I'm using a Delphi record type to store a Double value and then defining Implicit operators to handle assignment & conversion to different types. Everything works great for simple operations, however when using RTTI it bombs out with an invalid typecast when trying to assign the record type to another object. I'm trying to create a generic mapping class so that I can iterate over all properties and assign them using RTTI, but I'm stuck on this issue. Code sample provided below with exception line marked...
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.
The reason is trivial: the type conversion in TValue
does not consider operator overloads. However, in Spring4D there is a type helper for TValue
that provides conversion methods. These conversions provide various conversions between types that are not assignment compatible such as from and to string conversions. On top of that they can use the value converters but you need to explicitly connect the ValueConverterCallback
for that to work as well as registering value converters for your type:
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));
However, that can become a little tedious when you already have the code to perform this conversion in the form of the implicit operators so I just implemented support for using them in TValue.TryConvert
- please look into the branch feature/implicit_conversion. If that feature turns out to be usable I will merge it to develop.