【问题标题】:Delphi RTTI to iterate properties of Generic record typeDelphi RTTI 迭代通用记录类型的属性
【发布时间】:2017-10-19 14:05:32
【问题描述】:

我有几个具有简单类型(整数、布尔值、字符串)和一些 Nullable 属性的类:

  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;

例如。

  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;

等等……

鉴于 TCommonAncestor 的后代,我想使用 RTTI 迭代所有公共属性并列出它们的名称和值,除非它是一个 Nullable,其中 T.HasValue 返回 false。

我正在使用 Delphi XE2。

编辑:添加了我目前的内容。

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;

【问题讨论】:

  • 到目前为止,您尝试了哪些方法来解决这个问题?公共属性无法通过传统 RTTI(System.TypInfo 单元)访问,因此您必须使用扩展 RTTI(System.Rtti 单元)
  • 我已经修改了我的问题以表明我正在尝试使用 System.Rtti
  • 无法使用 RTTI 访问记录属性。您将不得不改为使用记录字段。
  • @LU RD 你能详细说明一下吗?
  • @LURD: How to access record properties? 询问如何访问记录类型内部的属性,由于缺少记录属性的 RTTI,这确实不起作用。但这不是这个问题的目的。这个问题是询问如何访问记录类型的属性,并且与 RTTI 配合得很好。

标签: delphi generics delphi-xe2


【解决方案1】:

以下内容在 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;

【讨论】:

  • @Remy 优秀的解决方案,非常感谢。你拯救了我的一天。
  • 你好@Remy 很棒的解决方案,但是 SetValue 的 nullable 呢?如果我在这里提出问题,你会为我回答吗?
  • @Rebelss SetValue() 到底怎么样?你有什么问题?
  • @Remi 在这里,我试图以问题的形式提出:stackoverflow.com/questions/62704576/…
猜你喜欢
  • 2012-07-06
  • 1970-01-01
  • 2011-01-30
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2010-10-11
  • 1970-01-01
相关资源
最近更新 更多