paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 12:39:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* currency is handled directly in StrToCurr, CurrToStr, CurrToStrF functions.

Browse Source 
* improved Delphi compatibility of FloatToStrF.

git-svn-id: trunk@5879 -
This commit is contained in:
yury 2007-01-11 01:50:33 +00:00
parent e8707ad4b8
commit df10089076
1 changed files with 114 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
rtl/objpas/sysutils/sysstr.inc
View File

@ -961,7 +961,9 @@ Function TextToFloat(Buffer: PChar; Var Value; ValueType: TFloatValue): Boolean;
Var Var
E,P : Integer; E,P : Integer;
S : String; S : String;
{$ifndef FPC_HAS_STR_CURRENCY}
TempValue: extended; TempValue: extended;
{$endif FPC_HAS_STR_CURRENCY}
Begin Begin
S:=StrPas(Buffer); S:=StrPas(Buffer);
@ -976,11 +978,15 @@ Begin
S[P] := '.'; S[P] := '.';
case ValueType of case ValueType of
fvCurrency: fvCurrency:
{$ifdef FPC_HAS_STR_CURRENCY}
Val(S,Currency(Value),E);
{$else FPC_HAS_STR_CURRENCY}
begin begin
// needed for platforms where Currency = Int64 // needed for platforms where Currency = Int64
Val(S,TempValue,E); Val(S,TempValue,E);
Currency(Value) := TempValue; Currency(Value) := TempValue;
end; end;
{$endif FPC_HAS_STR_CURRENCY}
fvExtended: fvExtended:
Val(S,Extended(Value),E); Val(S,Extended(Value),E);
fvDouble: fvDouble:
@ -1020,10 +1026,12 @@ const
maxdigits = 14; maxdigits = 14;
{$endif} {$endif}
Function FloatToStrFIntl(Value: Extended; format: TFloatFormat; Precision, Digits: Integer; ValueType: TFloatValue): String; Function FloatToStrFIntl(const Value; format: TFloatFormat; Precision, Digits: Integer; ValueType: TFloatValue): String;
Var Var
P: Integer; P: Integer;
Negative, TooSmall, TooLarge: Boolean; Negative, TooSmall, TooLarge: Boolean;
ValExt: Extended;
ValCur: Currency;
Begin Begin
Case format Of Case format Of
@ -1031,17 +1039,33 @@ Begin
ffGeneral: ffGeneral:
Begin Begin
If (Precision = -1) Or (Precision > maxdigits) Then Precision := maxdigits; case ValueType of
TooSmall := (Abs(Value) < 0.00001) and (Value>0.0); fvCurrency:
begin
If (Precision = -1) Or (Precision > 19) Then Precision := 19;
TooSmall:=False;
end;
else
begin
If (Precision = -1) Or (Precision > maxdigits) Then Precision := maxdigits;
TooSmall := (Abs(Extended(Value)) < 0.00001) and (Extended(Value)<>0.0);
end;
end;
If Not TooSmall Then If Not TooSmall Then
Begin Begin
case ValueType of case ValueType of
fvDouble: fvDouble:
Str(Double(Value):digits:precision, Result); Str(Double(Value):0:precision, Result);
fvSingle: fvSingle:
Str(Single(Value):digits:precision, Result); Str(Single(Value):0:precision, Result);
fvCurrency:
{$ifdef FPC_HAS_STR_CURRENCY}
Str(Currency(Value):0:precision, Result);
{$else}
Str(Extended(Currency(Value)):0:precision, Result);
{$endif FPC_HAS_STR_CURRENCY}
else else
Str(Extended(Value):digits:precision, Result); Str(Extended(Value):0:precision, Result);
end; end;
P := Pos('.', Result); P := Pos('.', Result);
if P<>0 then if P<>0 then
@ -1051,7 +1075,7 @@ Begin
If TooSmall Or TooLarge Then If TooSmall Or TooLarge Then
begin begin
Result := FloatToStrF(Value, ffExponent, Precision, Digits); Result := FloatToStrFIntl(Value, ffExponent, Precision, Digits, ValueType);
// Strip unneeded zeroes. // Strip unneeded zeroes.
P:=Pos('E',result)-1; P:=Pos('E',result)-1;
If P<>-1 then If P<>-1 then
@ -1077,6 +1101,8 @@ Begin
{ significant digits" rather than "number of digits after the } { significant digits" rather than "number of digits after the }
{ decimal point" (as it does in the system unit) -> adjust } { decimal point" (as it does in the system unit) -> adjust }
{ (precision+1 to count the decimal point character) } { (precision+1 to count the decimal point character) }
if Result[1] = '-' then
Inc(Precision);
if (Length(Result) > Precision + 1) and if (Length(Result) > Precision + 1) and
(Precision + 1 > P) then (Precision + 1 > P) then
begin begin
@ -1101,6 +1127,12 @@ Begin
Str(Double(Value):Precision+8, Result); Str(Double(Value):Precision+8, Result);
fvSingle: fvSingle:
Str(Single(Value):Precision+8, Result); Str(Single(Value):Precision+8, Result);
fvCurrency:
{$ifdef FPC_HAS_STR_CURRENCY}
Str(Currency(Value):Precision+8, Result);
{$else}
Str(Extended(Currency(Value)):Precision+8, Result);
{$endif FPC_HAS_STR_CURRENCY}
else else
Str(Extended(Value):Precision+8, Result); Str(Extended(Value):Precision+8, Result);
end; end;
@ -1128,6 +1160,12 @@ Begin
Str(Double(Value):0:Digits, Result); Str(Double(Value):0:Digits, Result);
fvSingle: fvSingle:
Str(Single(Value):0:Digits, Result); Str(Single(Value):0:Digits, Result);
fvCurrency:
{$ifdef FPC_HAS_STR_CURRENCY}
Str(Currency(Value):0:Digits, Result);
{$else}
Str(Extended(Currency(Value)):0:Digits, Result);
{$endif FPC_HAS_STR_CURRENCY}
else else
Str(Extended(Value):0:Digits, Result); Str(Extended(Value):0:Digits, Result);
end; end;
@ -1147,6 +1185,12 @@ Begin
Str(Double(Value):0:Digits, Result); Str(Double(Value):0:Digits, Result);
fvSingle: fvSingle:
Str(Single(Value):0:Digits, Result); Str(Single(Value):0:Digits, Result);
fvCurrency:
{$ifdef FPC_HAS_STR_CURRENCY}
Str(Currency(Value):0:Digits, Result);
{$else}
Str(Extended(Currency(Value)):0:Digits, Result);
{$endif FPC_HAS_STR_CURRENCY}
else else
Str(Extended(Value):0:Digits, Result); Str(Extended(Value):0:Digits, Result);
end; end;
@ -1167,23 +1211,44 @@ Begin
ffCurrency: ffCurrency:
Begin Begin
If Value < 0 Then if ValueType = fvCurrency then
Begin begin
Negative := True; ValCur:=Currency(Value);
Value := -Value; If ValCur < 0 Then
End Begin
Else Negative := False; Negative := True;
ValCur := -ValCur;
End
Else Negative := False;
end
else
begin
ValExt:=Extended(Value);
If ValExt < 0 Then
Begin
Negative := True;
ValExt := -ValExt;
End
Else Negative := False;
end;
If Digits = -1 Then Digits := CurrencyDecimals If Digits = -1 Then Digits := CurrencyDecimals
Else If Digits > 18 Then Digits := 18; Else If Digits > 18 Then Digits := 18;
case ValueType of case ValueType of
fvDouble: fvDouble:
Str(Double(Value):0:Digits, Result); Str(Double(ValExt):0:Digits, Result);
fvSingle: fvSingle:
Str(Single(Value):0:Digits, Result); Str(Single(ValExt):0:Digits, Result);
fvCurrency:
{$ifdef FPC_HAS_STR_CURRENCY}
Str(ValCur:0:Digits, Result);
{$else}
Str(Extended(ValCur):0:Digits, Result);
{$endif FPC_HAS_STR_CURRENCY}
else else
Str(Extended(Value):0:Digits, Result); Str(Extended(ValExt):0:Digits, Result);
end; end;
writeln(result);
If Result[1] = ' ' Then System.Delete(Result, 1, 1); If Result[1] = ' ' Then System.Delete(Result, 1, 1);
P := Pos('.', Result); P := Pos('.', Result);
If P <> 0 Then Result[P] := DecimalSeparator; If P <> 0 Then Result[P] := DecimalSeparator;
@ -1236,24 +1301,36 @@ Begin
End; End;
Function FloatToStr(Value: Double): String; Function FloatToStr(Value: Double): String;
var
e: Extended;
Begin Begin
Result := FloatToStrFIntl(Value, ffGeneral, 15, 0, fvDouble); e := Value;
Result := FloatToStrFIntl(e, ffGeneral, 15, 0, fvDouble);
End; End;
Function FloatToStr(Value: Single): String; Function FloatToStr(Value: Single): String;
var
e: Extended;
Begin Begin
Result := FloatToStrFIntl(Value, ffGeneral, 15, 0, fvSingle); e := Value;
Result := FloatToStrFIntl(e, ffGeneral, 15, 0, fvSingle);
End; End;
Function FloatToStr(Value: Comp): String; Function FloatToStr(Value: Comp): String;
var
e: Extended;
Begin Begin
Result := FloatToStrFIntl(Value, ffGeneral, 15, 0, fvComp); e := Value;
Result := FloatToStrFIntl(e, ffGeneral, 15, 0, fvComp);
End; End;
{$ifndef FPC_COMP_IS_INT64} {$ifndef FPC_COMP_IS_INT64}
Function FloatToStr(Value: Int64): String; Function FloatToStr(Value: Int64): String;
var
e: Extended;
Begin Begin
Result := FloatToStrFIntl(Comp(Value), ffGeneral, 15, 0, fvComp); e := Comp(Value);
Result := FloatToStrFIntl(e, ffGeneral, 15, 0, fvComp);
End; End;
{$endif FPC_COMP_IS_INT64} {$endif FPC_COMP_IS_INT64}
@ -1280,24 +1357,36 @@ begin
end; end;
Function FloatToStrF(Value: Double; format: TFloatFormat; Precision, Digits: Integer): String; Function FloatToStrF(Value: Double; format: TFloatFormat; Precision, Digits: Integer): String;
var
e: Extended;
begin begin
result := FloatToStrFIntl(value,format,precision,digits,fvDouble); e := Value;
result := FloatToStrFIntl(e,format,precision,digits,fvDouble);
end; end;
Function FloatToStrF(Value: Single; format: TFloatFormat; Precision, Digits: Integer): String; Function FloatToStrF(Value: Single; format: TFloatFormat; Precision, Digits: Integer): String;
var
e: Extended;
begin begin
result := FloatToStrFIntl(value,format,precision,digits,fvSingle); e := Value;
result := FloatToStrFIntl(e,format,precision,digits,fvSingle);
end; end;
Function FloatToStrF(Value: Comp; format: TFloatFormat; Precision, Digits: Integer): String; Function FloatToStrF(Value: Comp; format: TFloatFormat; Precision, Digits: Integer): String;
var
e: Extended;
begin begin
result := FloatToStrFIntl(value,format,precision,digits,fvComp); e := Value;
result := FloatToStrFIntl(e,format,precision,digits,fvComp);
end; end;
{$ifndef FPC_COMP_IS_INT64} {$ifndef FPC_COMP_IS_INT64}
Function FloatToStrF(Value: Int64; format: TFloatFormat; Precision, Digits: Integer): String; Function FloatToStrF(Value: Int64; format: TFloatFormat; Precision, Digits: Integer): String;
var
e: Extended;
begin begin
result := FloatToStrFIntl(Comp(value),format,precision,digits,fvComp); e := Comp(Value);
result := FloatToStrFIntl(e,format,precision,digits,fvComp);
end; end;
{$endif FPC_COMP_IS_INT64} {$endif FPC_COMP_IS_INT64}
@ -1333,7 +1422,7 @@ end;
Function CurrToStr(Value: Currency): string; Function CurrToStr(Value: Currency): string;
begin begin
Result:=FloatToStrF(Value,ffNumber,15,2); Result:=FloatToStrF(Value,ffGeneral,-1,0);
end; end;
function AnsiDequotedStr(const S: string; AQuote: Char): string; function AnsiDequotedStr(const S: string; AQuote: Char): string;