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

Delphi の RTTI(Delphi 2010以降) とジェネリックスを利用して record 型の情報取得

昨日のコードは、取得するだけで書き込む事を考えてなかったので、その辺りを変更
Create時の引数からポインタを保持して、record そのものを変更しに行く
これで、record の型と値を放り込んだら、レジストリやIniFileやSQLへの書き込みや、読み込みが可能になるクラスが作れます

独自のクラスを保存したい場合、FieldType の TypeKind へ tkClass が入るので、
if (Value.AsObject is TMyClass) then のようにクラスを判定して処理したり、さらに再帰して中身を分離したりできそう

ところで、ジェネリックスで与えられた型を使って、汎用ポインタからキャストって出来ないんですかね

1. var D: T;  
2.     P: ^T;  
3. begin  
4.     D := P^;  
5. end;  

var D: T;
    P: ^T;
begin
    D := P^;
end;

みたいなのは OK ですが

1. var D: T;  
2.     P: Pointer;  
3. begin  
4.     P := @D;  
5.     D := T(P); // NG  
6.     D := (P as T); // NG  
7.     D := <T>(P); // NG  
8. end;  

var D: T;
    P: Pointer;
begin
    P := @D;
    D := T(P); // NG
    D := (P as T); // NG
    D := <T>(P); // NG
end;

みたいなのは、NGで一方通行なんです

昨日と似たコード(Value がプロパティに変更され、引数のカッコを変更)で、書き込みをしている

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

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

    RecField := TRttiRecordField.Create(TestRecord);
    try
        for I := RecField.Count - 1 downto 0 do begin
            S := RecField.Name[I];

            case RecField.ValueType(I) of
                tkInteger:
                    ValueStr := IntToStr(RecField.Value[I].AsInteger);
                tkUString:
                    ValueStr := RecField.Value[I].AsString;
            else
                ValueStr := '[else]';
            end;

            if (S = 'Key') then begin
                RecField.Value[I] := 'Goodbye';
            end;

            Memo1.Lines.Add(S + ' = ' + ValueStr);
        end;
    finally
        RecField.Free;
    end;

    Memo1.Lines.Add(TestRecord.Key);
end;

以下 TRttiRecordField<T>

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

unit RttiRecordFieldUnit;

interface

uses Classes, RTTI, TypInfo;

type
    TRttiRecordField<T> = class
    private
        FRecData: T;
        PRecData: Pointer;

        FCtx: TRttiContext;
        FFields: TArray<TRttiField>;

        function GetValue(I: Integer): TValue;
        procedure SetValue(I: Integer; AValue: TValue);
        function GetName(I: Integer): string;
    public
        constructor Create(var ARecData: T);
        destructor Destroy; override;

        function Count: Integer;
        function ValueType(I: Integer): TTypeKind;
        property Name[I: Integer]: string read GetName;
        property Value[I: Integer]: TValue read GetValue write SetValue;
    end;

implementation

{ TRttiRecordField<T> }

constructor TRttiRecordField<T>.Create(var ARecData: T);
begin
    PRecData := @ARecData;
    // FRecData := ARecData;

    FCtx := TRttiContext.Create;
    FFields := FCtx.GetType(TRttiRecordField<T>).GetField('FRecData').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>.GetName(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>.GetValue(I: Integer): TValue;
begin
    Result := FFields[I].GetValue(PRecData);
end;

procedure TRttiRecordField<T>.SetValue(I: Integer; AValue: TValue);
begin
    FFields[I].SetValue(PRecData, AValue);
end;

end.