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

* implemented fpc_AnsiStr_Currency and fpc_Val_Currency_AnsiStr.

Browse Source 
* fixed fpc_ShortStr_Currency.

git-svn-id: trunk@5856 -
This commit is contained in:
yury 2007-01-08 19:40:14 +00:00
parent b04c30dfb8
commit b6b9582d8e
3 changed files with 35 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
rtl/inc/astrings.inc
View File

@ -746,6 +746,23 @@ begin
end;
Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Currency; [public, alias:'FPC_VAL_CURRENCY_ANSISTR']; compilerproc;
Var
SS : String;
begin
if length(S) > 255 then
begin
fpc_Val_Currency_AnsiStr := 0;
code := 256;
end
else
begin
SS := S;
Val(SS,fpc_Val_Currency_AnsiStr,code);
end;
end;
Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; out Code : ValSInt): ValUInt; [public, alias:'FPC_VAL_UINT_ANSISTR']; compilerproc;
Var
SS : ShortString;
@ -819,6 +836,15 @@ begin
end;
procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring);[public,alias:'FPC_ANSISTR_CURRENCY']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
var
ss: ShortString;
begin
str(c:len:fr,ss);
s:=ss;
end;
Procedure fpc_AnsiStr_UInt(v : ValUInt;Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALUINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
Var
SS : ShortString;

2
rtl/inc/compproc.inc
View File

@ -81,6 +81,7 @@ procedure fpc_chararray_uint(v : valuint;len : SizeInt;out a : array of char); c
procedure fpc_AnsiStr_sint(v : valsint; Len : SizeInt; out S : AnsiString); compilerproc;
procedure fpc_AnsiStr_uint(v : valuint;Len : SizeInt; out S : AnsiString); compilerproc;
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring); compilerproc;
procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring); compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
@ -117,6 +118,7 @@ Function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : longint): c
Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; compilerproc;
Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; out Code : ValSInt): ValUInt; compilerproc;
Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; out Code : ValSInt): ValSInt; compilerproc;
Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Currency; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Function fpc_Val_Real_WideStr(Const S : WideString; out Code : ValSInt): ValReal; compilerproc;

12
rtl/inc/sstrings.inc
View File

@ -392,18 +392,20 @@ const
var
buf : array[1..19] of char;
i,j,k,reslen,tlen,sign,r,point : longint;
ic : int64;
ic : qword;
begin
{ default value for length is -32767 }
if len=-32767 then
len:=25;
ic:=PInt64(@c)^;
if ic >= 0 then
sign:=0
if PInt64(@c)^ >= 0 then
begin
ic:=QWord(PInt64(@c)^);
sign:=0;
end
else
begin
sign:=1;
ic:=-ic;
ic:=QWord(-PInt64(@c)^);
end;
{ converting to integer string }
tlen:=0;