Details | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
1 | daniel-mar | 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. |