mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-07 08:47:32 +02:00
* Patch from Zeljan Rikalo to fix issue #13722 (FloatToStrF negative 0)
git-svn-id: trunk@15945 -
This commit is contained in:
parent
99c261c5ba
commit
f7b268713d
@ -1162,6 +1162,32 @@ Var
|
|||||||
Negative, TooSmall, TooLarge: Boolean;
|
Negative, TooSmall, TooLarge: Boolean;
|
||||||
DS: Char;
|
DS: Char;
|
||||||
|
|
||||||
|
function RemoveLeadingNegativeSign(var AValue: String): Boolean;
|
||||||
|
// removes negative sign in case when result is zero eg. -0.00
|
||||||
|
var
|
||||||
|
i: PtrInt;
|
||||||
|
S: String;
|
||||||
|
TS: Char;
|
||||||
|
B: Boolean;
|
||||||
|
StartPos: PtrInt;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
if Format = ffCurrency then
|
||||||
|
StartPos := 1
|
||||||
|
else
|
||||||
|
StartPos := 2;
|
||||||
|
TS := FormatSettings.ThousandSeparator;
|
||||||
|
S := '';
|
||||||
|
for i := StartPos to length(AValue) do
|
||||||
|
begin
|
||||||
|
Result := (AValue[i] in ['0', DS, 'E', '+', TS]);
|
||||||
|
if not Result then
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
if (Result) and (Format <> ffCurrency) then
|
||||||
|
Delete(AValue, 1, 1);
|
||||||
|
end;
|
||||||
|
|
||||||
Begin
|
Begin
|
||||||
DS:=FormatSettings.DecimalSeparator;
|
DS:=FormatSettings.DecimalSeparator;
|
||||||
Case format Of
|
Case format Of
|
||||||
@ -1388,6 +1414,9 @@ Begin
|
|||||||
Dec(P, 3);
|
Dec(P, 3);
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
if (length(Result) > 1) and Negative then
|
||||||
|
Negative := not RemoveLeadingNegativeSign(Result);
|
||||||
|
|
||||||
If Not Negative Then
|
If Not Negative Then
|
||||||
Begin
|
Begin
|
||||||
Case FormatSettings.CurrencyFormat Of
|
Case FormatSettings.CurrencyFormat Of
|
||||||
@ -1415,6 +1444,8 @@ Begin
|
|||||||
End;
|
End;
|
||||||
End;
|
End;
|
||||||
End;
|
End;
|
||||||
|
if not (format in [ffCurrency]) and (length(Result) > 1) and (Result[1] = '-') then
|
||||||
|
RemoveLeadingNegativeSign(Result);
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user