* BCD improvements based on a patch from LacaK

  * fmtbcd.pp: convert BCD to strings directly (without intermediate conversion to Double) to avoid loss of precision.
  + variants.pp: support custom variants in Variant->AnsiString conversions.

git-svn-id: trunk@17170 -

rtl/inc/variants.pp

@@ -670,6 +670,7 @@ begin
       VarCastError(varNull, varDouble)
     else
       Result := 0
+  { TODO: performance: custom variants must be handled after standard ones }
   else if FindCustomVariantType(TVarData(v).vType, Handler) then
   begin
     VariantInit(dest);
@@ -693,6 +694,21 @@ begin
     Result := VariantToCurrency(TVarData(V));
 end;
 
+function CustomVarToLStr(const v: TVarData; out s: AnsiString): Boolean;
+var
+  handler: TCustomVariantType;
+  temp: TVarData;
+begin
+  result := FindCustomVariantType(v.vType, handler);
+  if result then
+  begin
+    VariantInit(temp);
+    handler.CastTo(temp, v, varString);
+    { out-semantic ensures that s is finalized,
+      so just copy the pointer and don't finalize the temp }
+    Pointer(s) := temp.vString;
+  end;
+end;
 
 procedure sysvartolstr (var s : AnsiString; const v : Variant);
 begin
@@ -701,7 +717,8 @@ begin
       VarCastError(varNull, varString)
     else
       s := NullAsStringValue
-  else
+  { TODO: performance: custom variants must be handled after standard ones }
+  else if not CustomVarToLStr(TVarData(v), s) then
     S := VariantToAnsiString(TVarData(V));
 end;
 

rtl/objpas/fmtbcd.pp

@@ -4006,9 +4006,14 @@ 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
+        VarDataFromStr(Dest, BCDToStr(TFMTBcdVarData(Source.vPointer).BCD))
+      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;