Delphi RTTI 在分配记录类型的属性时“无效的类类型转换”

问题描述 投票:0回答:2

我正在使用 Delphi 记录类型来存储 Double 值,然后定义隐式运算符来处理不同类型的赋值和转换。一切都适用于简单的操作,但是当使用 RTTI 时,它会在尝试将记录类型分配给另一个对象时用无效的类型转换轰炸。我正在尝试创建一个通用映射类,以便我可以遍历所有属性并使用 RTTI 分配它们,但我被困在这个问题上。下面提供的代码示例带有标记为...

的异常行
program RecordAssigner;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Rtti,
  System.SysUtils;

type

  TLength = record
  private
    FValue: Double;
  public
    class operator Implicit(A: Double): TLength;
    class operator Implicit(A: TLength): Double;
    class operator Implicit(A: TLength): string;
    class operator Implicit(A: string): TLength;
  end;

  TMyClassNormal = class
  private
    FMyDouble: Double;
    FMyLength: TLength;
  public
    property MyDouble: Double read FMyDouble write FMyDouble;
    property MyLength: TLength read FMyLength write FMyLength;
  end;

  TMyClassInverted = class
  private
    FMyDouble: TLength;
    FMyLength: Double;
  public
    property MyDouble: TLength read FMyDouble write FMyDouble;
    property MyLength: Double read FMyLength write FMyLength;
  end;

class operator TLength.Implicit(A: Double): TLength;
begin
  Result.FValue := A;
end;

class operator TLength.Implicit(A: TLength): Double;
begin
  Result := A.FValue;
end;

class operator TLength.Implicit(A: string): TLength;
begin
  Result.FValue := StrToFloat(A);
end;

class operator TLength.Implicit(A: TLength): string;
begin
  Result := Format('%f inches', [A.FValue]);
end;

procedure WriteObject(ANormalObject: TMyClassNormal; AInvertedObject: TMyClassInverted; APass: string);
begin
  Writeln('Pass #', APass);
  Writeln('Normal Class Double: ', FloatToStr(ANormalObject.MyDouble));
  Writeln('Normal Class Length: ', FloatToStr(ANormalObject.MyLength));
  Writeln('Normal Class Length (as string): ', string(ANormalObject.MyLength));
  Writeln('Inverted Class Double: ', FloatToStr(AInvertedObject.MyDouble));
  Writeln('Inverted Class Double (as string): ', string(AInvertedObject.MyDouble));
  Writeln('Inverted Class Length: ', FloatToStr(AInvertedObject.MyLength));
  Writeln('');
end;

var
  LNormalObject: TMyClassNormal;
  LInvertedObject: TMyClassInverted;

  LContext: TRttiContext;
  SourceType: TRttiType;
  LTargetProp: TRttiProperty;
begin
  LNormalObject := TMyClassNormal.Create;
  LInvertedObject := TMyClassInverted.Create;
  try
    try
      LNormalObject.MyDouble := 1;
      LNormalObject.MyLength := 2;
      LInvertedObject.MyDouble := LNormalObject.MyDouble;
      LInvertedObject.MyLength := LNormalObject.MyLength;
      WriteObject(LNormalObject, LInvertedObject, '1');

      LNormalObject.MyDouble := 3;
      LNormalObject.MyLength := '4';
      LInvertedObject.MyDouble := LNormalObject.MyDouble;
      LInvertedObject.MyLength := LNormalObject.MyLength;
      WriteObject(LNormalObject, LInvertedObject, '2');

      LNormalObject.MyDouble := 5;
      LNormalObject.MyLength := 6;

      SourceType := LContext.GetType(LNormalObject.ClassInfo);
      for LTargetProp in LContext.GetType(LInvertedObject.ClassInfo).GetProperties do
        LTargetProp.SetValue(LInvertedObject, SourceType.GetProperty(LTargetProp.Name).GetValue(LNormalObject));   // FAILING HERE

      WriteObject(LNormalObject, LInvertedObject, '3');

      Readln;
    except
      on E: Exception do
        Writeln(E.ClassName, ': ', E.Message);
    end;
  finally
    LNormalObject.Free;
    LInvertedObject.Free;
  end;

  ReportMemoryLeaksOnShutdown := True;
end.
delphi rtti spring4d
2个回答
0
投票

在对上述进行进一步研究后,提出了一个不太优雅但可行的解决方案。也许这是实现结果的唯一已知方法:

  for LTargetProp in LContext.GetType(LInvertedObject.ClassInfo).GetProperties do
  begin
    if LTargetProp.PropertyType.Name = 'TLength' then
    begin
      LLength := TLength.Create(SourceType.GetProperty(LTargetProp.Name).GetValue(LNormalObject).AsType<Double>);
      TValue.Make(@LLength, TypeInfo(TLength), LValue);
      LTargetProp.SetValue(LInvertedObject, LValue);
    end
    else
    begin
      LLength := SourceType.GetProperty(LTargetProp.Name).GetValue(LNormalObject).AsType<TLength>;
      LDouble := LLength;
      TValue.Make(@LDouble, TypeInfo(Double), LValue);
      LTargetProp.SetValue(LInvertedObject, LValue);
    end;
  end;

欢迎任何其他想法或改进...... 请参阅我上面的评论:Spring4D。 我很乐意使用 TValueConverters 来满足这个要求,因为我很肯定这就是它们的构建目的。


0
投票

原因很简单:

TValue
中的类型转换没有考虑运算符重载。但是,在 Spring4D 中有一个
TValue
的类型助手,它提供了转换方法。这些转换提供了与赋值不兼容的类型之间的各种转换,例如从和到字符串的转换。最重要的是,他们可以使用值转换器,但您需要显式连接
ValueConverterCallback
才能正常工作,并为您的类型注册值转换器:

type
  TLengthToDoubleConverter = class(TValueConverter)
    function DoConvertTo(const value: TValue; const targetTypeInfo: PTypeInfo;
      const parameter: TValue): TValue; override;
  end;

  TDoubleToLengthConverter = class(TValueConverter)
    function DoConvertTo(const value: TValue; const targetTypeInfo: PTypeInfo;
      const parameter: TValue): TValue; override;
  end;

function TLengthToDoubleConverter.DoConvertTo(const value: TValue;
  const targetTypeInfo: PTypeInfo; const parameter: TValue): TValue;
begin
  Result := Double(value.AsType<TLength>);
end;

function TDoubleToLengthConverter.DoConvertTo(const value: TValue;
  const targetTypeInfo: PTypeInfo; const parameter: TValue): TValue;
begin
  Result := TValue.From<TLength>(value.AsType<Double>);
end;

function TryConvertTo(const value: TValue; const targetTypeInfo: PTypeInfo;
  var targetValue: TValue; const parameter: TValue): Boolean;
begin
  Result := TValueConverter.Default.TryConvertTo(value, targetTypeInfo, targetValue, parameter);
end;

procedure InitConverters;
begin
  TValue.ValueConverterCallback := TryConvertTo;
end;

begin
  TValue.ValueConverterCallback := TryConvertTo;
  TValueConverterFactory.RegisterConverter(TypeInfo(TLength), TypeInfo(Double), TLengthToDoubleConverter);
  TValueConverterFactory.RegisterConverter(TypeInfo(Double), TypeInfo(TLength), TDoubleToLengthConverter);

  ...

  for LTargetProp in LContext.GetType(LInvertedObject.ClassInfo).GetProperties do
    LTargetProp.SetValue(LInvertedObject, SourceType.GetProperty(LTargetProp.Name).GetValue(LNormalObject).Convert(LTargetProp.PropertyType.Handle));

但是,当您已经拥有以隐式运算符的形式执行此转换的代码时,这可能会变得有点乏味,因此我刚刚实现了对在

TValue.TryConvert
中使用它们的支持 - 请查看分支功能/implicit_conversion。如果该功能被证明是可用的,我将把它合并到开发中。

© www.soinside.com 2019 - 2024. All rights reserved.