Class Delphi RTTI对象检查器

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

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

我知道它在“0级”工作，因为我可以将BaseObject.Brush传递到我对GetRTTIObject的第一个调用，然后我会得到一个TBrush属性列表。如何递归地向下钻取

我似乎得到了一个具有以下值的指针：=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;

procedure TfrmMain.GetRTTIClass（AClass:TClass；Items:TStrings；Indent:Integer）；
变量
LContext:trttitcontext；
l型：trtti型；
财产：信托财产；
PropString：字符串；
PropInfo:PPropInfo；
标签：字符串；
I：整数；
值：变量；
开始
LContext:=TRttiContext.Create（）；
尝试
对于I:=0，缩进do
制表符：=制表符+“”//chr（9）
日志（格式（'Get RTTI（Class）for“%s”，[AClass.ClassName]）；
LType:=LContext.GetType（AClass.ClassInfo）；
添加（制表符+RTTI for:'+Ltype.Name）；
Items.Add（制表符+“包名称：”+LType.Package.Name）；
添加（Tabs+'--Properties--'）；
对于LType.GetProperties中的Prop
开始
PropString:=“属性：”+属性名称；
PropInfo:=GetPropInfo（AClass，Prop.Name）；
PropString:=PropString+'：'+GetEnumName（TypeInfo（TTypeKind），Ord（Prop.PropertyType.TypeKind））；
如果为零，则开始
PropString:=PropString+'：'+PropInfo^.PropType^.Name；
案例propInfo.PropType^.种类
tkClass:开始
PropString:=PropString+'（类）；//'GetProp值：'+IntToHex（PropInfo.GetProc，8）；//Items.Add（'--Get RTTI---'）；(类别)";；
日志（格式（'GetRTTI:%s（%s）][Prop.Name，PropInfo^.PropType^.Name]）；
//TODO:获取对对象的引用并调用GetRTTI
//TODO:或将函数更改为从类类型而不是对象工作
//GetRTTIObject（#####这里是什么？！？，项目，缩进+1）；/：=PropString+“类”；
结束；
结束；
结束；
Items.Add（Tabs+PropString）；
结束；
最后
LContext.Free；
结束；
结束；

哎呀

我发现我把错误的函数放进了……这个函数取了一个TObject，赋值是：

LType:=LContext.GetType（（AObject.ClassInfo）；（AObject.ClassType似乎也能工作…）

---

现在不是在我的开发站，但在那之后，我认为其他一切都是一样的。…

在您的示例中，TBrash有属性TBitMap，TBitMap有TCanvas，TCanvas有TBrash。函数GetRTTIClass的调用将是无限递归的。但是如果为每个类设置一次获取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;

使用System.Generics.Collections；
var列表类：TList；
LContext:trttitcontext；
实施
过程TfrmMain.FormCreate（发送方：TObject）；
开始
LContext:=TRttiContext.Create（）；
ListClasses:=TList.Create；
结束；
过程TfrmMain.GetRTTIClass（AClass:TClass；Items:TStrings；Indent:Integer）；
变量
l型：trtti型；
财产：信托财产；
PropString：字符串；
标签：字符串；
I：整数；
开始
如果ListPrinted.Contains（AClass），则退出
else list printed.Add（AClass）；
对于I:=0，缩进do制表符：=制表符+“”；
LType:=LContext.GetType（AClass.ClassInfo）；
添加（制表符+RTTI for:'+Ltype.Name）；
Items.Add（制表符+“包名称：”+LType.Package.Name）；
添加（Tabs+'--Properties--'）；
对于LType.GetProperties中的Prop，不开始
PropString:=“属性：”+属性名称；
PropString:=PropString+'：'+GetEnumName（TypeInfo（TTypeKind），Ord（Prop.PropertyType.TypeKind））+''+Prop.PropertyType.Name；
Items.Add（Tabs+PropString）；
case Prop.PropertyType.Handle^.类
tkClass:开始
GetRTTIClass（Prop.PropertyType.Handle^.TypeData^.ClassType，Items，缩进+2）；
结束；
结束；
结束；
过程TfrmMain.btn1Click（发送方：TObject）；
开始
GetRTTIClass（TBaseClass，Items，0）；
结束；

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

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

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

很简单，真的，只要我把头绕过去

---

仍然要投票选择另一个答案作为解决方案，因为它为避免另一个陷阱提供了很好的指导。：）

感谢您的回复！！！一些问题：2）为什么要在FormCreate中而不是在GetRTTI过程中创建RTTIContext…？3）我在哪里可以找到有关符号“ListClass:TList”和“TList.create”的更多信息。。。。？