Subversion Repositories spacemission

Rev

Blame | Last modification | View Log | RSS feed

  1. unit DXGUIDEdit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ActiveX, ComObj;
  8.  
  9. type
  10.   TDelphiXGUIDEditForm = class(TForm)
  11.     Edit: TEdit;
  12.     OKButton: TButton;
  13.     CancelButton: TButton;
  14.     NewButton: TButton;
  15.     procedure NewButtonClick(Sender: TObject);
  16.     procedure EditChange(Sender: TObject);
  17.     procedure CancelButtonClick(Sender: TObject);
  18.     procedure OKButtonClick(Sender: TObject);
  19.     procedure EditExit(Sender: TObject);
  20.     procedure FormShow(Sender: TObject);
  21.     procedure EditEnter(Sender: TObject);
  22.   private
  23.     FChanged: Boolean;
  24.     FOldGUID: string;
  25.   public
  26.     GUID: string;
  27.   end;
  28.  
  29. var
  30.   DelphiXGUIDEditForm: TDelphiXGUIDEditForm;
  31.  
  32. implementation
  33.  
  34. uses DXConsts;
  35.  
  36. {$R *.DFM}
  37.  
  38. const
  39.   SIsGUIDnewlyMade = 'Is GUID newly made?';
  40.  
  41. procedure TDelphiXGUIDEditForm.OKButtonClick(Sender: TObject);
  42. begin
  43.   if FChanged then
  44.   begin
  45.     GUID := GUIDToString(StringToGUID(Edit.Text));
  46.     Tag := 1;
  47.   end;
  48.   Close;
  49. end;
  50.  
  51. procedure TDelphiXGUIDEditForm.CancelButtonClick(Sender: TObject);
  52. begin
  53.   Close;
  54. end;
  55.  
  56. procedure TDelphiXGUIDEditForm.NewButtonClick(Sender: TObject);
  57. var
  58.   GUID: TGUID;
  59. begin
  60.   if Application.MessageBox(PChar(SIsGUIDnewlyMade), 'GUID', MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2)<>IDYES then Exit;
  61.  
  62.   if CoCreateGuid(GUID)<>0 then
  63.     raise Exception.CreateFmt(SCannotMade, ['GUID']);
  64.   Edit.Text := GUIDToString(GUID);
  65.   FChanged := True;
  66. end;
  67.  
  68. procedure TDelphiXGUIDEditForm.EditChange(Sender: TObject);
  69. begin
  70.   FChanged := True;
  71. end;
  72.  
  73. procedure TDelphiXGUIDEditForm.EditExit(Sender: TObject);
  74. begin
  75.   try
  76.     Edit.Text := GUIDToString(StringToGUID(Edit.Text));
  77.   except
  78.     Edit.Text := FOldGUID;
  79.     raise;
  80.   end;
  81. end;
  82.  
  83. procedure TDelphiXGUIDEditForm.FormShow(Sender: TObject);
  84. begin
  85.   Edit.Text := GUIDToString(StringToGUID(GUID));
  86. end;
  87.  
  88. procedure TDelphiXGUIDEditForm.EditEnter(Sender: TObject);
  89. begin
  90.   FOldGUID := Edit.Text;
  91. end;
  92.  
  93. end.
  94.