Delphi RTTI 对象检查器

Question

我正在尝试为我正在编写的绘图应用构建一个简化的对象检查器。

我正在尝试为所选对象及其子对象动态获取 RTTI。如果给定的属性是 class (tkClass)，我想递归调用 GetRTTIObject，将属性作为对象来获取它的“子属性”（即 BaseObj.Brush.Color 或 BaseObj.Pen.Width 等）。我怀疑我想传递那个对象的实例，当有人指出它是什么时，它会非常明显。如何让实例传递给我的函数？或者我应该查看 TRttiInstance 的属性 classes....?

我知道它在“级别 0”下工作，因为我可以将 BaseObject.Brush 传递到我第一次调用 GetRTTIObject 并获得 TBrush 属性列表。如何递归向下钻取？

我似乎得到了某种指针 Value := GetPropValue(AObj, Prop.Name);

我是否以某种方式取消引用以获取我的实例...？

此致，罗布

简化测试class定义：

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;

我的 RTTI 程序是：

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;

哎呀！！

我看到我放错了函数.....有问题的那个接受了一个 TObject 并且赋值是：

LType := LContext.GetType((AObject.ClassInfo); (AObject.ClassType 似乎也有效...)...

刚才不在我的开发站，但认为其他一切都一样....

Answer 1

你的例子中的问题是 TBrash 有属性 TBitMap，TBitMap 有 TCanvas，TCanvas 有 TBrash。函数 GetRTTIClass 的调用将无限递归。但是，如果为每个 class 设置一次仅获取 RTTI 的条件，则可以修复您的功能。

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

好的，我对程序做了一些修改。解析 class 还不够。我需要实例句柄。

要递归调用我的过程（以对象而不是 class 作为第一个参数的过程），我需要子对象的实例（例如 AObj.Font） .我可以通过以下方式获得它：

case Prop.PropertyType.TypeKind of
  tkClass: begin
    SubObj := GetObjectProp(AObj, Prop.Name);
    GetRTTIObject2(SubObj, Tree, ChildNode, Indent + 2);
  end;
end;

真的很简单，一旦我全神贯注。

仍然会投票给另一个答案作为解决方案，因为它为避免另一个陷阱提供了很好的指导。 :)

Delphi RTTI 对象检查器

Delphi RTTI Object Inspector

delphi

properties

class

instance

rtti