+ newer version of FloatToDecimal

* 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

View File

@ -1886,15 +1886,26 @@ Begin
End;
Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
Procedure FloatToDecimal(Out Result: TFloatRec; const Value; ValueType: TFloatValue; Precision, Decimals : integer);
var
Buffer: String[254]; //Though str func returns only 25 chars, this might change in the future
Error, N, L, Start, C: Integer;
GotNonZeroBeforeDot, BeforeDot : boolean;
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;
L := Byte(Buffer[0]);
while Buffer[N]=' ' do
@ -1989,6 +2000,13 @@ begin
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;
Var

View File

@ -168,6 +168,7 @@ function TryStrToBool(const S: string; out Value: Boolean): Boolean;
function LastDelimiter(const Delimiters, S: string): Integer;
function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
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);
Function FormatFloat(Const Format : String; Value : Extended) : String;
Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;

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);
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-',
'258-1',
'-255-',
@ -341,6 +667,7 @@ const results: array[1..324] of string =
'4+9057',
'4+9194',
'4+9059');
{$endif}
function DecimalToStr(fr: TFloatRec): string;
var
@ -389,3 +716,4 @@ BEGIN
end;
END.