Hi there,
here is a litte article that describes how to write an object that prevent the
"creations" and the "destructions" in a specific case.
Let us assume that we have an object of the base class THRBase which holds many
object properties which, in turn, are derivates from THRBase.
For example,
|THRBase (TPersistent)|<---inherits---- |THRGenerator_A_1|
| O O
| | |
| | |---------------------
| | |
| | |
| | |
|<---inherits---- |THRGenerator_A_1_1| |
|<---inherits----------------------------
|THRGenerator_A_1_2|
Therefor see this simplified code :
1
2 THRBase=class(TObject)
3 private
4 public
5 end;
6 THRGenerator_A_1_1=class; {forward}
7 THRGenerator_A_1_2=class; {forward}
8 THRGenerator_A_1=class(THRBase)
9 private
10 fGenerator_A_1_1: THRGenerator_A_1_1;
11 fGenerator_A_1_2: THRGenerator_A_1_2;
12 public
13 published
14 property Generator_A_1_1: THRGenerator_A_1_1 read fGenerator_A_1_1 write
15 fGenerator_A_1_1;
16 property Generator_A_1_2: THRGenerator_A_1_2 read fGenerator_A_1_2 write
17 fGenerator_A_1_2;
18 end;
19
20 THRGenerator_A_1_1=class(THRBase)
21 public
22 end;
23
24 THRGenerator_A_1_2=class(THRBase)
25 public
26 end;
Now,if we want to mangage the objects Generator_A_1_1 and Generator_A_1_2 within
the classtype THRGenerator_A_1, we have to instatiate and
destroy these objects manually.
To avoid and automate this we have the possibility to use the RTTI in conjunction
with metaclasses.
Therefor we need an abstract and generalized constructor and a generalized method
for creation and destruction of the THRBase-objects.
The methods CreateEntities and DestroyEntities - which are called in the virtual
constructor and the overwritten destructor of THRBase -
are responsible for the creation and destruction of the member entities.
To look which objects are present in the class we have to involve the Runtime Type
Information (RTTI, see article "How to get the published properties of an
persistent object" )
by including the TypInfo library. Basically we can use the RTTI only for
TPersistent objects - but in the majority of cases we don't need the the capacity
of persistence of an object.
To avoid this overhead and take the abbility to use the RTTI with TObject derivates
we have to compile the project with the $M+ compiler directive.
27
28
29 {$M+}
30 type
31 THRBaseClass=class of THRBase; {metaclass of THRBase}
32
33 {our baseclass - TPersistent is important - otherwise use the $M+ compiler
34 directive }
35 THRBase=class(TObject)
36 private
37 fOwner: THRBaseClass;
38 function CreateEntities:boolean;virtual;
39 function DestroyEntities:boolean;virtual;
40 function GetOwnerClass: THRBaseClass;
41 public
42 constructor Create;overload;virtual;
43 constructor Create(Owner:THRBase);overload;virtual;abstract;
44 destructor destroy;override;
45 property Owner:THRBaseClass read fOwner write fOwner;
46 property OwnerClass:THRBaseClass read GetOwnerClass;
47 end;
Now take a look at the implementations of the methods CreateEntities and
DestroyEntities.
48
49 {$M+}
50 type
51 …
52 implementation
53 …
54 uses TypInfo;
55
56 function THRBase.CreateEntities: boolean;
57 var count,i : Integer;
58 Meta:THRBaseClass; {Metaclass}
59 PropInfo:PPropInfo;
60 PropList:pPropList;
61 begin
62 RESULT:=FALSE;
63 { get count of class properties of object}
64 Count := GetPropList(self.ClassInfo, [tkClass], nil);
65 New(PropList);
66 { fill proplist with member objects }
67 GetPropList(self.ClassInfo, [tkClass], PropList);
68 try
69 for I:=0 to Count-1 do begin
70 { get the single property from property list }
71 PropInfo:=GetPropInfo(Self,PropList[I].Name);
72 { next if the propinfo is nil or not a class - but this should be impossible}
73 if (PropInfo = nil)or(PropInfo.PropType^.Kind<>tkClass) then
74 Continue;
75 { get metaclass of object property }
76 Meta:=THRBaseClass(GetObjectPropClass(Self,PropInfo));
77 { instantiate the object by calling the overwritten abstract constructor }
78 SetObjectProp(self,PropInfo,Meta.Create(self));
79 end;
80 RESULT:=TRUE;
81 finally
82 { free proplist }
83 Dispose(PropList);
84 end;
85 end;
86
87 function THRBase.DestroyEntities: boolean;
88 var count,i : Integer;
89 Meta:THRBaseClass;
90 PropInfo:PPropInfo;
91 PropList:pPropList;
92 begin
93 RESULT:=FALSE;
94 { get count of class properties of object}
95 Count := GetPropList(self.ClassInfo, [tkClass], nil);
96 New(PropList);
97 { fill proplist with member objects }
98 GetPropList(self.ClassInfo, [tkClass], PropList);
99 try
100 for I:=0 to Count-1 do begin
101 { get the single property from property list }
102 PropInfo:=GetPropInfo(Self,PropList[I].Name);
103 { next if the propinfo is nil or not a class - but this should be impossible}
104 if (PropInfo = nil)or(PropInfo.PropType^.Kind <>tkClass) then begin
105 Continue;
106 end;
107 { get metaclass of object property }
108 Meta:=THRBaseClass(GetObjectPropClass(Self,PropInfo));
109 { casting and destructor call }
110 (GetObjectProp(Self,PropInfo) as Meta).Destroy;
111 end;
112 Dispose(Proplist);
113 RESULT:=TRUE;
114 finally
115 Dispose(PropList);
116 end;
117 end;
At the bottom the complete source code with an implementation of an exemplary
virtual generator method - but this should be self-explantaory.
Best regards
Boris Benjamin Wittfoth
118
119 unit main;
120 {$M+}
121
122 interface
123
124 uses
125 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
126 Dialogs, StdCtrls;
127
128 type
129 THRBaseClass=class of THRBase;
130
131 THRBase=class(TObject)
132 private
133 fOwner: THRBaseClass;
134 function CreateEntities:boolean;virtual;
135 function DestroyEntities:boolean;virtual;
136 function GetOwnerClass: THRBaseClass;
137 public
138 constructor Create;overload;virtual;
139 constructor Create(Owner:THRBase);overload;virtual;abstract;
140 destructor destroy;override;
141 function Generate:string;virtual;abstract;
142 property Owner:THRBaseClass read fOwner write fOwner;
143 property OwnerClass:THRBaseClass read GetOwnerClass;
144 end;
145
146 THRGenerator_A_1_1=class;
147 THRGenerator_A_1_2=class;
148 THRGenerator_A_1=class(THRBase)
149 private
150 fGenerator_A_1_1: THRGenerator_A_1_1;
151 fGenerator_A_1_2: THRGenerator_A_1_2;
152 fStrings: TStrings;
153 public
154 constructor Create(Owner:THRBase);override;
155 function Generate:string;override;
156 published
157 property Generator_A_1_1: THRGenerator_A_1_1 read fGenerator_A_1_1 write
158 fGenerator_A_1_1;
159 property Generator_A_1_2: THRGenerator_A_1_2 read fGenerator_A_1_2 write
160 fGenerator_A_1_2;
161 end;
162
163 THRGenerator_A_1_1=class(THRBase)
164 public
165 constructor Create(Owner:THRBase);override;
166 function Generate:string;override;
167 end;
168
169 THRGenerator_A_1_2=class(THRBase)
170 public
171 constructor Create(Owner:THRBase);override;
172 function Generate:string;override;
173 end;
174
175 THRGenerator_A_2=class(THRBase)
176 public
177 constructor Create(Owner:THRBase);override;
178 function Generate:string;override;
179 end;
180
181 THRGeneratorA=class(THRBase)
182 private
183 fGenerator_A_1: THRGenerator_A_1;
184 fGenerator_A_2: THRGenerator_A_2;
185 published
186 property Generator_A_1:THRGenerator_A_1 read fGenerator_A_1 write
187 fGenerator_A_1;
188 property Generator_A_2:THRGenerator_A_2 read fGenerator_A_2 write
189 fGenerator_A_2;
190 end;
191
192 TForm1 = class(TForm)
193 Button1: TButton;
194 Button2: TButton;
195 procedure Button1Click(Sender: TObject);
196 procedure Button2Click(Sender: TObject);
197 private
198 public
199 end;
200
201 var
202 Form1: TForm1;
203
204 implementation
205
206 {$R *.dfm}
207
208
209 uses TypInfo;
210
211
212 { THRBaseClass }
213
214
215 constructor THRBase.Create;
216 begin
217 self.CreateEntities;
218 end;
219
220 function THRBase.CreateEntities: boolean;
221 var count,i : Integer;
222 Meta:THRBaseClass;
223 PropInfo:PPropInfo;
224 PropList:pPropList;
225 begin
226 RESULT:=FALSE;
227 Count := GetPropList(self.ClassInfo, [tkClass], nil);
228 New(PropList);
229 GetPropList(self.ClassInfo, [tkClass], PropList);
230 try
231 for I:=0 to Count-1 do begin
232 PropInfo:=GetPropInfo(Self,PropList[I].Name);
233 if (PropInfo = nil)or(PropInfo.PropType^.Kind<>tkClass) then
234 Continue;
235 Meta:=THRBaseClass(GetObjectPropClass(Self,PropInfo));
236 SetObjectProp(self,PropInfo,Meta.Create(self));
237 end;
238 Dispose(Proplist);
239 RESULT:=TRUE;
240 except
241 on e:Exception do begin
242 Dispose(PropList);
243 end;
244 end;
245 end;
246
247 function THRBase.DestroyEntities: boolean;
248 var count,i : Integer;
249 Meta:THRBaseClass;
250 PropInfo:PPropInfo;
251 PropList:pPropList;
252 begin
253 RESULT:=FALSE;
254 Count := GetPropList(self.ClassInfo, [tkClass], nil);
255 New(PropList);
256 GetPropList(self.ClassInfo, [tkClass], PropList);
257 try
258 for I:=0 to Count-1 do begin
259 PropInfo:=GetPropInfo(Self,PropList[I].Name);
260 if (PropInfo = nil)or(PropInfo.PropType^.Kind <>tkClass) then begin
261 Continue;
262 end;
263 Meta:=THRBaseClass(GetObjectPropClass(Self,PropInfo));
264 (GetObjectProp(Self,PropInfo) as Meta).Destroy;
265 end;
266 Dispose(Proplist);
267 RESULT:=TRUE;
268 except
269 on e:Exception do begin
270 Dispose(PropList);
271 end;
272 end;
273 end;
274
275
276 destructor THRBase.destroy;
277 begin
278 self.DestroyEntities;
279 inherited Destroy;
280 end;
281
282
283 function THRBase.GetOwnerClass: THRBaseClass;
284 begin
285 if self.Owner<>nil then
286 RESULT:=THRBaseClass(self.Owner);
287
288 end;
289
290 { THRGenerator_A_1 }
291
292
293 constructor THRGenerator_A_1.Create(Owner: THRBase);
294 begin
295 inherited Create;
296 self.fStrings:=TStringlist.create;
297
298 end;
299
300 function THRGenerator_A_1.Generate: string;
301 begin
302 RESULT:=
303 self.Generator_A_1_1.Generate+' + '+self.Generator_A_1_2.Generate;
304 end;
305
306
307 { THRGenerator_A_1_1 }
308
309 constructor THRGenerator_A_1_1.Create(Owner: THRBase);
310 begin
311 inherited Create;
312 end;
313
314 function THRGenerator_A_1_1.Generate: string;
315 begin
316 RESULT:='A_1_1';
317 end;
318
319 { THRGenerator_A_1_2 }
320
321 constructor THRGenerator_A_1_2.Create(Owner: THRBase);
322 begin
323 inherited Create;
324 end;
325
326 function THRGenerator_A_1_2.Generate: string;
327 begin
328 RESULT:='A_1_2';
329 end;
330
331 { THRGenerator_A_2 }
332
333
334 constructor THRGenerator_A_2.Create(Owner: THRBase);
335 begin
336 inherited Create;
337 end;
338
339 function THRGenerator_A_2.Generate: string;
340 begin
341 RESULT:='A_2';
342 end;
343
344 { TForm1 }
345
346 procedure TForm1.Button1Click(Sender: TObject);
347 var GeneratorA:THRGeneratorA;
348 begin
349 GeneratorA:=THRGeneratorA.Create;
350 ShowMessage(
351 GeneratorA.Generator_A_1.ClassName+' ->
352 'GeneratorA.Generator_A_1.Generate+#13#10+
353 GeneratorA.Generator_A_2.ClassName+' ->
354 'GeneratorA.Generator_A_2.Generate+#13#10
355 );
356 GeneratorA.free;
357 end;
358
359
360 end.
|
