我正在使用 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.
在对上述进行进一步研究后,提出了一个不太优雅但可行的解决方案。也许这是实现结果的唯一已知方法:
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 来满足这个要求,因为我很肯定这就是它们的构建目的。
原因很简单:
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。如果该功能被证明是可用的,我将把它合并到开发中。