Delphi の RTTI で record の情報取得(1/2)

Delphi 2010だったかで、機能追加された RTTI。 クラスなどのフィールド情報などを取得できる
( 2/2はこちら )

喜んで試してみたんだけど、class だけで record の情報は取得できない様子(できるのかもしれんが)
ただ、class メンバの record 型の情報は取れるので、ジェネリックスと絡めて record 型のメンバとデータを取得するクラスを作成してみた(後半のコード)

何がしたかったかというと、データ設定値などを record 型で作成して、レジストリやIniファイルへ保存するようなパターンで、フィールドが増えたときにいちいち保存や読込の所を修正しに行くのが面倒
TInifile を継承して、レコード型を渡すだけで、全て指定セクションに書き込んでちょ、みたいなのを最終的に利用できればよいと思う(SQLとのやりとりなんかにも)

Form1 に Button1 と Memo1 を貼って、TTestRecord のメンバと値を列挙する
(とりあえず String と Integer の例)

TRttiRecordField の Create で、型と実際の値を渡してやれば、あとはメソッドを呼び出すだけです

1. type  
2.     TTestRecord = record  
3.         Key: string;  
4.         Value: Integer;  
5.     end;  
6.   
7. procedure TForm1.Button1Click(Sender: TObject);  
8. var I: Integer;  
9.     S: string;  
10.     RecField: TRttiRecordField<TTestRecord>;  
11.     TestRecord: TTestRecord;  
12. begin  
13.     TestRecord.Key := 'Hello';  
14.     TestRecord.Value := 99;  
15.   
16.     RecField := TRttiRecordField<TTestRecord>.Create(TestRecord);  
17.     try  
18.         for I := RecField.Count - 1 downto 0 do begin  
19.             S := RecField.Name(I) + ' = ';  
20.   
21.             case RecField.ValueType(I) of  
22.                 tkInteger:  
23.                     S := S + IntToStr(RecField.Value(I).AsInteger);  
24.                 tkUString:  
25.                     S := S + RecField.Value(I).AsString;  
26.             end;  
27.   
28.             Memo1.Lines.Add(S);  
29.         end;  
30.     finally  
31.         RecField.Free;  
32.     end;  
33. end;  

type
    TTestRecord = record
        Key: string;
        Value: Integer;
    end;

procedure TForm1.Button1Click(Sender: TObject);
var I: Integer;
    S: string;
    RecField: TRttiRecordField<TTestRecord>;
    TestRecord: TTestRecord;
begin
    TestRecord.Key := 'Hello';
    TestRecord.Value := 99;

    RecField := TRttiRecordField<TTestRecord>.Create(TestRecord);
    try
        for I := RecField.Count - 1 downto 0 do begin
            S := RecField.Name(I) + ' = ';

            case RecField.ValueType(I) of
                tkInteger:
                    S := S + IntToStr(RecField.Value(I).AsInteger);
                tkUString:
                    S := S + RecField.Value(I).AsString;
            end;

            Memo1.Lines.Add(S);
        end;
    finally
        RecField.Free;
    end;
end;

以下 TRttiRecordField クラス (書き込みに対応したコードは、こちら)

1. unit RttiRecordFieldUnit;  
2. interface  
3.   
4. uses Classes, RTTI, TypInfo;  
5.   
6. type  
7.     TRttiRecordField<T> = class  
8.     private  
9.         FRecordData: T;  
10.         FCtx: TRttiContext;  
11.         FFields: TArray<TRttiField>;  
12.     public  
13.         constructor Create(ARecordData: T);  
14.         destructor Destroy; override;  
15.   
16.         function Count: Integer;  
17.         function ValueType(I: Integer): TTypeKind;  
18.         function Name(I: Integer): string;  
19.         function Value(I: Integer): TValue;  
20.     end;  
21.   
22. implementation  
23.   
24. { TRttiRecordField<T> }  
25.   
26. constructor TRttiRecordField<T>.Create(ARecordData: T);  
27. begin  
28.     FRecordData := ARecordData;  
29.     FCtx := TRttiContext.Create;  
30.     FFields := FCtx.GetType(TRttiRecordField<T>).GetField('FRecordData').FieldType.GetFields;  
31. end;  
32.   
33. destructor TRttiRecordField<T>.Destroy;  
34. begin  
35.     inherited;  
36.     FCtx.Free;  
37. end;  
38.   
39. function TRttiRecordField<T>.Count: Integer;  
40. begin  
41.     Result := Length(FFields);  
42. end;  
43.   
44. function TRttiRecordField<T>.Name(I: Integer): string;  
45. begin  
46.     Result := FFields[I].name;  
47. end;  
48.   
49. function TRttiRecordField<T>.ValueType(I: Integer): TTypeKind;  
50. begin  
51.     Result := FFields[I].FieldType.TypeKind;  
52. end;  
53.   
54. function TRttiRecordField<T>.Value(I: Integer): TValue;  
55. begin  
56.     Result := FFields[I].GetValue(@FRecordData);  
57. end;  
58.   
59. end.  

unit RttiRecordFieldUnit;
interface

uses Classes, RTTI, TypInfo;

type
    TRttiRecordField<T> = class
    private
        FRecordData: T;
        FCtx: TRttiContext;
        FFields: TArray<TRttiField>;
    public
        constructor Create(ARecordData: T);
        destructor Destroy; override;

        function Count: Integer;
        function ValueType(I: Integer): TTypeKind;
        function Name(I: Integer): string;
        function Value(I: Integer): TValue;
    end;

implementation

{ TRttiRecordField<T> }

constructor TRttiRecordField<T>.Create(ARecordData: T);
begin
    FRecordData := ARecordData;
    FCtx := TRttiContext.Create;
    FFields := FCtx.GetType(TRttiRecordField<T>).GetField('FRecordData').FieldType.GetFields;
end;

destructor TRttiRecordField<T>.Destroy;
begin
    inherited;
    FCtx.Free;
end;

function TRttiRecordField<T>.Count: Integer;
begin
    Result := Length(FFields);
end;

function TRttiRecordField<T>.Name(I: Integer): string;
begin
    Result := FFields[I].name;
end;

function TRttiRecordField<T>.ValueType(I: Integer): TTypeKind;
begin
    Result := FFields[I].FieldType.TypeKind;
end;

function TRttiRecordField<T>.Value(I: Integer): TValue;
begin
    Result := FFields[I].GetValue(@FRecordData);
end;

end.