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