Преглед на файлове

+ variants: string -> float/int casts

florian преди 20 години
родител
ревизия
c36eadddf7
променени са 3 файла, в които са добавени 170 реда и са изтрити 104 реда
  1. 154 101
      rtl/objpas/cvarutil.inc
  2. 11 2
      rtl/objpas/sysutils/sysstr.inc
  3. 5 1
      rtl/objpas/sysutils/sysstrh.inc

+ 154 - 101
rtl/objpas/cvarutil.inc

@@ -105,116 +105,136 @@ begin
   end;
 end;
 
-Function VariantToLongint(Const VargSrc : TVarData) : Longint;
 
-begin
-  With VargSrc do
-    Case (VType and VarTypeMask) of
-      VarSmallInt: Result:=VSmallInt;
-      VarShortInt: Result:=VShortInt;
-      VarInteger : Result:=VInteger;
-      VarSingle  : Result:=Round(VSingle);
-      VarDouble  : Result:=Round(VDouble);
-      VarCurrency: Result:=Round(VCurrency);
-      VarDate    : Result:=Round(VDate);
-      VarOleStr  : Result:=StrToInt(WideCharToString(vOleStr));
-      VarBoolean : Result:=Longint(VBoolean);
-      VarByte    : Result:=VByte;
-      VarWord    : Result:=VWord;
-      VarLongWord   : Result:=VLongWord;
-      VarInt64   : Result:=VInt64;
-      VarQword   : Result:=VQWord;
-  else
-    VariantTypeMismatch;
+Function VariantToLongint(Const VargSrc : TVarData) : Longint;
+  begin
+    With VargSrc do
+      Case (VType and VarTypeMask) of
+        VarSmallInt: Result:=VSmallInt;
+        VarShortInt: Result:=VShortInt;
+        VarInteger : Result:=VInteger;
+        VarSingle  : Result:=Round(VSingle);
+        VarDouble  : Result:=Round(VDouble);
+        VarCurrency: Result:=Round(VCurrency);
+        VarDate    : Result:=Round(VDate);
+        VarOleStr  :
+          if not(TryStrToInt(WideCharToString(vOleStr),Result)) then
+            VariantTypeMismatch;
+        VarString  :
+          if not(TryStrToInt(ansistring(vString),Result)) then
+            VariantTypeMismatch;
+        VarBoolean : Result:=Longint(VBoolean);
+        VarByte    : Result:=VByte;
+        VarWord    : Result:=VWord;
+        VarLongWord   : Result:=VLongWord;
+        VarInt64   : Result:=VInt64;
+        VarQword   : Result:=VQWord;
+    else
+      VariantTypeMismatch;
+    end;
   end;
-end;
 
-Function VariantToCardinal(Const VargSrc : TVarData) : Cardinal;
 
-begin
-  With VargSrc do
-    Case (VType and VarTypeMask) of
-      VarSmallInt: Result:=VSmallInt;
-      VarShortInt: Result:=VShortInt;
-      VarInteger : Result:=VInteger;
-      VarSingle  : Result:=Round(VSingle);
-      VarDouble  : Result:=Round(VDouble);
-      VarCurrency: Result:=Round(VCurrency);
-      VarDate    : Result:=Round(VDate);
-      VarOleStr  : Result:=StrToInt(WideCharToString(vOleStr));
-      VarBoolean : Result:=Longint(VBoolean);
-      VarByte    : Result:=VByte;
-      VarWord    : Result:=VWord;
-      VarLongWord   : Result:=VLongWord;
-      VarInt64   : Result:=VInt64;
-      VarQword   : Result:=VQWord;
-  else
-    VariantTypeMismatch;
+Function VariantToCardinal(Const VargSrc : TVarData) : Cardinal;
+  var
+    l : longint;
+  begin
+    With VargSrc do
+      Case (VType and VarTypeMask) of
+        VarSmallInt: Result:=VSmallInt;
+        VarShortInt: Result:=VShortInt;
+        VarInteger : Result:=VInteger;
+        VarSingle  : Result:=Round(VSingle);
+        VarDouble  : Result:=Round(VDouble);
+        VarCurrency: Result:=Round(VCurrency);
+        VarDate    : Result:=Round(VDate);
+        VarOleStr  :
+          begin
+            if not(TryStrToInt(WideCharToString(vOleStr),l)) then
+              VariantTypeMismatch;
+            result:=l;
+          end;
+        VarString  :
+          begin
+            if not(TryStrToInt(ansistring(vString),l)) then
+              VariantTypeMismatch;
+            result:=l;
+          end;
+        VarBoolean : Result:=Longint(VBoolean);
+        VarByte    : Result:=VByte;
+        VarWord    : Result:=VWord;
+        VarLongWord   : Result:=VLongWord;
+        VarInt64   : Result:=VInt64;
+        VarQword   : Result:=VQWord;
+    else
+      VariantTypeMismatch;
+    end;
   end;
-end;
 
-Function VariantToSingle(Const VargSrc : TVarData) : Single;
-
-begin
-  With VargSrc do
-    Case (VType and VarTypeMask) of
-      VarSmallInt: Result:=VSmallInt;
-      VarShortInt: Result:=VShortInt;
-      VarInteger : Result:=VInteger;
-      VarSingle  : Result:=VSingle;
-      VarDouble  : Result:=VDouble;
-      VarCurrency: Result:=VCurrency;
-      VarDate    : Result:=VDate;
-      VarOleStr  : NoWideStrings;
-      VarBoolean : Result:=Longint(VBoolean);
-      VarByte    : Result:=VByte;
-      VarWord    : Result:=VWord;
-      VarLongWord   : Result:=VLongWord;
-      VarInt64   : Result:=VInt64;
-      VarQword   : Result:=VQWord;
-  else
-    VariantTypeMismatch;
-  end;
-end;
 
-Function VariantToDouble(Const VargSrc : TVarData) : Double;
+Function VariantToSingle(Const VargSrc : TVarData) : Single;
+  var
+    e : extended;
+  begin
+    With VargSrc do
+      Case (VType and VarTypeMask) of
+        VarSmallInt: Result:=VSmallInt;
+        VarShortInt: Result:=VShortInt;
+        VarInteger : Result:=VInteger;
+        VarSingle  : Result:=VSingle;
+        VarDouble  : Result:=VDouble;
+        VarCurrency: Result:=VCurrency;
+        VarDate    : Result:=VDate;
+        VarOleStr  :
+          begin
+            if not(TryStrToFloat(WideCharToString(vOleStr),Result)) then
+              VariantTypeMismatch;
+             result:=e;
+          end;
+        VarString  :
+          begin
+            if not(TryStrToFloat(ansistring(vString),Result)) then
+              VariantTypeMismatch;
+             result:=e;
+          end;
 
-begin
-  With VargSrc do
-    Case (VType and VarTypeMask)  of
-      VarSmallInt: Result:=VSmallInt;
-      VarShortInt: Result:=VShortInt;
-      VarInteger : Result:=VInteger;
-      VarSingle  : Result:=VSingle;
-      VarDouble  : Result:=VDouble;
-      VarCurrency: Result:=VCurrency;
-      VarDate    : Result:=VDate;
-      VarOleStr  : NoWideStrings;
-      VarBoolean : Result:=Longint(VBoolean);
-      VarByte    : Result:=VByte;
-      VarWord    : Result:=VWord;
-      VarLongWord   : Result:=VLongWord;
-      VarInt64   : Result:=VInt64;
-      VarQword   : Result:=VQWord;
-  else
-    VariantTypeMismatch;
+        VarBoolean : Result:=Longint(VBoolean);
+        VarByte    : Result:=VByte;
+        VarWord    : Result:=VWord;
+        VarLongWord   : Result:=VLongWord;
+        VarInt64   : Result:=VInt64;
+        VarQword   : Result:=VQWord;
+    else
+      VariantTypeMismatch;
+    end;
   end;
-end;
 
-Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
 
-begin
-  Try
+Function VariantToDouble(Const VargSrc : TVarData) : Double;
+  var
+    e : extended;
+  begin
     With VargSrc do
-      Case (VType and VarTypeMask) of
+      Case (VType and VarTypeMask)  of
         VarSmallInt: Result:=VSmallInt;
         VarShortInt: Result:=VShortInt;
         VarInteger : Result:=VInteger;
-        VarSingle  : Result:=FloatToCurr(VSingle);
-        VarDouble  : Result:=FloatToCurr(VDouble);
+        VarSingle  : Result:=VSingle;
+        VarDouble  : Result:=VDouble;
         VarCurrency: Result:=VCurrency;
-        VarDate    : Result:=FloatToCurr(VDate);
-        VarOleStr  : NoWideStrings;
+        VarDate    : Result:=VDate;
+        VarOleStr  :
+          begin
+            if not(TryStrToFloat(WideCharToString(vOleStr),Result)) then
+              VariantTypeMismatch;
+             result:=e;
+          end;
+        VarString  :
+          begin
+            if not(TryStrToFloat(ansistring(vString),Result)) then
+              VariantTypeMismatch;
+             result:=e;
+          end;
         VarBoolean : Result:=Longint(VBoolean);
         VarByte    : Result:=VByte;
         VarWord    : Result:=VWord;
@@ -224,13 +244,43 @@ begin
     else
       VariantTypeMismatch;
     end;
-  except
-    On EConvertError do
-      VariantTypeMismatch;
-    else
-      Raise;
   end;
-end;
+
+
+Function VariantToCurrency(Const VargSrc : TVarData) : Currency;
+  begin
+    Try
+      With VargSrc do
+        Case (VType and VarTypeMask) of
+          VarSmallInt: Result:=VSmallInt;
+          VarShortInt: Result:=VShortInt;
+          VarInteger : Result:=VInteger;
+          VarSingle  : Result:=FloatToCurr(VSingle);
+          VarDouble  : Result:=FloatToCurr(VDouble);
+          VarCurrency: Result:=VCurrency;
+          VarDate    : Result:=FloatToCurr(VDate);
+          VarOleStr  :
+            if not(TryStrToCurr(WideCharToString(vOleStr),Result)) then
+              VariantTypeMismatch;
+          VarString  :
+            if not(TryStrToCurr(ansistring(vString),Result)) then
+              VariantTypeMismatch;
+          VarBoolean : Result:=Longint(VBoolean);
+          VarByte    : Result:=VByte;
+          VarWord    : Result:=VWord;
+          VarLongWord   : Result:=VLongWord;
+          VarInt64   : Result:=VInt64;
+          VarQword   : Result:=VQWord;
+      else
+        VariantTypeMismatch;
+      end;
+    except
+      On EConvertError do
+        VariantTypeMismatch;
+      else
+        Raise;
+    end;
+  end;
 
 
 Function VariantToDate(Const VargSrc : TVarData) : TDateTime;
@@ -588,7 +638,10 @@ end;
 
 {
   $Log$
-  Revision 1.13  2005-03-28 20:36:14  florian
+  Revision 1.14  2005-04-28 09:15:44  florian
+    + variants: string -> float/int casts
+
+  Revision 1.13  2005/03/28 20:36:14  florian
     * some variant <-> string types fixes
 
   Revision 1.12  2005/03/10 21:05:36  florian

+ 11 - 2
rtl/objpas/sysutils/sysstr.inc

@@ -1191,7 +1191,6 @@ end;
 
 
 Function CurrToStr(Value: Currency): string;
-
 begin
   Result:=FloatToStrF(Value,ffNumber,15,2);
 end;
@@ -1202,6 +1201,13 @@ begin
     Raise EConvertError.createfmt(SInValidFLoat,[S]);
 end;
 
+
+Function TryStrToCurr(Const S : String; Var Value: Currency): Boolean;
+Begin
+  Result := TextToFloat(PChar(S), Value, fvCurrency);
+End;
+
+
 function StrToCurrDef(const S: string; Default : Currency): Currency;
 begin
   if not TextToFloat(PChar(S), Result, fvCurrency) then
@@ -2098,7 +2104,10 @@ const
 
 {
   $Log$
-  Revision 1.36  2005-04-26 16:40:51  michael
+  Revision 1.37  2005-04-28 09:15:44  florian
+    + variants: string -> float/int casts
+
+  Revision 1.36  2005/04/26 16:40:51  michael
   + Added FormatCurr by Uberto Barbini
 
   Revision 1.35  2005/03/25 22:53:39  jonas

+ 5 - 1
rtl/objpas/sysutils/sysstrh.inc

@@ -152,6 +152,7 @@ Function FloattoCurr (Const Value : Extended) : Currency;
 function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
 Function CurrToStr(Value: Currency): string;
 function StrToCurr(const S: string): Currency;
+function TryStrToCurr(const S: string;Var Value : Currency): Boolean;
 function StrToCurrDef(const S: string; Default : Currency): Currency;
 function StrToBool(const S: string): Boolean;
 function BoolToStr(B: Boolean): string;
@@ -203,7 +204,10 @@ function BCDToInt(Value: integer): integer;
 
 {
   $Log$
-  Revision 1.17  2005-04-26 16:40:51  michael
+  Revision 1.18  2005-04-28 09:15:44  florian
+    + variants: string -> float/int casts
+
+  Revision 1.17  2005/04/26 16:40:51  michael
   + Added FormatCurr by Uberto Barbini
 
   Revision 1.16  2005/03/12 14:56:22  florian