Browse Source

* fixed some FloatToStrF and FloatToStr precision problems. Still fails
for some corner cases (e.g. 8.502 as double), but that problem is in
str_real

git-svn-id: trunk@2390 -

Jonas Maebe 19 years ago
parent
commit
e9a6b3dc10
2 changed files with 106 additions and 21 deletions
  1. 96 21
      rtl/objpas/sysutils/sysstr.inc
  2. 10 0
      rtl/objpas/sysutils/sysstrh.inc

+ 96 - 21
rtl/objpas/sysutils/sysstr.inc

@@ -1012,33 +1012,19 @@ Begin
 End;
 {$endif FPC_HAS_TYPE_EXTENDED}
 
-Function FloatToStr(Value: Extended): String;
-Begin
-  Result := FloatToStrF(Value, ffGeneral, 15, 0);
-End;
-
-Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Precision, Digits: Integer): Longint;
-Var
-  Tmp: String[40];
-Begin
-  Tmp := FloatToStrF(Value, format, Precision, Digits);
-  Result := Length(Tmp);
-  Move(Tmp[1], Buffer[0], Result);
-End;
 
 const
-{$if sizeof(extended) > sizeof(double)}
+{$ifdef FPC_HAS_TYPE_EXTENDED}
   maxdigits = 15;
 {$else}
   maxdigits = 14;
 {$endif}
 
-Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
+Function FloatToStrFIntl(Value: Extended; format: TFloatFormat; Precision, Digits: Integer; ValueType: TFloatValue): String;
 Var
   P: Integer;
   Negative, TooSmall, TooLarge: Boolean;
 
-
 Begin
   Case format Of
 
@@ -1049,7 +1035,14 @@ Begin
         TooSmall := (Abs(Value) < 0.00001) and (Value>0.0);
         If Not TooSmall Then
         Begin
-          Str(Value:digits:precision, Result);
+          case ValueType of
+            fvDouble:
+              Str(Double(Value):digits:precision, Result);
+            fvSingle:
+              Str(Single(Value):digits:precision, Result);
+            else
+              Str(Extended(Value):digits:precision, Result);
+          end;
           P := Pos('.', Result);
           if P<>0 then
             Result[P] := DecimalSeparator;
@@ -1093,7 +1086,14 @@ Begin
 
       Begin
         If (Precision = -1) Or (Precision > maxdigits) Then Precision := maxdigits;
-        Str(Value:Precision + 8, Result);
+        case ValueType of
+          fvDouble:
+            Str(Double(Value):Precision+8, Result);
+          fvSingle:
+            Str(Single(Value):Precision+8, Result);
+          else
+            Str(Extended(Value):Precision+8, Result);
+        end;
         Result[3] := DecimalSeparator;
         P:=4;
         While (P>0) and (Digits < P) And (Result[Precision + 5] = '0') do
@@ -1113,7 +1113,14 @@ Begin
       Begin
         If Digits = -1 Then Digits := 2
         Else If Digits > 18 Then Digits := 18;
-        Str(Value:0:Digits, Result);
+        case ValueType of
+          fvDouble:
+            Str(Double(Value):0:Digits, Result);
+          fvSingle:
+            Str(Single(Value):0:Digits, Result);
+          else
+            Str(Extended(Value):0:Digits, Result);
+        end;
         If Result[1] = ' ' Then
           System.Delete(Result, 1, 1);
         P := Pos('.', Result);
@@ -1125,7 +1132,14 @@ Begin
       Begin
         If Digits = -1 Then Digits := 2
         Else If Digits > maxdigits Then Digits := maxdigits;
-        Str(Value:0:Digits, Result);
+        case ValueType of
+          fvDouble:
+            Str(Double(Value):0:Digits, Result);
+          fvSingle:
+            Str(Single(Value):0:Digits, Result);
+          else
+            Str(Extended(Value):0:Digits, Result);
+        end;
         If Result[1] = ' ' Then System.Delete(Result, 1, 1);
         P := Pos('.', Result);
         If P <> 0 Then
@@ -1152,7 +1166,14 @@ Begin
 
         If Digits = -1 Then Digits := CurrencyDecimals
         Else If Digits > 18 Then Digits := 18;
-        Str(Value:0:Digits, Result);
+        case ValueType of
+          fvDouble:
+            Str(Double(Value):0:Digits, Result);
+          fvSingle:
+            Str(Single(Value):0:Digits, Result);
+          else
+            Str(Extended(Value):0:Digits, Result);
+        end;
         If Result[1] = ' ' Then System.Delete(Result, 1, 1);
         P := Pos('.', Result);
         If P <> 0 Then Result[P] := DecimalSeparator;
@@ -1192,6 +1213,60 @@ Begin
   End;
 End;
 
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+Function FloatToStr(Value: Extended): String;
+Begin
+  Result := FloatToStrFIntl(Value, ffGeneral, 15, 0, fvExtended);
+End;
+{$endif FPC_HAS_TYPE_EXTENDED}
+
+Function FloatToStr(Value: Currency): String;
+Begin
+  Result := FloatToStrFIntl(Value, ffGeneral, 15, 0, fvCurrency);
+End;
+
+Function FloatToStr(Value: Double): String;
+Begin
+  Result := FloatToStrFIntl(Value, ffGeneral, 15, 0, fvDouble);
+End;
+
+Function FloatToStr(Value: Single): String;
+Begin
+  Result := FloatToStrFIntl(Value, ffGeneral, 15, 0, fvSingle);
+End;
+
+Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Precision, Digits: Integer): Longint;
+Var
+  Tmp: String[40];
+Begin
+  Tmp := FloatToStrF(Value, format, Precision, Digits);
+  Result := Length(Tmp);
+  Move(Tmp[1], Buffer[0], Result);
+End;
+
+{$ifdef FPC_HAS_TYPE_EXTENDED}
+Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
+begin
+  result := FloatToStrFIntl(value,format,precision,digits,fvExtended);
+end;
+{$endif}
+
+Function FloatToStrF(Value: Currency; format: TFloatFormat; Precision, Digits: Integer): String;
+begin
+  result := FloatToStrFIntl(value,format,precision,digits,fvCurrency);
+end;
+
+Function FloatToStrF(Value: Double; format: TFloatFormat; Precision, Digits: Integer): String;
+begin
+  result := FloatToStrFIntl(value,format,precision,digits,fvDouble);
+end;
+
+Function FloatToStrF(Value: Single; format: TFloatFormat; Precision, Digits: Integer): String;
+begin
+  result := FloatToStrFIntl(value,format,precision,digits,fvSingle);
+end;
+
+
 Function CurrToStrF(Value: Currency; Format: TFloatFormat; Digits: Integer): string;
   begin
     result:=FloatToStrF(Value,Format,19,Digits);

+ 10 - 0
rtl/objpas/sysutils/sysstrh.inc

@@ -119,9 +119,19 @@ Function FormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal;
 Function StrFmt(Buffer,Fmt : PChar; Const args: Array of const) : Pchar;
 Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const) : Pchar;
 Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const);
+{$ifdef FPC_HAS_TYPE_EXTENDED}
 Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
+{$endif FPC_HAS_TYPE_EXTENDED}
+Function FloatToStrF(Value: Double; format: TFloatFormat; Precision, Digits: Integer): String;
+Function FloatToStrF(Value: Single; format: TFloatFormat; Precision, Digits: Integer): String;
+Function FloatToStrF(Value: Currency; format: TFloatFormat; Precision, Digits: Integer): String;
 Function CurrToStrF(Value: Currency; Format: TFloatFormat; Digits: Integer): string;
+{$ifdef FPC_HAS_TYPE_EXTENDED}
 Function FloatToStr(Value: Extended): String;
+{$endif FPC_HAS_TYPE_EXTENDED}
+Function FloatToStr(Value: Double): String;
+Function FloatToStr(Value: Single): String;
+Function FloatToStr(Value: Currency): String;
 Function StrToFloat(Const S : String) : Extended;
 Function StrToFloatDef(Const S: String; Const Default: Extended): Extended;
 Function TryStrToFloat(Const S : String; Var Value: Single): Boolean;