Browse Source

* Implemented fpc_Write_Text_Currency and fpc_Read_Text_Currency.

git-svn-id: trunk@5874 -
yury 18 years ago
parent
commit
71961bb8ce
2 changed files with 51 additions and 0 deletions
  1. 4 0
      rtl/inc/compproc.inc
  2. 47 0
      rtl/inc/text.inc

+ 4 - 0
rtl/inc/compproc.inc

@@ -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 - 0
rtl/inc/text.inc

@@ -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;