paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 22:50:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implemented fpc_Write_Text_Currency and fpc_Read_Text_Currency.

Browse Source 
git-svn-id: trunk@5874 -
This commit is contained in:
yury 2007-01-10 22:07:42 +00:00
parent 650bb51d31
commit 71961bb8ce
2 changed files with 51 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
rtl/inc/compproc.inc
View File

@ -245,6 +245,9 @@ procedure fpc_write_text_qword(len : longint;var t : text;q : qword); compilerpr
procedure fpc_write_text_int64(len : longint;var t : text;i : int64); compilerproc;
{$endif CPU64}
Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc;
{$ifdef FPC_HAS_STR_CURRENCY}
Procedure fpc_Write_Text_Currency(fixkomma,Len : Longint;var t : Text;c : Currency); compilerproc;
{$endif FPC_HAS_STR_CURRENCY}
Procedure fpc_Write_Text_Boolean(Len : Longint;var t : Text;b : Boolean); compilerproc;
Procedure fpc_Write_Text_Char(Len : Longint;var t : Text;c : Char); compilerproc;
Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); compilerproc;
@ -275,6 +278,7 @@ Procedure fpc_Read_Text_Char(var f : Text; out c : char); compilerproc;
Procedure fpc_Read_Text_SInt(var f : Text; out l :ValSInt); compilerproc;
Procedure fpc_Read_Text_UInt(var f : Text; out u :ValUInt); compilerproc;
Procedure fpc_Read_Text_Float(var f : Text; out v :ValReal); compilerproc;
procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); compilerproc;
{$ifndef CPU64}
Procedure fpc_Read_Text_QWord(var f : text; out q : qword); compilerproc;
Procedure fpc_Read_Text_Int64(var f : text; out i : int64); compilerproc;

47
rtl/inc/text.inc
View File

@ -696,6 +696,17 @@ Begin
Write_Str(Len,t,s);
End;
{$ifdef FPC_HAS_STR_CURRENCY}
Procedure fpc_Write_Text_Currency(fixkomma,Len : Longint;var t : Text;c : Currency); iocheck; [Public,Alias:'FPC_WRITE_TEXT_CURRENCY']; compilerproc;
var
s : String;
Begin
If (InOutRes<>0) then
exit;
str(c:Len:fixkomma,s);
Write_Str(Len,t,s);
End;
{$endif FPC_HAS_STR_CURRENCY}
Procedure fpc_Write_Text_Boolean(Len : Longint;var t : Text;b : Boolean); iocheck; [Public,Alias:'FPC_WRITE_TEXT_BOOLEAN']; compilerproc;
Begin
@ -1153,6 +1164,42 @@ begin
end;
procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); iocheck; [Public,Alias:'FPC_READ_TEXT_CURRENCY']; compilerproc;
var
hs : string;
code : Word;
begin
v:=0.0;
{ Leave if error or not open file, else check for empty buf }
If (InOutRes<>0) then
exit;
if (TextRec(f).mode<>fmInput) Then
begin
case TextRec(f).mode of
fmOutPut,fmAppend:
InOutRes:=104
else
InOutRes:=103;
end;
exit;
end;
If TextRec(f).BufPos>=TextRec(f).BufEnd Then
FileFunc(TextRec(f).InOutFunc)(TextRec(f));
hs:='';
if IgnoreSpaces(f) then
begin
{ When spaces were found and we are now at EOF,
then we return 0 }
if (TextRec(f).BufPos>=TextRec(f).BufEnd) then
exit;
ReadNumeric(f,hs);
end;
val(hs,v,code);
If code<>0 Then
InOutRes:=106;
end;
{$ifndef cpu64}
procedure fpc_Read_Text_QWord(var f : text; out q : qword); iocheck; [public,alias:'FPC_READ_TEXT_QWORD']; compilerproc;