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

+ newer version of FloatToDecimal

Browse Source 
* use more precision for extended (Delphi compatible)

git-svn-id: trunk@5517 -
This commit is contained in:
Jonas Maebe 2006-12-01 18:18:23 +00:00
parent fb22cb9efc
commit 5133e7161a
3 changed files with 351 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1886,15 +1886,26 @@ Begin
End; End;
Procedure FloatToDecimal(Out Result: TFloatRec; const Value; ValueType: TFloatValue; Precision, Decimals : integer);
Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
var var
Buffer: String[254]; //Though str func returns only 25 chars, this might change in the future Buffer: String[254]; //Though str func returns only 25 chars, this might change in the future
Error, N, L, Start, C: Integer; Error, N, L, Start, C: Integer;
GotNonZeroBeforeDot, BeforeDot : boolean; GotNonZeroBeforeDot, BeforeDot : boolean;
begin begin
Str(Value:23, Buffer); case ValueType of
fvExtended:
Str(Extended(Value):25, Buffer);
fvDouble,
fvReal:
Str(Double(Value):23, Buffer);
fvSingle:
Str(Single(Value):16, Buffer);
fvCurrency:
Str(Currency(Value):25, Buffer);
fvComp:
Str(Currency(Value):23, Buffer);
end;
N := 1; N := 1;
L := Byte(Buffer[0]); L := Byte(Buffer[0]);
while Buffer[N]=' ' do while Buffer[N]=' ' do
@ -1989,6 +2000,13 @@ begin
end; end;
end; end;
Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
begin
FloatToDecimal(Result,Value,fvExtended,Precision,Decimals);
end;
Function FormatFloat(Const format: String; Value: Extended): String; Function FormatFloat(Const format: String; Value: Extended): String;
Var Var

1
rtl/objpas/sysutils/sysstrh.inc
View File

@ -168,6 +168,7 @@ function TryStrToBool(const S: string; out Value: Boolean): Boolean;
function LastDelimiter(const Delimiters, S: string): Integer; function LastDelimiter(const Delimiters, S: string): Integer;
function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string; function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer; Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
Procedure FloatToDecimal(Out Result: TFloatRec; const Value; ValueType: TFloatValue; Precision, Decimals : integer);
Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer); Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
Function FormatFloat(Const Format : String; Value : Extended) : String; Function FormatFloat(Const Format : String; Value : Extended) : String;
Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean; Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;

328
tests/webtbs/tw7756.pp
View File

@ -17,6 +17,332 @@ var
-1.1E256, -5.5E256, -1.1E-256, -5.5E-256, -pi, 0.0, pi, 1.1E-256, 5.5E-256, 1.1E256, 5.5E256); -1.1E256, -5.5E256, -1.1E-256, -5.5E-256, -pi, 0.0, pi, 1.1E-256, 5.5E-256, 1.1E256, 5.5E256);
const results: array[1..324] of string = const results: array[1..324] of string =
{$ifdef FPC_HAS_TYPE_EXTENDED}
('257-',
'258-1',
'-255-',
'-255-',
'1-',
'0+',
'1+',
'-255+',
'-255+',
'257+',
'258+1',
'257-',
'258-1',
'-255-',
'-255-',
'1-',
'0+',
'1+',
'-255+',
'-255+',
'257+',
'258+1',
'257-',
'258-1',
'-255-',
'-255-',
'1-',
'0+',
'1+',
'-255+',
'-255+',
'257+',
'258+1',
'257-',
'258-1',
'-255-',
'-255-',
'1-',
'0+',
'1+',
'-255+',
'-255+',
'257+',
'258+1',
'257-',
'258-1',
'-255-',
'-255-',
'1-',
'0+',
'1+',
'-255+',
'-255+',
'257+',
'258+1',
'257-',
'258-1',
'-255-',
'-255-',
'1-',
'0+',
'1+',
'-255+',
'-255+',
'257+',
'258+1',
'257-11',
'257-55',
'-255-',
'-255-',
'1-3',
'0+',
'1+3',
'-255+',
'-255+',
'257+11',
'257+55',
'257-11',
'257-55',
'-255-',
'-255-',
'1-314159',
'0+',
'1+314159',
'-255+',
'-255+',
'257+11',
'257+55',
'257-11',
'257-55',
'-255-',
'-255-',
'1-314159265358979',
'0+',
'1+314159265358979',
'-255+',
'-255+',
'257+11',
'257+55',
'257-11',
'257-55',
'-255-',
'-255-',
'1-314159265358979',
'0+',
'1+314159265358979',
'-255+',
'-255+',
'257+11',
'257+55',
'257-11',
'257-55',
'-255-',
'-255-',
'1-314159265358979',
'0+',
'1+314159265358979',
'-255+',
'-255+',
'257+11',
'257+55',
'257-11',
'257-55',
'-255-',
'-255-',
'1-314159265358979',
'0+',
'1+314159265358979',
'-255+',
'-255+',
'257+11',
'257+55',
'257-11',
'257-54999999999999998',
'-255-',
'-255-',
'1-3',
'0+',
'1+3',
'-255+',
'-255+',
'257+11',
'257+54999999999999998',
'257-11',
'257-54999999999999998',
'-255-',
'-255-',
'1-314159',
'0+',
'1+314159',
'-255+',
'-255+',
'257+11',
'257+54999999999999998',
'257-11',
'257-54999999999999998',
'-255-',
'-255-',
'1-3141592653589793',
'0+',
'1+3141592653589793',
'-255+',
'-255+',
'257+11',
'257+54999999999999998',
'257-11',
'257-54999999999999998',
'-255-',
'-255-',
'1-31415926535897931',
'0+',
'1+31415926535897931',
'-255+',
'-255+',
'257+11',
'257+54999999999999998',
'257-11',
'257-54999999999999998',
'-255-',
'-255-',
'1-31415926535897931',
'0+',
'1+31415926535897931',
'-255+',
'-255+',
'257+11',
'257+54999999999999998',
'257-11',
'257-54999999999999998',
'-255-',
'-255-',
'1-31415926535897931',
'0+',
'1+31415926535897931',
'-255+',
'-255+',
'257+11',
'257+54999999999999998',
'5-1',
'5-1',
'5-1',
'0+',
'5+1',
'5+1',
'5+1',
'5-1',
'5-1',
'5-1',
'0+',
'5+1',
'5+1',
'5+1',
'5-1',
'5-1',
'5-1',
'0+',
'5+1',
'5+1',
'5+1',
'5-1',
'5-1',
'5-1',
'0+',
'5+1',
'5+1',
'5+1',
'5-1',
'5-1',
'5-1',
'0+',
'5+1',
'5+1',
'5+1',
'5-1',
'5-1',
'5-1',
'0+',
'5+1',
'5+1',
'5+1',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059',
'4-9057',
'4-9194',
'4-9059',
'0+',
'4+9057',
'4+9194',
'4+9059');
{$else}
('257-', ('257-',
'258-1', '258-1',
'-255-', '-255-',
@ -341,6 +667,7 @@ const results: array[1..324] of string =
'4+9057', '4+9057',
'4+9194', '4+9194',
'4+9059'); '4+9059');
{$endif}
function DecimalToStr(fr: TFloatRec): string; function DecimalToStr(fr: TFloatRec): string;
var var
@ -389,3 +716,4 @@ BEGIN
end; end;
END. END.