Delphi の interface のプロパティを RTTI で取得

Delphi の interface のプロパティを RTTI で取得

インタフェイスから直接取り出せないため、元のクラスにキャストして取得

キャスト可能なのは Delphi2010以降だそうです

view plainprint?

1. uses System.Rtti;  
2.   
3. type  
4.     ITest = interface  
5.         function GetValue: string;  
6.         procedure SetValue(const Value: string);  
7.   
8.         property Value: string read GetValue write SetValue;  
9.     end;  
10.   
11.     TTest = class(TInterfacedObject, ITest)  
12.     private  
13.         FValue: string;  
14.         function GetValue: string;  
15.         procedure SetValue(const Value: string);  
16.     public  
17.         property Value: string read GetValue write SetValue;  
18.     end;  
19.       
20. // :::::  
21.   
22. procedure TForm1.Button1Click(Sender: TObject);  
23. var  
24.     Test: ITest;  
25.     TestObj: TTest;  
26.   
27.     RttiContext: TRttiContext;  
28.     RttiType: TRttiType;  
29.     RttiProp: TRttiProperty;  
30. begin  
31.     Test := TTest.Create;  
32.     Test.Value := 'interface rtti';  
33.   
34.     // 元のクラスにキャスト  
35.     TestObj := TTest(Test);  
36.   
37.     RttiContext := TRttiContext.Create;  
38.     try  
39.         RttiType := RttiContext.GetType(TestObj.ClassInfo);  
40.         for RttiProp in RttiType.GetProperties do begin  
41.             Memo1.Lines.Add('Name: ' + RttiProp.Name);  
42.             Memo1.Lines.Add('Type: ' + RttiProp.PropertyType.ToString);  
43.   
44.             if SameText(RttiProp.PropertyType.ToString, 'string') then begin  
45.                 Memo1.Lines.Add('Value: ' + RttiProp.GetValue(TestObj).AsString);  
46.             end  
47.             else if SameText(RttiProp.PropertyType.ToString, 'integer') then begin  
48.                 Memo1.Lines.Add('Value: ' + IntToStr(RttiProp.GetValue(TestObj).AsInteger));  
49.             end;  
50.   
51.         end;  
52.     finally  
53.         RttiContext.Free;  
54.     end;  
55. end;  

uses System.Rtti;

type
    ITest = interface
        function GetValue: string;
        procedure SetValue(const Value: string);

        property Value: string read GetValue write SetValue;
    end;

    TTest = class(TInterfacedObject, ITest)
    private
        FValue: string;
        function GetValue: string;
        procedure SetValue(const Value: string);
    public
        property Value: string read GetValue write SetValue;
    end;
    
// :::::

procedure TForm1.Button1Click(Sender: TObject);
var
    Test: ITest;
    TestObj: TTest;

    RttiContext: TRttiContext;
    RttiType: TRttiType;
    RttiProp: TRttiProperty;
begin
    Test := TTest.Create;
    Test.Value := 'interface rtti';

    // 元のクラスにキャスト
    TestObj := TTest(Test);

    RttiContext := TRttiContext.Create;
    try
        RttiType := RttiContext.GetType(TestObj.ClassInfo);
        for RttiProp in RttiType.GetProperties do begin
            Memo1.Lines.Add('Name: ' + RttiProp.Name);
            Memo1.Lines.Add('Type: ' + RttiProp.PropertyType.ToString);

            if SameText(RttiProp.PropertyType.ToString, 'string') then begin
                Memo1.Lines.Add('Value: ' + RttiProp.GetValue(TestObj).AsString);
            end
            else if SameText(RttiProp.PropertyType.ToString, 'integer') then begin
                Memo1.Lines.Add('Value: ' + IntToStr(RttiProp.GetValue(TestObj).AsInteger));
            end;

        end;
    finally
        RttiContext.Free;
    end;
end;