简体   繁体   English

Delphi RTTI迭代通用记录类型的属性

[英]Delphi RTTI to iterate properties of Generic record type

I have several classes with properties of simple types (Integer, Boolean, string) and some Nullable's: 我有几个具有简单类型(整数,布尔值,字符串)和一些可空值的属性的类:

  Nullable<T> = record
  private
    FValue: T;
    FHasValue: IInterface;
    function GetValue: T;
    function GetHasValue: Boolean;
  public
    constructor Create(AValue: T);
    property HasValue: Boolean read GetHasValue;
    property Value: T read GetValue;
  end;

Eg. 例如。

  TMyClass1 = class(TCommonAncestor)
    private
      FNumericvalue: Double;
      FEventTime: Nullable<TDateTime>;
    public 
      property NumericValue: Double read FNumericValue write FNumericValue;
      property EventTime: Nullable<TDateTime> read FEventTime write FEventTime;   
  end;

and

  TMyClass2 = class(TCommonAncestor)
    private
      FCount: Nullable<Integer>;
      FName: string;
    public 
      property Count: Nullable<Integer> read FCount write FCount;
      property Name: string read FName write FName;   
  end;

etc.... 等等....

Given a descendant of TCommonAncestor, I would like to use RTTI to iterate all public properties and list their name and value, unless it is a Nullable where T.HasValue returns false. 给定TCommonAncestor的后代,我想使用RTTI来迭代所有公共属性并列出它们的名称和值,除非它是T.HasValue返回false的Nullable。

I am using Delphi XE2. 我正在使用Delphi XE2。

EDIT: added what I have so far. 编辑:添加了我到目前为止。

procedure ExtractValues(Item: TCommonAncestor);
var
  c : TRttiContext;
  t : TRttiType;
  p : TRttiProperty;
begin
  c := TRttiContext.Create;
  try
    t := c.GetType(Item.ClassType);
    for p in t.GetProperties do
    begin
      case p.PropertyType.TypeKind of
        tkInteger:
          OutputDebugString(PChar(Format('%se=%s', [p.Name,p.GetValue(Item).ToString]));
        tkRecord:
        begin
          // for Nullable<Double> p.PropertyType.Name contains 'Nullable<System.Double>'
          // but how do I go about accessing properties of this record-type field?
        end;
      end;
    end;
  finally
    c.Free;
  end;
end;

The following works for me in XE2: 在XE2中,以下对我有用:

uses
  System.SysUtils, System.TypInfo, System.Rtti, System.StrUtils, Winapi.Windows;

type
  Nullable<T> = record
  private
    FValue: T;
    FHasValue: IInterface;
    function GetHasValue: Boolean;
    function GetValue: T;
    procedure SetValue(const AValue: T);
  public
    constructor Create(AValue: T);
    function ToString: string; // <-- add this for easier use!
    property HasValue: Boolean read GetHasValue;
    property Value: T read GetValue write SetValue;
  end;

  TCommonAncestor = class
  end;

  TMyClass1 = class(TCommonAncestor)
  private
    FNumericvalue: Double;
    FEventTime: Nullable<TDateTime>;
  public
    property NumericValue: Double read FNumericValue write FNumericValue;
    property EventTime: Nullable<TDateTime> read FEventTime write FEventTime;
  end;

  TMyClass2 = class(TCommonAncestor)
  private
    FCount: Nullable<Integer>;
    FName: string;
  public
    property Count: Nullable<Integer> read FCount write FCount;
    property Name: string read FName write FName;
  end;

...

constructor Nullable<T>.Create(AValue: T);
begin
  SetValue(AValue);
end;

function Nullable<T>.GetHasValue: Boolean;
begin
  Result := FHasValue <> nil;
end;

function Nullable<T>.GetValue: T;
begin
  if HasValue then
    Result := FValue
  else
    Result := Default(T);
end;

procedure Nullable<T>.SetValue(const AValue: T);
begin
  FValue := AValue;
  FHasValue := TInterfacedObject.Create;
end;

function Nullable<T>.ToString: string;
begin
  if HasValue then
  begin
    // TValue.ToString() does not output T(Date|Time) values as date/time strings,
    // it outputs them as floating-point numbers instead, so do it manually...
    if TypeInfo(T) = TypeInfo(TDateTime) then
      Result := DateTimeToStr(PDateTime(@FValue)^)
    else if TypeInfo(T) = TypeInfo(TDate) then
      Result := DateToStr(PDateTime(@FValue)^)
    else if TypeInfo(T) = TypeInfo(TTime) then
      Result := TimeToStr(PDateTime(@FValue)^)
    else
      Result := TValue.From<T>(FValue).ToString;
  end
  else
    Result := '(null)';
end;

procedure ExtractValues(Item: TCommonAncestor);
var
  c : TRttiContext;
  t : TRttiType;
  p : TRttiProperty;
  v : TValue;
  m : TRttiMethod;
  s : string;
begin
  c := TRttiContext.Create;

  t := c.GetType(Item.ClassType);
  for p in t.GetProperties do
  begin
    case p.PropertyType.TypeKind of
      tkRecord:
      begin
        if StartsText('Nullable<', p.PropertyType.Name) then
        begin
          // get Nullable<T> instance...
          v := p.GetValue(Item);
          // invoke Nullable<T>.ToString() method on that instance...
          m := c.GetType(v.TypeInfo).GetMethod('ToString');
          s := m.Invoke(v, []).AsString;
        end else
          s := Format('(record type %s)', [p.PropertyName.Name]);
      end;
    else
      s := p.GetValue(Item).ToString;
    end;
    OutputDebugString(PChar(Format('%s=%s', [p.Name, s])))
  end;
end;

var
  Item1: TMyClass1;
  Item2: TMyClass2;
begin
  Item1 := TMyClass1.Create;
  try
    Item1.NumericValue := 123.45;
    Item1.EventTime.SetValue(Now);
    ExtractValues(Item1);
    { Output: 
      NumericValue=123.45
      EventTime=10/19/2017 1:25:05 PM
    }
  finally
    Item1.Free;
  end;

  Item1 := TMyClass1.Create;
  try
    Item1.NumericValue := 456.78;
    //Item1.EventTime.SetValue(Now);
    ExtractValues(Item1);
    { Output: 
      NumericValue=456.78
      EventTime=(null)
    }
  finally
    Item1.Free;
  end;

  Item2 := TMyClass2.Create;
  try
    Item2.Count.SetValue(12345);
    Item2.Name := 'test';
    ExtractValues(Item2);
    { Output: 
      Count=12345
      Name=test
    }
  finally
    Item2.Free;
  end;

  Item2 := TMyClass2.Create;
  try
    //Item2.Count.SetValue(12345);
    Item2.Name := 'test2';
    ExtractValues(Item2);
    { Output: 
      Count=(null)
      Name=test2
    }
  finally
    Item2.Free;
  end;
end;

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM