Delphi RTTI 对象检查器

如何解决Delphi RTTI 对象检查器

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

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

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

我似乎得到了一个 Value := GetPropValue(AObj,Prop.Name);

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

问候，罗布

定义了简化的测试类：

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 似乎也有效.......

现在不在我的开发站，但认为之后一切都一样......

解决方法

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

Toolbar

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

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

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

太简单了，真的，一旦我把头绕过去。

仍将投票其他答案作为解决方案，因为它为避免另一个陷阱提供了很好的指示。 :)