Articles   Members Online:
-Article/Tip Search
-News Group Search over 21 Million news group articles.
-Delphi/Pascal
-CBuilder/C++
-C#Builder/C#
-JBuilder/Java
-Kylix
Member Area
-Home
-Account Center
-Top 10 NEW!!
-Submit Article/Tip
-Forums Upgraded!!
-My Articles
-Edit Information
-Login/Logout
-Become a Member
-Why sign up!
-Newsletter
-Chat Online!
-Indexes NEW!!
Employment
-Build your resume
-Find a job
-Post a job
-Resume Search
Contacts
-Contacts
-Feedbacks
-Link to us
-Privacy/Disclaimer
Embarcadero
Visit Embarcadero
Embarcadero Community
JEDI
Links
Automated object property creation and destruction using RTTI and metaclasses Turn on/off line numbers in source code. Switch to Orginial background IDE or DSP color Comment or reply to this aritlce/tip for discussion. Bookmark this article to my favorite article(s). Print this article
How to automate object creation / How to use the RTTI and Me 22-Mar-07
Category
OO-related
Language
Delphi All Versions
Views
4
User Rating
No Votes
# Votes
0
Replies
0
Publisher:
Wittfoth, Boris Benjamin
Reference URL:
			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. 


			
Vote: How useful do you find this Article/Tip?
Bad Excellent
1 2 3 4 5 6 7 8 9 10

 

Advertisement
Share this page
Advertisement
Download from Google

Copyright © Mendozi Enterprises LLC