Delphi RTTI でプロパティ名や型を再帰で取得

RTTIを用いて、プロパティの設定値をそのままファイルなどへ保存しようとしたが、項目がTFont等のクラスだったりすると中身を取得する必要があるので、再帰で取得

まぁ、できるにはできたんですが、Parent Child のような互いに参照する項目があると、循環が起きてしまうので、レベル(深さ)制限や除外リストなどが用途によって必要かもしれません
また、値がnilの項目は型を特定できないため、配下を参照できません(取得時には問題ないかも)

フォームへ Memo1(TMemo) と Button1(TButton)を貼り付けて、作成した ListProperties 関数で Button1 のプロパティを参照しています

uses へ System.Rtti を追加してください

view plainprint?

1. procedure TForm1.Button1Click(Sender: TObject);  
2. begin  
3.     Memo1.Lines.Clear;  
4.     ListProperties(Button1);  
5. end;  
6.   
7. procedure TForm1.ListProperties(Obj: TObject; Level: Integer = 0);  
8. var  
9.     RttiContext: TRttiContext;  
10.     RttiType: TRttiType;  
11.     RttiProp: TRttiProperty;  
12. begin  
13.     if (Obj = nil) then begin  
14.         Exit;  
15.     end;  
16.   
17.     if (Level > 3) then begin  
18.         // Exit;  
19.     end;  
20.   
21.     RttiContext := TRttiContext.Create;  
22.     try  
23.         RttiType := RttiContext.GetType(Obj.ClassInfo);  
24.         for RttiProp in RttiType.GetProperties do begin  
25.             Memo1.Lines.Add(StringOfChar(#9, Level) + RttiProp.Name + ': ' + RttiProp.PropertyType.ToString);  
26.   
27.             // 除外  
28.             if SameStr(RttiProp.PropertyType.ToString, 'TComponent') then Continue;  
29.             if SameStr(RttiProp.PropertyType.ToString, 'TWinControl') then Continue;  
30.   
31.             // tkClass は再帰  
32.             if (RttiProp.PropertyType.TypeKind = tkClass) then begin  
33.                 ListProperties(RttiProp.GetValue(Obj).AsObject, Level + 1);  
34.             end;  
35.         end;  
36.     finally  
37.         RttiContext.Free;  
38.     end;  
39. end;  

procedure TForm1.Button1Click(Sender: TObject);
begin
    Memo1.Lines.Clear;
    ListProperties(Button1);
end;

procedure TForm1.ListProperties(Obj: TObject; Level: Integer = 0);
var
    RttiContext: TRttiContext;
    RttiType: TRttiType;
    RttiProp: TRttiProperty;
begin
    if (Obj = nil) then begin
        Exit;
    end;

    if (Level > 3) then begin
        // Exit;
    end;

    RttiContext := TRttiContext.Create;
    try
        RttiType := RttiContext.GetType(Obj.ClassInfo);
        for RttiProp in RttiType.GetProperties do begin
            Memo1.Lines.Add(StringOfChar(#9, Level) + RttiProp.Name + ': ' + RttiProp.PropertyType.ToString);

            // 除外
            if SameStr(RttiProp.PropertyType.ToString, 'TComponent') then Continue;
            if SameStr(RttiProp.PropertyType.ToString, 'TWinControl') then Continue;

            // tkClass は再帰
            if (RttiProp.PropertyType.TypeKind = tkClass) then begin
                ListProperties(RttiProp.GetValue(Obj).AsObject, Level + 1);
            end;
        end;
    finally
        RttiContext.Free;
    end;
end;