Author: Güven ÖZDEMİR
Daniel Wischnewski 's Article is good.But how i can compile it on delphi7.
Answer:
As you know under delphi 6 there is DsgnIntf. unit. Instead of this unit
DesignIntf and DesignEditors units came with delphi 6 and after.
Now to fix code first use DesignIntf and DesignEditors units instead of
DsgnIntf.. and replase IformDesigner to IDesigner in frmDesignTimeEditor unit.After
to do this you will get error.to correct this please replace Designer.form.Name
to Designer.Root.Name. And Now You can compile these usefull toll on delphi 7.
here is the code of frmDesignTimeEditor.
Thank again to Daniel Wischnewski for that good companent.
Regards ;
Güven Özdemir.
1 unit frmDesignTimeEditor;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, Buttons, ComCtrls, ComponentStateRecovery, DesignIntf,
8 DesignEditors,
9 TypInfo;
10
11 type
12 // component editor for the TComponentStateRecorder class
13 TCSRDesignEditor = class(TDefaultEditor)
14 protected
15 public
16 function GetVerb(Index: Integer): string; override;
17 function GetVerbCount: Integer; override;
18 procedure ExecuteVerb(Index: Integer); override;
19 end;
20
21 // property editor that lists all properties of a component at design-time
22 TPropertyNameEditor = class(TStringProperty)
23 public
24 procedure GetValues(Proc: TGetStrProc); override;
25 function GetAttributes: TPropertyAttributes; override;
26 end;
27
28 // property editor that lists all components at design-time
29 TComponentNameEditor = class(TStringProperty)
30 public
31 procedure GetValues(Proc: TGetStrProc); override;
32 function GetAttributes: TPropertyAttributes; override;
33 end;
34
35 TfrmCSRDesigner = class(TForm)
36 Panel1: TPanel;
37 Label1: TLabel;
38 edtRegKey: TEdit;
39 Panel2: TPanel;
40 btnOK: TBitBtn;
41 trvCollections: TTreeView;
42 Panel3: TPanel;
43 lblComponent: TLabel;
44 cmbComponent: TComboBox;
45 grpProperty: TGroupBox;
46 lblPropertyName: TLabel;
47 cmbPropertyName: TComboBox;
48 lblDefaultValue: TLabel;
49 edtDefaultValue: TEdit;
50 btnAddComponent: TButton;
51 btnRemove: TButton;
52 btnAddProperty: TButton;
53 procedure btnOKClick(Sender: TObject);
54 procedure trvCollectionsChange(Sender: TObject; Node: TTreeNode);
55 procedure btnAddComponentClick(Sender: TObject);
56 procedure cmbComponentChange(Sender: TObject);
57 procedure edtRegKeyChange(Sender: TObject);
58 procedure cmbPropertyNameChange(Sender: TObject);
59 procedure edtDefaultValueChange(Sender: TObject);
60 procedure btnAddPropertyClick(Sender: TObject);
61 procedure btnRemoveClick(Sender: TObject);
62 private
63 FCSR: TComponentStateRecorder;
64 FDesigner: IDesigner;
65 procedure SetCSR(const Value: TComponentStateRecorder);
66 procedure ShowProperties(Name: string);
67 procedure UpdateForSelectedNode;
68 procedure SetDesigner(const Value: IDesigner);
69 public
70 property CSR: TComponentStateRecorder read FCSR write SetCSR;
71 property Designer: IDesigner read FDesigner write SetDesigner;
72 end;
73
74 var
75 frmCSRDesigner: TfrmCSRDesigner;
76
77 procedure register;
78
79 implementation
80
81 {$R *.DFM}
82
83 procedure register;
84 begin
85 // register component
86 RegisterComponents('gate(n)etwork', [TComponentStateRecorder]);
87 // register property editors (they will provide drop-down lists to the OI)
88 RegisterPropertyEditor(
89 TypeInfo(string), TSavedComponent, 'ComponentName', TComponentNameEditor
90 );
91 RegisterPropertyEditor(
92 TypeInfo(string), TSavedProperty, 'PropertyName', TPropertyNameEditor
93 );
94 // register component editor
95 RegisterComponentEditor(TComponentStateRecorder, TCSRDesignEditor);
96 end;
97
98 { TCSRDesignEditor }
99
100 procedure TCSRDesignEditor.ExecuteVerb(Index: Integer);
101 begin
102 with TfrmCSRDesigner.Create(Application) do
103 try
104 Designer := Self.Designer;
105 CSR := TComponentStateRecorder(Component);
106 ShowModal;
107 finally
108 Free;
109 end;
110 end;
111
112 function TCSRDesignEditor.GetVerb(Index: Integer): string;
113 begin
114 if Index = 0 then
115 Result := 'Edit all recorded Properties...'
116 else
117 Result := '';
118 end;
119
120 function TCSRDesignEditor.GetVerbCount: Integer;
121 begin
122 Result := 1;
123 end;
124
125 { TPropertyNameEditor }
126
127 function TPropertyNameEditor.GetAttributes: TPropertyAttributes;
128 begin
129 // the property editor will provide a sorted list of possible values
130 Result := [paValueList, paSortList];
131 end;
132
133 procedure TPropertyNameEditor.GetValues(Proc: TGetStrProc);
134 var
135 I, Count: Integer;
136 PropInfos: PPropList;
137 TmpComponent: TComponent;
138 SC: TSavedComponent;
139 begin
140 // check property type
141 if not (GetComponent(0) is TSavedProperty) then
142 Exit;
143 // get TSavedComponent (parent object)
144 SC := TSavedProperties(
145 TSavedProperty(GetComponent(0)).Collection
146 ).SavedComponent;
147 // find the corresponding component
148
149
150 if SC.ComponentName = Designer.Root.Name then
151 TmpComponent := Designer.Root
152 else
153 TmpComponent := Designer.GetComponent(SC.ComponentName);
154
155
156 // quit if component was not found
157 if TmpComponent = nil then
158 Exit;
159 // determine the property count
160 Count := GetPropList(TmpComponent.ClassInfo, [
161 tkInteger, tkInt64, tkFloat, tkEnumeration, tkSet, tkChar, tkString,
162 tkLString
163 ], nil);
164 // reserve memory needed for property informations
165 GetMem(PropInfos, Count * SizeOf(PPropInfo));
166 try
167 // load property list
168 GetPropList(TmpComponent.ClassInfo, [
169 tkInteger, tkInt64, tkFloat, tkEnumeration, tkSet, tkChar, tkString,
170 tkLString
171 ], PropInfos);
172 // save to object inspector list
173 for I := 0 to Pred(Count) do
174 Proc(PropInfos^[I]^.Name);
175 finally
176 // free resources
177 FreeMem(PropInfos);
178 end;
179 end;
180
181 { TComponentNameEditor }
182
183 function TComponentNameEditor.GetAttributes: TPropertyAttributes;
184 begin
185 // the property editor will provide a sorted list of possible values
186 Result := [paValueList, paSortList];
187 end;
188
189 procedure TComponentNameEditor.GetValues(Proc: TGetStrProc);
190 var
191 I: Integer;
192 begin
193 // return name of form
194 if Designer.Root.Name <> '' then
195 Proc(Designer.Root.Name);
196 // return names of all components
197 for I := 0 to Pred(Designer.root.ComponentCount) do
198 if Designer.root.Components[I].Name <> '' then
199 Proc(Designer.root.Components[I].Name);
200 end;
201
202 { TfrmCSRDesigner }
203
204 procedure TfrmCSRDesigner.btnAddComponentClick(Sender: TObject);
205 var
206 Node: TTreeNode;
207 SC: TSavedComponent;
208 begin
209 SC := CSR.SavedComponents.Add;
210 Node := trvCollections.Items.AddChild(nil, SC.DisplayName);
211 trvCollections.Selected := Node;
212 Node.Data := SC;
213 UpdateForSelectedNode;
214 Designer.Modified;
215 end;
216
217 procedure TfrmCSRDesigner.btnAddPropertyClick(Sender: TObject);
218 var
219 Node: TTreeNode;
220 SP: TSavedProperty;
221 begin
222 if trvCollections.Selected = nil then
223 Exit;
224 if trvCollections.Selected.Data = nil then
225 Exit;
226 if not (TObject(trvCollections.Selected.Data) is TSavedComponent) then
227 Exit;
228 SP := TSavedComponent(trvCollections.Selected.Data).SavedProperties.Add;
229 Node :=
230 trvCollections.Items.AddChild(trvCollections.Selected, SP.DisplayName);
231 Node.Data := SP;
232 trvCollections.Selected := Node;
233 UpdateForSelectedNode;
234 Designer.Modified;
235 end;
236
237 procedure TfrmCSRDesigner.btnOKClick(Sender: TObject);
238 begin
239 ModalResult := mrOK;
240 end;
241
242 procedure TfrmCSRDesigner.btnRemoveClick(Sender: TObject);
243 begin
244 if trvCollections.Selected = nil then
245 Exit;
246 if trvCollections.Selected.Data = nil then
247 Exit;
248 if (TObject(trvCollections.Selected.Data) is TSavedComponent) then
249 begin
250 TSavedComponent(trvCollections.Selected.Data).Collection.Delete(
251 TSavedComponent(trvCollections.Selected.Data).Index
252 );
253 trvCollections.Items.Delete(trvCollections.Selected);
254 end;
255 if (TObject(trvCollections.Selected.Data) is TSavedProperty) then
256 begin
257 TSavedProperty(trvCollections.Selected.Data).Collection.Delete(
258 TSavedProperty(trvCollections.Selected.Data).Index
259 );
260 trvCollections.Items.Delete(trvCollections.Selected);
261 end;
262 Designer.Modified;
263 end;
264
265 procedure TfrmCSRDesigner.cmbComponentChange(Sender: TObject);
266 begin
267 if trvCollections.Selected = nil then
268 Exit;
269 if trvCollections.Selected.Data = nil then
270 Exit;
271 if not (TObject(trvCollections.Selected.Data) is TSavedComponent) then
272 Exit;
273 TSavedComponent(trvCollections.Selected.Data).ComponentName :=
274 cmbComponent.Text;
275 trvCollections.Selected.Text :=
276 TSavedComponent(trvCollections.Selected.Data).DisplayName;
277 Designer.Modified;
278 end;
279
280 procedure TfrmCSRDesigner.cmbPropertyNameChange(Sender: TObject);
281 begin
282 if trvCollections.Selected = nil then
283 Exit;
284 if trvCollections.Selected.Data = nil then
285 Exit;
286 if not (TObject(trvCollections.Selected.Data) is TSavedProperty) then
287 Exit;
288 TSavedProperty(trvCollections.Selected.Data).DefaultValue := '';
289 TSavedProperty(trvCollections.Selected.Data).PropertyName :=
290 cmbPropertyName.Text;
291 trvCollections.Selected.Text :=
292 TSavedProperty(trvCollections.Selected.Data).DisplayName;
293 edtDefaultValue.Text :=
294 TSavedProperty(trvCollections.Selected.Data).DefaultValue;
295 Designer.Modified;
296 end;
297
298 procedure TfrmCSRDesigner.edtDefaultValueChange(Sender: TObject);
299 begin
300 if trvCollections.Selected = nil then
301 Exit;
302 if trvCollections.Selected.Data = nil then
303 Exit;
304 if not (TObject(trvCollections.Selected.Data) is TSavedProperty) then
305 Exit;
306 TSavedProperty(trvCollections.Selected.Data).DefaultValue :=
307 edtDefaultValue.Text;
308 Designer.Modified;
309 end;
310
311 procedure TfrmCSRDesigner.edtRegKeyChange(Sender: TObject);
312 begin
313 FCSR.RegistryKey := edtRegKey.Text;
314 Designer.Modified;
315 end;
316
317 procedure TfrmCSRDesigner.SetCSR(const Value: TComponentStateRecorder);
318 var
319 I, J: Integer;
320 SC: TSavedComponent;
321 SP: TSavedProperty;
322 SCNode, SPNode: TTreeNode;
323 begin
324 FCSR := Value;
325 // load registry key
326 edtRegKey.Text := FCSR.RegistryKey;
327 trvCollections.Items.Clear;
328 // parse all selected components
329 for I := 0 to Pred(FCSR.SavedComponents.Count) do
330 begin
331 SC := FCSR.SavedComponents.Items[I];
332 SCNode := trvCollections.Items.AddChild(nil, SC.DisplayName);
333 SCNode.Data := SC;
334 // parse all selected properties
335 for J := 0 to Pred(SC.SavedProperties.Count) do
336 begin
337 SP := SC.SavedProperties.Items[J];
338 SPNode := trvCollections.Items.AddChild(SCNode, SP.DisplayName);
339 SPNode.Data := SP;
340 end;
341 end;
342 // select the first item in the list
343 if trvCollections.Items.Count > 0 then
344 trvCollections.Selected := trvCollections.Items.Item[0];
345 if Designer <> nil then
346 begin
347 // return name of form
348 if Designer.root.Name <> '' then
349 cmbComponent.Items.Add(Designer.root.Name);
350 // return names of all components
351 for I := 0 to Pred(Designer.root.ComponentCount) do
352 if Designer.root.Components[I].Name <> '' then
353 cmbComponent.Items.Add(Designer.root.Components[I].Name);
354 end;
355 // show state of selection
356 UpdateForSelectedNode;
357 end;
358
359 type
360 TEnableStates = (esComponent, esProperty);
361 TEnableStateSet = set of TEnableStates;
362
363 procedure TfrmCSRDesigner.SetDesigner(const Value: IDesigner);
364 begin
365 FDesigner := Value;
366 end;
367
368 procedure TfrmCSRDesigner.ShowProperties(Name: string);
369 var
370 I, Count: Integer;
371 PropInfos: PPropList;
372 TmpComponent: TComponent;
373 begin
374 // clear list
375 cmbPropertyName.Clear;
376 // stop if no component name is provided
377 if Name = '' then
378 Exit;
379 // get component
380 if CSR.Owner.Name = Name then
381 TmpComponent := CSR.Owner
382 else
383 TmpComponent := CSR.Owner.FindComponent(Name);
384 // stop if component was not found
385 if TmpComponent = nil then
386 Exit;
387 // determine the property count
388 Count := GetPropList(TmpComponent.ClassInfo, [
389 tkInteger, tkInt64, tkFloat, tkEnumeration, tkSet, tkChar, tkString,
390 tkLString
391 ], nil);
392 // reserve memory needed for property informations
393 GetMem(PropInfos, Count * SizeOf(PPropInfo));
394 try
395 // load property list
396 GetPropList(TmpComponent.ClassInfo, [
397 tkInteger, tkInt64, tkFloat, tkEnumeration, tkSet, tkChar, tkString,
398 tkLString
399 ], PropInfos);
400 // save to object inspector list
401 for I := 0 to Pred(Count) do
402 cmbPropertyName.Items.Add(PropInfos^[I]^.Name);
403 finally
404 // free resources
405 FreeMem(PropInfos);
406 end;
407 end;
408
409 procedure TfrmCSRDesigner.trvCollectionsChange(Sender: TObject;
410 Node: TTreeNode);
411 begin
412 UpdateForSelectedNode;
413 end;
414
415 procedure TfrmCSRDesigner.UpdateForSelectedNode;
416 var
417 CompName, PropertyName: string;
418 EnableStates: TEnableStateSet;
419 begin
420 EnableStates := [];
421 Name := '';
422 if trvCollections.Selected <> nil then
423 if trvCollections.Selected.Data <> nil then
424 begin
425 if TObject(trvCollections.Selected.Data) is TSavedComponent then
426 begin
427 cmbComponent.Text :=
428 TSavedComponent(trvCollections.Selected.Data).ComponentName;
429 EnableStates := EnableStates + [esComponent];
430 cmbPropertyName.Text := '';
431 edtDefaultValue.Text := '';
432 trvCollections.Selected.Text :=
433 TSavedComponent(trvCollections.Selected.Data).DisplayName;
434 CompName := '';
435 PropertyName := '';
436 end;
437 if TObject(trvCollections.Selected.Data) is TSavedProperty then
438 begin
439 EnableStates := EnableStates + [esProperty];
440 CompName :=
441 TSavedProperties(TSavedProperty(
442 trvCollections.Selected.Data
443 ).Collection).SavedComponent.ComponentName;
444 cmbComponent.Text := CompName;
445 PropertyName :=
446 TSavedProperty(trvCollections.Selected.Data).PropertyName;
447 cmbPropertyName.Text := Name;
448 edtDefaultValue.Text :=
449 TSavedProperty(trvCollections.Selected.Data).DefaultValue;
450 trvCollections.Selected.Text :=
451 TSavedProperty(trvCollections.Selected.Data).DisplayName;
452 end;
453 end;
454 cmbComponent.Enabled := esComponent in EnableStates;
455 lblComponent.Enabled := esComponent in EnableStates;
456 btnAddProperty.Enabled := esComponent in EnableStates;
457 cmbPropertyName.Enabled := esProperty in EnableStates;
458 lblPropertyName.Enabled := esProperty in EnableStates;
459 edtDefaultValue.Enabled := esProperty in EnableStates;
460 lblDefaultValue.Enabled := esProperty in EnableStates;
461 grpProperty.Enabled := esProperty in EnableStates;
462 btnRemove.Enabled := EnableStates <> [];
463 ShowProperties(CompName);
464 cmbPropertyName.Text := PropertyName;
465 trvCollections.Update;
466 end;
467
468 end.
|