Delphi RTTI 'Invalid class typecast'当分配记录类型的属性时

ua4mk5z4  于 2023-04-20  发布在  其他
关注(0)|答案(2)|浏览(338)

我使用 Delphi 记录类型来存储Double值,然后定义隐式操作符来处理赋值和转换到不同类型。对于简单的操作,一切都很好,但是当使用RTTI时,当试图将记录类型分配给另一个对象时,它会出现无效的类型转换。我试图创建一个通用的Map类,以便我可以迭代所有属性并使用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.
a1o7rhls

a1o7rhls1#

原因是微不足道的:TValue中的类型转换不考虑运算符重载。但是,在Spring 4D中有一个TValue的类型帮助器,它提供了转换方法。这些转换提供了不兼容赋值的类型之间的各种转换,例如from和to字符串转换。最重要的是,它们可以使用值转换器,但您需要显式连接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。如果该特性是可用的,我将合并它来开发。

3gtaxfhh

3gtaxfhh2#

在对上述内容进行了进一步的研究之后,我提出了一个不那么优雅但有效的解决方案。也许这是实现结果的唯一方法:

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;

欢迎任何其他想法或改进......请参阅我的评论以上回复:我很乐意使用TValueConverters来满足这个要求,因为我确信这就是它们的用途。

相关问题