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

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

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

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

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

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

みたいなのは OK ですが

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

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

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

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>

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.

IT漂着メモ

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

コメント