Mega Code Archive
Automated object property creation and destruction using RTTI and metaclasses
<![CDATA[
Title: Automated object-property creation and destruction using RTTI and metaclasses
Question: How to automate object creation / How to use the RTTI and Metaclasses
Answer:
Hi there,
here is a litte article that describes how to write an object that prevent the annoying
thing of the "creates" and the "destroys" 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)| | O O
| | |
| | |---------------------
| | |
| | |
| | |
| |
Therefor see this simplified code :
THRBase=class(TObject)
private
public
end;
THRGenerator_A_1_1=class; {forward}
THRGenerator_A_1_2=class; {forward}
THRGenerator_A_1=class(THRBase)
private
fGenerator_A_1_1: THRGenerator_A_1_1;
fGenerator_A_1_2: THRGenerator_A_1_2;
public
published
property Generator_A_1_1: THRGenerator_A_1_1 read fGenerator_A_1_1 write fGenerator_A_1_1;
property Generator_A_1_2: THRGenerator_A_1_2 read fGenerator_A_1_2 write fGenerator_A_1_2;
end;
THRGenerator_A_1_1=class(THRBase)
public
end;
THRGenerator_A_1_2=class(THRBase)
Public
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 http://www.delphi3000.com/articles/article_3423.asp ) 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.
{$M+}
type
THRBaseClass=class of THRBase; {metaclass of THRBase}
{our baseclass - TPersistent is important - otherwise use the $M+ compiler directive }
THRBase=class(TObject)
private
fOwner: THRBaseClass;
function CreateEntities:boolean;virtual;
function DestroyEntities:boolean;virtual;
function GetOwnerClass: THRBaseClass;
public
constructor Create;overload;virtual;
constructor Create(Owner:THRBase);overload;virtual;abstract;
destructor destroy;override;
property Owner:THRBaseClass read fOwner write fOwner;
property OwnerClass:THRBaseClass read GetOwnerClass;
end;
Now take a look at the implementations of the methods CreateEntities and DestroyEntities.
{$M+}
type
implementation
uses TypInfo;
function THRBase.CreateEntities: boolean;
var count,i : Integer;
Meta:THRBaseClass; {Metaclass}
PropInfo:PPropInfo;
PropList:pPropList;
begin
RESULT:=FALSE;
{ get count of class properties of object}
Count := GetPropList(self.ClassInfo, [tkClass], nil);
New(PropList);
{ fill proplist with member objects }
GetPropList(self.ClassInfo, [tkClass], PropList);
try
for I:=0 to Count-1 do begin
{ get the single property from property list }
PropInfo:=GetPropInfo(Self,PropList[I].Name);
{ next if the propinfo is nil or not a class - but this should be impossible}
if (PropInfo = nil)or(PropInfo.PropType^.KindtkClass) then
Continue;
{ get metaclass of object property }
Meta:=THRBaseClass(GetObjectPropClass(Self,PropInfo));
{ instantiate the object by calling the overwritten abstract constructor }
SetObjectProp(self,PropInfo,Meta.Create(self));
end;
RESULT:=TRUE;
Finally
{ free proplist }
Dispose(PropList);
end;
end;
function THRBase.DestroyEntities: boolean;
var count,i : Integer;
Meta:THRBaseClass;
PropInfo:PPropInfo;
PropList:pPropList;
begin
RESULT:=FALSE;
{ get count of class properties of object}
Count := GetPropList(self.ClassInfo, [tkClass], nil);
New(PropList);
{ fill proplist with member objects }
GetPropList(self.ClassInfo, [tkClass], PropList);
try
for I:=0 to Count-1 do begin
{ get the single property from property list }
PropInfo:=GetPropInfo(Self,PropList[I].Name);
{ next if the propinfo is nil or not a class - but this should be impossible}
if (PropInfo = nil)or(PropInfo.PropType^.Kind tkClass) then begin
Continue;
end;
{ get metaclass of object property }
Meta:=THRBaseClass(GetObjectPropClass(Self,PropInfo));
{ casting and destructor call }
(GetObjectProp(Self,PropInfo) as Meta).Destroy;
end;
Dispose(Proplist);
RESULT:=TRUE;
Finally
Dispose(PropList);
end;
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
unit main;
{$M+}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
THRBaseClass=class of THRBase;
THRBase=class(TObject)
private
fOwner: THRBaseClass;
function CreateEntities:boolean;virtual;
function DestroyEntities:boolean;virtual;
function GetOwnerClass: THRBaseClass;
public
constructor Create;overload;virtual;
constructor Create(Owner:THRBase);overload;virtual;abstract;
destructor destroy;override;
function Generate:String;virtual;abstract;
property Owner:THRBaseClass read fOwner write fOwner;
property OwnerClass:THRBaseClass read GetOwnerClass;
end;
THRGenerator_A_1_1=class;
THRGenerator_A_1_2=class;
THRGenerator_A_1=class(THRBase)
private
fGenerator_A_1_1: THRGenerator_A_1_1;
fGenerator_A_1_2: THRGenerator_A_1_2;
fStrings: TStrings;
public
constructor Create(Owner:THRBase);override;
function Generate:String;override;
published
property Generator_A_1_1: THRGenerator_A_1_1 read fGenerator_A_1_1 write fGenerator_A_1_1;
property Generator_A_1_2: THRGenerator_A_1_2 read fGenerator_A_1_2 write fGenerator_A_1_2;
end;
THRGenerator_A_1_1=class(THRBase)
public
constructor Create(Owner:THRBase);override;
function Generate:String;override;
end;
THRGenerator_A_1_2=class(THRBase)
public
constructor Create(Owner:THRBase);override;
function Generate:String;override;
end;
THRGenerator_A_2=class(THRBase)
public
constructor Create(Owner:THRBase);override;
function Generate:String;override;
end;
THRGeneratorA=class(THRBase)
private
fGenerator_A_1: THRGenerator_A_1;
fGenerator_A_2: THRGenerator_A_2;
published
property Generator_A_1:THRGenerator_A_1 read fGenerator_A_1 write fGenerator_A_1;
property Generator_A_2:THRGenerator_A_2 read fGenerator_A_2 write fGenerator_A_2;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses TypInfo;
{ THRBaseClass }
constructor THRBase.Create;
begin
self.CreateEntities;
end;
function THRBase.CreateEntities: boolean;
var count,i : Integer;
Meta:THRBaseClass;
PropInfo:PPropInfo;
PropList:pPropList;
begin
RESULT:=FALSE;
Count := GetPropList(self.ClassInfo, [tkClass], nil);
New(PropList);
GetPropList(self.ClassInfo, [tkClass], PropList);
try
for I:=0 to Count-1 do begin
PropInfo:=GetPropInfo(Self,PropList[I].Name);
if (PropInfo = nil)or(PropInfo.PropType^.KindtkClass) then
Continue;
Meta:=THRBaseClass(GetObjectPropClass(Self,PropInfo));
SetObjectProp(self,PropInfo,Meta.Create(self));
end;
Dispose(Proplist);
RESULT:=TRUE;
except
on e:Exception do begin
Dispose(PropList);
end;
end;
end;
function THRBase.DestroyEntities: boolean;
var count,i : Integer;
Meta:THRBaseClass;
PropInfo:PPropInfo;
PropList:pPropList;
begin
RESULT:=FALSE;
Count := GetPropList(self.ClassInfo, [tkClass], nil);
New(PropList);
GetPropList(self.ClassInfo, [tkClass], PropList);
try
for I:=0 to Count-1 do begin
PropInfo:=GetPropInfo(Self,PropList[I].Name);
if (PropInfo = nil)or(PropInfo.PropType^.Kind tkClass) then begin
Continue;
end;
Meta:=THRBaseClass(GetObjectPropClass(Self,PropInfo));
(GetObjectProp(Self,PropInfo) as Meta).Destroy;
end;
Dispose(Proplist);
RESULT:=TRUE;
except
on e:Exception do begin
Dispose(PropList);
end;
end;
end;
destructor THRBase.destroy;
begin
self.DestroyEntities;
inherited Destroy;
end;
function THRBase.GetOwnerClass: THRBaseClass;
begin
if self.OwnerNIL then
RESULT:=THRBaseClass(self.Owner);
end;
{ THRGenerator_A_1 }
constructor THRGenerator_A_1.Create(Owner: THRBase);
begin
inherited Create;
self.fStrings:=TStringlist.create;
end;
function THRGenerator_A_1.Generate: String;
begin
RESULT:=
self.Generator_A_1_1.Generate+' + '+self.Generator_A_1_2.Generate;
end;
{ THRGenerator_A_1_1 }
constructor THRGenerator_A_1_1.Create(Owner: THRBase);
begin
inherited Create;
end;
function THRGenerator_A_1_1.Generate: String;
begin
RESULT:='A_1_1';
end;
{ THRGenerator_A_1_2 }
constructor THRGenerator_A_1_2.Create(Owner: THRBase);
begin
inherited Create;
end;
function THRGenerator_A_1_2.Generate: String;
begin
RESULT:='A_1_2';
end;
{ THRGenerator_A_2 }
constructor THRGenerator_A_2.Create(Owner: THRBase);
begin
inherited Create;
end;
function THRGenerator_A_2.Generate: String;
begin
RESULT:='A_2';
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var GeneratorA:THRGeneratorA;
begin
GeneratorA:=THRGeneratorA.Create;
ShowMessage(
GeneratorA.Generator_A_1.ClassName+' - '+GeneratorA.Generator_A_1.Generate+#13#10+
GeneratorA.Generator_A_2.ClassName+' - '+GeneratorA.Generator_A_2.Generate+#13#10
);
GeneratorA.free;
end;
end.
]]>