Delphi RTTI Object Inspector - class

Question

I'm trying to build a simplified object inspector for a drawing app I'm writing.
I'm trying to dynamically get RTTI for the selected object and its child objects. If a given property is a class (tkClass), I want to call GetRTTIObject recursively, handing that property as the object to get the "subproperties" for it (i.e. BaseObj.Brush.Color or BaseObj.Pen.Width etc.). I suspect I want to pass the instance of that object and that it will be painfully obvious when someone points out what that is. How do I get an instance to pass to my function? Or should I be looking at TRttiInstance for properties that are classes....?
I know it works at "level 0", because I can pass in BaseObject.Brush to my first call of GetRTTIObject and I get a list of TBrush properties. How can I drill down recursively?
I seem to get a pointer of some kind with Value := GetPropValue(AObj, Prop.Name);
Do I dereference that somehow to get my instance...?
Regards,
Rob
The simplified test class is defined:
TBaseClass = class(TObject)
private
FFont: TFont;
FBrush: TBrush;
FPen: TPen;
FCaption: String;
FFloat1: Real;
FInt1: Integer;
published
property Font: TFont Read FFont Write FFont;
property Brush: TBrush Read FBrush Write FBrush;
property Pen: TPen Read FPen Write FPen;
property Caption: String Read FCaption Write FCaption;
property Float1: Real Read FFloat1 Write FFloat1;
property Int1: Integer Read FInt1 Write FInt1;
end;
My RTTI procedure is:
procedure TfrmMain.GetRTTIClass(AClass: TClass; Items: TStrings; Indent: Integer);
var
LContext: TRttiContext;
LType: TRttiType;
Prop: TRttiProperty;
PropString: String;
PropInfo: PPropInfo;
Tabs: String;
I: Integer;
Value: Variant;
begin
LContext := TRttiContext.Create();
try
for I := 0 to Indent do
Tabs := Tabs + ' '; //chr(9)
Log(Format('Get RTTI (Class) for "%s"', [AClass.ClassName]));
LType := LContext.GetType(AClass.ClassInfo);
Items.Add(Tabs + 'RTTI for: ' + Ltype.Name);
Items.Add(Tabs + 'Package Name: ' + LType.Package.Name);
Items.Add(Tabs + '-- Properties --');
for Prop in LType.GetProperties do
begin
PropString := 'property: ' + Prop.Name;
PropInfo := GetPropInfo(AClass, Prop.Name);
PropString := PropString + ': ' + GetEnumName(TypeInfo(TTypeKind), Ord(Prop.PropertyType.TypeKind));
if propInfo <> nil then begin
PropString := PropString + ': ' + PropInfo^.PropType^.Name;
case propInfo.PropType^.Kind of
tkClass: begin
PropString := PropString + ' (Class)' ; // ' GetProp Value: ' + IntToHex(PropInfo.GetProc, 8); // Items.Add('--- Get RTTI ---');(Class)';
Log(Format('GetRTTI: %s (%s)', [Prop.Name, PropInfo^.PropType^.Name]));
// TODO: Get a reference to the object and call GetRTTI
// TODO: Or change function to work from classtype rather than object
// GetRTTIObject(### WHAT GOES HERE?!?!?, Items, Indent + 1);// := PropString + ' Class';
end;
end;
end;
Items.Add(Tabs + PropString);
end;
finally
LContext.Free;
end;
end;
Oops!!
I see I put the wrong function in.....the one in question takes a TObject and the assignment is:
LType := LContext.GetType((AObject.ClassInfo); (AObject.ClassType also seems to work...)....
Not at my dev station just now, but think everything else is the same after that....

Answer 1

Problem in your example that TBrash have property TBitMap, TBitMap have TCanvas, TCanvas have TBrash. Call of function GetRTTIClass will be infinite recursive. But if make condition for getting RTTI only one time for each class it is possible to fix your function.
uses System.Generics.Collections;
var ListClasses:TList<TClass>;
LContext : TRttiContext;
implementation
procedure TfrmMain.FormCreate(Sender: TObject);
begin
LContext := TRttiContext.Create();
ListClasses:=TList<TClass>.Create;
end;
procedure TfrmMain.GetRTTIClass(AClass: TClass; Items: TStrings; Indent: Integer);
var
LType: TRttiType;
Prop: TRttiProperty;
PropString: String;
Tabs: String;
I: Integer;
begin
if ListPrinted.Contains(AClass) then Exit
else ListPrinted.Add(AClass);
for I := 0 to Indent do Tabs := Tabs + ' ';
LType := LContext.GetType(AClass.ClassInfo);
Items.Add(Tabs + 'RTTI for: ' + Ltype.Name);
Items.Add(Tabs + 'Package Name: ' + LType.Package.Name);
Items.Add(Tabs + '-- Properties --');
for Prop in LType.GetProperties do begin
PropString := 'property: ' + Prop.Name;
PropString := PropString + ': ' + GetEnumName(TypeInfo(TTypeKind), Ord(Prop.PropertyType.TypeKind))+' '+Prop.PropertyType.Name;
Items.Add(Tabs + PropString);
case Prop.PropertyType.Handle^.Kind of
tkClass: begin
GetRTTIClass(Prop.PropertyType.Handle^.TypeData^.ClassType, Items,Indent+2);
end;
end;
end;
procedure TfrmMain.btn1Click(Sender: TObject);
begin
GetRTTIClass(TBaseClass, Items,0);
end;

Answer 2

Ok, I have made some modifications to the procedure. Parsing the class isn't quite sufficient. I need handles to instances.
To recursively call my procedure (the one that takes an object, not a class as the first parameter), I need the instance of the sub-object (AObj.Font, for example). I can acquire that with:
case Prop.PropertyType.TypeKind of
tkClass: begin
SubObj := GetObjectProp(AObj, Prop.Name);
GetRTTIObject2(SubObj, Tree, ChildNode, Indent + 2);
end;
end;
So simple, really, once I wrapped my head around it.
Still going to vote the other answer as the solution, since it gave good pointers on avoiding another pitfall. :)