Hi,
I would like ask for your opinion in this case.
I found, that in this sample program is raised "Invalid variant ..."
var bcd1: TBCD;
v,v1: variant;
s: string;
begin
bcd1:=2;
v1:=varfmtbcdcreate(bcd1);
s:=v1; //assigment from customvariant to string is not handled in
sysvartolstr()
end;
I can fix it by following fixs:
1. fmtbcd_castto.diff ... added case when castto varString is requested
... then do not use cast throught varDouble (to avoid lost of
precision), but convert directly from TBCD to string
2. variants.pp ... here we must add handling of customvariants into
sysvartolstr ... I created "helper" function TryCastFromCustomVariant
which can be used multiple times (now in sysvartolstr and sysvartoreal)
... I isolate in this function code which is required multiple times.
I am not sure if
1. is this optimal approach, or is better to put same code repeatedly in
sysvartolstrm sysvartoreal and in future in others sysvarto... ?
2. is the name and place of such function good choosen ?
Can somebody look at it, and commit what is good and change what is not
good ;-) ?
Thanks
-Laco.
--- f:\tmp\fmtbcd.pp.old Mon Mar 21 07:37:34 2011
+++ f:\tmp\fmtbcd.pp Wed Mar 23 10:34:38 2011
@@ -4006,9 +3992,18 @@ begin
begin
VarDataInit(v);
try
- v.vType:=varDouble;
- v.vDouble:=TFMTBcdVarData(Source.vPointer).BCD;
- VarDataCastTo(Dest, v, aVarType); //now cast Double to any requested type
+ if aVarType = varString then
+ begin
+ Dest.vType:=varString;
+ Dest.vString:=nil;
+
AnsiString(Dest.vString):=BCDToStr(TFMTBcdVarData(Source.vPointer).BCD);
+ end
+ else
+ begin
+ v.vType:=varDouble;
+ v.vDouble:=BCDToDouble(TFMTBcdVarData(Source.vPointer).BCD);
+ VarDataCastTo(Dest, v, aVarType); //now cast Double to any requested
type
+ end;
finally
VarDataClear(v);
end;
--- f:\tmp\variants.pp.ori Thu Dec 2 10:03:42 2010
+++ f:\tmp\variants.pp Wed Mar 23 10:32:52 2011
@@ -602,7 +602,6 @@ begin
TVarData(V).vType := varEmpty;
end;
-
procedure sysvarclear(var v : Variant);
begin
if TVarData(v).vType and varComplexType <> 0 then
@@ -611,6 +610,16 @@ begin
TVarData(v).vType := varEmpty;
end;
+function TryCastFromCustomVariant(const v : Variant; const aVarType: TVarType;
out Dest: TVarData):boolean;
+var Handler: TCustomVariantType;
+begin
+ Result:=FindCustomVariantType(TVarData(v).vType, Handler);
+ if Result then
+ begin
+ VariantInit(Dest);
+ Handler.CastTo(dest, TVarData(v), aVarType);
+ end;
+end;
function Sysvartoint (const v : Variant) : Integer;
begin
@@ -661,20 +670,15 @@ end;
{$ifndef FPUNONE}
function sysvartoreal (const v : Variant) : Extended;
-var Handler: TCustomVariantType;
- dest: TVarData;
+var dest: TVarData;
begin
if VarType(v) = varNull then
if NullStrictConvert then
VarCastError(varNull, varDouble)
else
Result := 0
- else if FindCustomVariantType(TVarData(v).vType, Handler) then
- begin
- VariantInit(dest);
- Handler.CastTo(dest, TVarData(v), varDouble);
- Result := dest.vDouble;
- end
+ else if TryCastFromCustomVariant(v, varDouble, dest) then
+ Result := dest.vDouble
else
Result := VariantToDouble(TVarData(V));
end;
@@ -694,12 +698,15 @@ end;
procedure sysvartolstr (var s : AnsiString; const v : Variant);
+var dest: TVarData;
begin
if VarType(v) = varNull then
if NullStrictConvert then
VarCastError(varNull, varString)
else
s := NullAsStringValue
+ else if TryCastFromCustomVariant(v, varString, dest) then
+ s := AnsiString(dest.vString)
else
S := VariantToAnsiString(TVarData(V));
end;
_______________________________________________
fpc-devel maillist - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel
