Delphi RTTI Object Inspector

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;