mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 18:06:12 +02:00
+ read single,fixed
+ val with code:longint + val for fixed
This commit is contained in:
peter
parent
0559825e19
commit
af1ccc6f61
@ -19,7 +19,6 @@
|
||||
{$I real2str.inc}
|
||||
|
||||
function copy(const s : string;index : StrLenInt;count : StrLenInt): string;
|
||||
|
||||
begin
|
||||
if count<0 then
|
||||
count:=0;
|
||||
@ -36,26 +35,26 @@ begin
|
||||
Move(s[Index+1],Copy[1],Count);
|
||||
end;
|
||||
|
||||
procedure delete(var s : string;index : StrLenInt;count : StrLenInt);
|
||||
|
||||
procedure delete(var s : string;index : StrLenInt;count : StrLenInt);
|
||||
begin
|
||||
if index<=0 then
|
||||
begin
|
||||
count:=count+index-1;
|
||||
index:=1;
|
||||
end;
|
||||
begin
|
||||
inc(count,index-1);
|
||||
index:=1;
|
||||
end;
|
||||
if (Index<=Length(s)) and (Count>0) then
|
||||
begin
|
||||
if Count+Index>length(s) then
|
||||
begin
|
||||
if Count+Index>length(s) then
|
||||
Count:=length(s)-Index+1;
|
||||
s[0]:=Chr(length(s)-Count);
|
||||
if Index<=Length(s) then
|
||||
s[0]:=Chr(length(s)-Count);
|
||||
if Index<=Length(s) then
|
||||
Move(s[Index+Count],s[Index],Length(s)-Index+1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure insert(const source : string;var s : string;index : StrLenInt);
|
||||
|
||||
procedure insert(const source : string;var s : string;index : StrLenInt);
|
||||
begin
|
||||
if index>1 then
|
||||
dec(index)
|
||||
@ -64,43 +63,43 @@ begin
|
||||
s:=Copy(s,1,Index)+source+Copy(s,Index+1,length(s));
|
||||
end;
|
||||
|
||||
|
||||
function pos(const substr : string;const s : string): byte;
|
||||
|
||||
var i,j : longint;
|
||||
e : boolean;
|
||||
|
||||
var
|
||||
i,j : longint;
|
||||
e : boolean;
|
||||
begin
|
||||
i := 0;
|
||||
j := 0;
|
||||
e:=(length(SubStr)>0);
|
||||
while e and (i<=Length(s)-Length(SubStr)) do
|
||||
begin
|
||||
inc(i);
|
||||
if (SubStr[1]=s[i]) and (Substr=Copy(s,i,Length(SubStr))) then
|
||||
begin
|
||||
j:=i;
|
||||
e:=false;
|
||||
end;
|
||||
end;
|
||||
Pos:=j;
|
||||
i := 0;
|
||||
j := 0;
|
||||
e:=(length(SubStr)>0);
|
||||
while e and (i<=Length(s)-Length(SubStr)) do
|
||||
begin
|
||||
inc(i);
|
||||
if (SubStr[1]=s[i]) and (Substr=Copy(s,i,Length(SubStr))) then
|
||||
begin
|
||||
j:=i;
|
||||
e:=false;
|
||||
end;
|
||||
end;
|
||||
Pos:=j;
|
||||
end;
|
||||
|
||||
|
||||
{Faster when looking for a single char...}
|
||||
|
||||
function pos(c:char;const s:string):byte;
|
||||
|
||||
var i:longint;
|
||||
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
for i:=1 to length(s) do
|
||||
if s[i]=c then
|
||||
begin
|
||||
pos:=i;
|
||||
exit;
|
||||
end;
|
||||
pos:=0;
|
||||
for i:=1 to length(s) do
|
||||
if s[i]=c then
|
||||
begin
|
||||
pos:=i;
|
||||
exit;
|
||||
end;
|
||||
pos:=0;
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef IBM_CHAR_SET}
|
||||
const
|
||||
UpCaseTbl : string[7]=#154#142#153#144#128#143#165;
|
||||
@ -108,7 +107,6 @@ const
|
||||
{$endif}
|
||||
|
||||
function upcase(c : char) : char;
|
||||
|
||||
{$IFDEF IBM_CHAR_SET}
|
||||
var
|
||||
i : longint;
|
||||
@ -128,18 +126,19 @@ begin
|
||||
{$ELSE}
|
||||
upcase:=c;
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function upcase(const s : string) : string;
|
||||
|
||||
var i : longint;
|
||||
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
upcase[0]:=s[0];
|
||||
for i := 1 to length (s) do
|
||||
upcase[i] := upcase (s[i]);
|
||||
end;
|
||||
|
||||
|
||||
{$ifndef RTLLITE}
|
||||
|
||||
function lowercase(c : char) : char;
|
||||
@ -164,18 +163,18 @@ begin
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
function lowercase(const s : string) : string;
|
||||
|
||||
var i : longint;
|
||||
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
lowercase [0] := s[0];
|
||||
for i := 1 to length (s) do
|
||||
lowercase[i] := lowercase (s[i]);
|
||||
lowercase [0]:=s[0];
|
||||
for i:=1 to length(s) do
|
||||
lowercase[i]:=lowercase (s[i]);
|
||||
end;
|
||||
|
||||
function hexstr(val : longint;cnt : byte) : string;
|
||||
|
||||
function hexstr(val : longint;cnt : byte) : string;
|
||||
const
|
||||
HexTbl : array[0..15] of char='0123456789ABCDEF';
|
||||
var
|
||||
@ -190,9 +189,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
|
||||
function binstr(val : longint;cnt : byte) : string;
|
||||
|
||||
function binstr(val : longint;cnt : byte) : string;
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
@ -206,12 +203,13 @@ end;
|
||||
|
||||
{$endif RTLLITE}
|
||||
|
||||
function space (b : byte): string;
|
||||
|
||||
begin
|
||||
space[0] := chr(b);
|
||||
FillChar (Space[1],b,' ');
|
||||
end;
|
||||
function space (b : byte): string;
|
||||
begin
|
||||
space[0] := chr(b);
|
||||
FillChar (Space[1],b,' ');
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Str() Helpers
|
||||
@ -226,6 +224,7 @@ begin
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef SUPPORT_SINGLE}
|
||||
procedure int_str_single(d : single;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_SINGLE'{$else}'STR_SINGLE'{$endif}];
|
||||
begin
|
||||
@ -360,7 +359,16 @@ end;
|
||||
|
||||
procedure val(const s : string;var l : longint;var code : integer);
|
||||
begin
|
||||
val(s,l,word(code));
|
||||
val(s,l,integer(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var l : longint;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
begin
|
||||
val (s,l,cw);
|
||||
code:=cw;
|
||||
end;
|
||||
|
||||
|
||||
@ -368,7 +376,7 @@ procedure val(const s : string;var l : longint);
|
||||
var
|
||||
code : word;
|
||||
begin
|
||||
val (s,l,code);
|
||||
val (s,l,code);
|
||||
end;
|
||||
|
||||
|
||||
@ -396,6 +404,15 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : byte;var code : longint);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
val(s,l,code);
|
||||
b:=l;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : shortint);
|
||||
var
|
||||
l : longint;
|
||||
@ -420,6 +437,15 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : shortint;var code : longint);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
val(s,l,code);
|
||||
b:=l;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : word);
|
||||
var
|
||||
l : longint;
|
||||
@ -444,9 +470,18 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : word;var code : longint);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
val(s,l,code);
|
||||
b:=l;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : integer);
|
||||
var
|
||||
l : longint;
|
||||
l : longint;
|
||||
begin
|
||||
val(s,l);
|
||||
b:=l;
|
||||
@ -455,7 +490,7 @@ end;
|
||||
|
||||
procedure val(const s : string;var b : integer;var code : word);
|
||||
var
|
||||
l : longint;
|
||||
l : longint;
|
||||
begin
|
||||
val(s,l,code);
|
||||
b:=l;
|
||||
@ -467,6 +502,71 @@ begin
|
||||
val(s,b,word(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : integer;var code : longint);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
val(s,l,code);
|
||||
b:=l;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var v : cardinal;var code : word);
|
||||
var
|
||||
negativ : boolean;
|
||||
base,u : byte;
|
||||
begin
|
||||
v:=0;
|
||||
code:=InitVal(s,negativ,base);
|
||||
if (Code>length(s)) or negativ then
|
||||
exit;
|
||||
while Code<=Length(s) do
|
||||
begin
|
||||
u:=ord(s[code]);
|
||||
case u of
|
||||
48..57 : u:=u-48;
|
||||
65..70 : u:=u-55;
|
||||
97..104 : u:=u-87;
|
||||
else
|
||||
u:=16;
|
||||
end;
|
||||
cardinal(v):=cardinal(v)*cardinal(longint(base));
|
||||
if (u>base) or (cardinal($ffffffff)-cardinal(v)>cardinal(longint(u))) then
|
||||
begin
|
||||
v:=0;
|
||||
exit;
|
||||
end;
|
||||
v:=v+u;
|
||||
inc(code);
|
||||
end;
|
||||
code:=0;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var v : cardinal);
|
||||
var
|
||||
code : word;
|
||||
begin
|
||||
val(s,v,code);
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var v : cardinal;var code : integer);
|
||||
begin
|
||||
val(s,v,word(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var v : cardinal;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
begin
|
||||
val(s,v,cw);
|
||||
code:=cw;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : valreal;var code : word);
|
||||
var
|
||||
hd,
|
||||
@ -566,12 +666,22 @@ begin
|
||||
code:=0;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : valreal;var code : integer);
|
||||
begin
|
||||
val(s,d,word(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : valreal;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
begin
|
||||
val(s,d,cw);
|
||||
code:=cw;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : valreal);
|
||||
var
|
||||
code : word;
|
||||
@ -599,16 +709,28 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : single;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
e : valreal;
|
||||
begin
|
||||
val(s,e,cw);
|
||||
d:=e;
|
||||
code:=cw;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : single);
|
||||
var
|
||||
code : word;
|
||||
e : double;
|
||||
e : valreal;
|
||||
begin
|
||||
val(s,e,code);
|
||||
d:=e;
|
||||
end;
|
||||
{$endif SUPPORT_SINGLE}
|
||||
|
||||
|
||||
{$ifdef DEFAULT_EXTENDED}
|
||||
|
||||
{ with extended as default the valreal is extended so for real there need
|
||||
@ -625,13 +747,24 @@ end;
|
||||
|
||||
procedure val(const s : string;var d : real;var code : integer);
|
||||
var
|
||||
e : valreal;
|
||||
e : valreal;
|
||||
begin
|
||||
val(s,e,word(code));
|
||||
d:=e;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : real;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
e : valreal;
|
||||
begin
|
||||
val(s,e,cw);
|
||||
d:=e;
|
||||
code:=cw;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : real);
|
||||
var
|
||||
code : word;
|
||||
@ -657,12 +790,22 @@ end;
|
||||
|
||||
procedure val(const s : string;var d : extended;var code : integer);
|
||||
var
|
||||
e : valreal;
|
||||
e : valreal;
|
||||
begin
|
||||
val(s,e,word(code));
|
||||
d:=e;
|
||||
end;
|
||||
|
||||
procedure val(const s : string;var d : extended;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
e : valreal;
|
||||
begin
|
||||
val(s,e,cw);
|
||||
d:=e;
|
||||
code:=cw;
|
||||
end;
|
||||
|
||||
procedure val(const s : string;var d : extended);
|
||||
var
|
||||
code : word;
|
||||
@ -696,6 +839,17 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : comp;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
e : valreal;
|
||||
begin
|
||||
val(s,e,cw);
|
||||
d:=comp(e);
|
||||
code:=cw;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : comp);
|
||||
var
|
||||
code : word;
|
||||
@ -706,54 +860,56 @@ begin
|
||||
end;
|
||||
{$endif SUPPORT_COMP}
|
||||
|
||||
procedure val(const s : string;var v : cardinal;var code : word);
|
||||
|
||||
{$ifdef SUPPORT_FIXED}
|
||||
procedure val(const s : string;var d : fixed;var code : word);
|
||||
var
|
||||
negativ : boolean;
|
||||
base,u : byte;
|
||||
e : valreal;
|
||||
begin
|
||||
v:=0;
|
||||
code:=InitVal(s,negativ,base);
|
||||
if (Code>length(s)) or negativ then
|
||||
exit;
|
||||
while Code<=Length(s) do
|
||||
begin
|
||||
u:=ord(s[code]);
|
||||
case u of
|
||||
48..57 : u:=u-48;
|
||||
65..70 : u:=u-55;
|
||||
97..104 : u:=u-87;
|
||||
else
|
||||
u:=16;
|
||||
end;
|
||||
cardinal(v):=cardinal(v)*cardinal(longint(base));
|
||||
if (u>base) or (cardinal($ffffffff)-cardinal(v)>cardinal(longint(u))) then
|
||||
begin
|
||||
v:=0;
|
||||
exit;
|
||||
end;
|
||||
v:=v+u;
|
||||
inc(code);
|
||||
end;
|
||||
code:=0;
|
||||
val(s,e,code);
|
||||
d:=fixed(e);
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var v : cardinal);
|
||||
procedure val(const s : string;var d : fixed;var code : integer);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
val(s,e,word(code));
|
||||
d:=fixed(e);
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : fixed;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
e : valreal;
|
||||
begin
|
||||
val(s,e,cw);
|
||||
d:=fixed(e);
|
||||
code:=cw;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : fixed);
|
||||
var
|
||||
code : word;
|
||||
e : valreal;
|
||||
begin
|
||||
val(s,v,code);
|
||||
val(s,e,code);
|
||||
d:=fixed(e);
|
||||
end;
|
||||
{$endif SUPPORT_FIXED}
|
||||
|
||||
|
||||
procedure val(const s : string;var v : cardinal;var code : integer);
|
||||
begin
|
||||
val(s,v,word(code));
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 1998-09-14 10:48:19 peter
|
||||
Revision 1.13 1998-10-10 15:28:46 peter
|
||||
+ read single,fixed
|
||||
+ val with code:longint
|
||||
+ val for fixed
|
||||
|
||||
Revision 1.12 1998/09/14 10:48:19 peter
|
||||
* FPC_ names
|
||||
* Heap manager is now system independent
|
||||
|
||||
|
||||
@ -201,43 +201,60 @@ Function binStr(Val:Longint;cnt:byte):string;
|
||||
Function Space(b:byte):string;
|
||||
Procedure Val(const s:string;Var l:Longint;Var code:Word);
|
||||
Procedure Val(const s:string;Var l:Longint;Var code:Integer);
|
||||
Procedure Val(const s:string;Var l:Longint;Var code:Longint);
|
||||
Procedure Val(const s:string;Var l:Longint);
|
||||
Procedure Val(const s:string;Var b:byte;Var code:Word);
|
||||
Procedure Val(const s:string;Var b:byte;Var code:Integer);
|
||||
Procedure Val(const s:string;Var b:byte;Var code:Longint);
|
||||
Procedure Val(const s:string;Var b:byte);
|
||||
Procedure Val(const s:string;Var b:shortint;Var code:Word);
|
||||
Procedure Val(const s:string;Var b:shortint;Var code:Integer);
|
||||
Procedure Val(const s:string;Var b:shortint;Var code:Longint);
|
||||
Procedure Val(const s:string;Var b:shortint);
|
||||
Procedure Val(const s:string;Var b:Word;Var code:Word);
|
||||
Procedure Val(const s:string;Var b:Word;Var code:Integer);
|
||||
Procedure Val(const s:string;Var b:Word;Var code:Longint);
|
||||
Procedure Val(const s:string;Var b:Word);
|
||||
Procedure Val(const s:string;Var b:Integer;Var code:Word);
|
||||
Procedure Val(const s:string;Var b:Integer;Var code:Integer);
|
||||
Procedure Val(const s:string;Var b:Integer;Var code:Longint);
|
||||
Procedure Val(const s:string;Var b:Integer);
|
||||
Procedure Val(const s:string;Var v:cardinal;Var code:Word);
|
||||
Procedure Val(const s:string;Var v:cardinal;Var code:Integer);
|
||||
Procedure Val(const s:string;Var v:cardinal;Var code:Longint);
|
||||
Procedure Val(const s:string;Var v:cardinal);
|
||||
Procedure Val(const s:string;Var d:ValReal;Var code:Word);
|
||||
Procedure Val(const s:string;Var d:ValReal;Var code:Integer);
|
||||
Procedure Val(const s:string;Var d:ValReal;Var code:Longint);
|
||||
Procedure Val(const s:string;Var d:ValReal);
|
||||
{$ifdef SUPPORT_SINGLE}
|
||||
Procedure Val(const s:string;Var d:single;Var code:Word);
|
||||
Procedure Val(const s:string;Var d:single;Var code:Integer);
|
||||
Procedure Val(const s:string;Var d:single;Var code:Longint);
|
||||
Procedure Val(const s:string;Var d:single);
|
||||
{$endif SUPPORT_SINGLE}
|
||||
{$ifdef SUPPORT_COMP}
|
||||
Procedure Val(const s:string;Var d:comp;Var code:Word);
|
||||
Procedure Val(const s:string;Var d:comp;Var code:Integer);
|
||||
Procedure Val(const s:string;Var d:comp;Var code:Longint);
|
||||
Procedure Val(const s:string;Var d:comp);
|
||||
{$endif SUPPORT_COMP}
|
||||
{$ifdef SUPPORT_FIXED}
|
||||
Procedure Val(const s:string;Var d:fixed;Var code:Word);
|
||||
Procedure Val(const s:string;Var d:fixed;Var code:Integer);
|
||||
Procedure Val(const s:string;Var d:fixed;Var code:Longint);
|
||||
Procedure Val(const s:string;Var d:fixed);
|
||||
{$endif SUPPORT_FIXED}
|
||||
{$ifdef DEFAULT_EXTENDED}
|
||||
Procedure Val(const s:string;Var d:Real;Var code:Word);
|
||||
Procedure Val(const s:string;Var d:Real;Var code:Integer);
|
||||
Procedure Val(const s:string;Var d:Real;Var code:Longint);
|
||||
Procedure Val(const s:string;Var d:Real);
|
||||
{$else DEFAULT_EXTENDED}
|
||||
{$ifdef SUPPORT_EXTENDED}
|
||||
Procedure Val(const s:string;Var d:Extended;Var code:Word);
|
||||
Procedure Val(const s:string;Var d:Extended;Var code:Integer);
|
||||
Procedure Val(const s:string;Var d:Extended;Var code:Longint);
|
||||
Procedure Val(const s:string;Var d:Extended);
|
||||
{$endif}
|
||||
{$endif DEFAULT_EXTENDED}
|
||||
@ -405,7 +422,12 @@ const
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.36 1998-10-05 17:22:54 pierre
|
||||
Revision 1.37 1998-10-10 15:28:47 peter
|
||||
+ read single,fixed
|
||||
+ val with code:longint
|
||||
+ val for fixed
|
||||
|
||||
Revision 1.36 1998/10/05 17:22:54 pierre
|
||||
* avoid overflow on $8000000 with $Q-
|
||||
|
||||
Revision 1.35 1998/10/05 12:32:52 peter
|
||||
|
||||
125
rtl/inc/text.inc
125
rtl/inc/text.inc
@ -1075,13 +1075,11 @@ Begin
|
||||
HandleError(106);
|
||||
End;
|
||||
|
||||
|
||||
Procedure Read_Real(var f : TextRec;var d : Real);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_REAL'];
|
||||
function ReadRealStr(var f:TextRec):string;
|
||||
var
|
||||
hs : String;
|
||||
code : Word;
|
||||
Begin
|
||||
d:=0.0;
|
||||
hs : string;
|
||||
begin
|
||||
ReadRealStr:='';
|
||||
{ Leave if error or not open file, else check for empty buf }
|
||||
If (InOutRes<>0) then
|
||||
exit;
|
||||
@ -1115,53 +1113,38 @@ Begin
|
||||
ReadNumeric(f,hs,10);
|
||||
end;
|
||||
end;
|
||||
val(hs,d,code);
|
||||
ReadRealStr:=hs;
|
||||
end;
|
||||
|
||||
|
||||
Procedure Read_Real(var f : TextRec;var d : Real);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_REAL'];
|
||||
var
|
||||
code : Word;
|
||||
Begin
|
||||
val(ReadRealStr(f),d,code);
|
||||
If code<>0 Then
|
||||
HandleError(106);
|
||||
End;
|
||||
|
||||
|
||||
{$ifdef SUPPORT_SINGLE}
|
||||
Procedure Read_Single(var f : TextRec;var d : single);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_SINGLE'];
|
||||
var
|
||||
code : Word;
|
||||
Begin
|
||||
val(ReadRealStr(f),d,code);
|
||||
If code<>0 Then
|
||||
HandleError(106);
|
||||
End;
|
||||
{$endif SUPPORT_SINGLE}
|
||||
|
||||
|
||||
{$ifdef SUPPORT_EXTENDED}
|
||||
Procedure Read_Extended(var f : TextRec;var d : extended);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_EXTENDED'];
|
||||
var
|
||||
hs : String;
|
||||
code : Word;
|
||||
Begin
|
||||
d:=0.0;
|
||||
{ Leave if error or not open file, else check for empty buf }
|
||||
If (InOutRes<>0) then
|
||||
exit;
|
||||
if (f.mode<>fmInput) Then
|
||||
begin
|
||||
InOutRes:=104;
|
||||
exit;
|
||||
end;
|
||||
If f.BufPos>=f.BufEnd Then
|
||||
FileFunc(f.InOutFunc)(f);
|
||||
hs:='';
|
||||
if IgnoreSpaces(f) and ReadSign(f,hs) and ReadNumeric(f,hs,10) then
|
||||
begin
|
||||
{ First check for a . }
|
||||
if (f.Bufptr^[f.BufPos]='.') and (f.BufPos<f.BufEnd) Then
|
||||
begin
|
||||
hs:=hs+'.';
|
||||
Inc(f.BufPos);
|
||||
If f.BufPos>=f.BufEnd Then
|
||||
FileFunc(f.InOutFunc)(f);
|
||||
ReadNumeric(f,hs,10);
|
||||
end;
|
||||
{ Also when a point is found check for a E }
|
||||
if (f.Bufptr^[f.BufPos] in ['e','E']) and (f.BufPos<f.BufEnd) Then
|
||||
begin
|
||||
hs:=hs+'E';
|
||||
Inc(f.BufPos);
|
||||
If f.BufPos>=f.BufEnd Then
|
||||
FileFunc(f.InOutFunc)(f);
|
||||
if ReadSign(f,hs) then
|
||||
ReadNumeric(f,hs,10);
|
||||
end;
|
||||
end;
|
||||
val(hs,d,code);
|
||||
val(ReadRealStr(f),d,code);
|
||||
If code<>0 Then
|
||||
HandleError(106);
|
||||
End;
|
||||
@ -1171,50 +1154,27 @@ End;
|
||||
{$ifdef SUPPORT_COMP}
|
||||
Procedure Read_Comp(var f : TextRec;var d : comp);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_COMP'];
|
||||
var
|
||||
hs : String;
|
||||
code : Word;
|
||||
Begin
|
||||
d:=comp(0.0);
|
||||
{ Leave if error or not open file, else check for empty buf }
|
||||
If (InOutRes<>0) then
|
||||
exit;
|
||||
if (f.mode<>fmInput) Then
|
||||
begin
|
||||
InOutRes:=104;
|
||||
exit;
|
||||
end;
|
||||
If f.BufPos>=f.BufEnd Then
|
||||
FileFunc(f.InOutFunc)(f);
|
||||
hs:='';
|
||||
if IgnoreSpaces(f) and ReadSign(f,hs) and ReadNumeric(f,hs,10) then
|
||||
begin
|
||||
{ First check for a . }
|
||||
if (f.Bufptr^[f.BufPos]='.') and (f.BufPos<f.BufEnd) Then
|
||||
begin
|
||||
hs:=hs+'.';
|
||||
Inc(f.BufPos);
|
||||
If f.BufPos>=f.BufEnd Then
|
||||
FileFunc(f.InOutFunc)(f);
|
||||
ReadNumeric(f,hs,10);
|
||||
end;
|
||||
{ Also when a point is found check for a E }
|
||||
if (f.Bufptr^[f.BufPos] in ['e','E']) and (f.BufPos<f.BufEnd) Then
|
||||
begin
|
||||
hs:=hs+'E';
|
||||
Inc(f.BufPos);
|
||||
If f.BufPos>=f.BufEnd Then
|
||||
FileFunc(f.InOutFunc)(f);
|
||||
if ReadSign(f,hs) then
|
||||
ReadNumeric(f,hs,10);
|
||||
end;
|
||||
end;
|
||||
val(hs,d,code);
|
||||
val(ReadRealStr(f),d,code);
|
||||
If code<>0 Then
|
||||
HandleError(106);
|
||||
End;
|
||||
{$endif SUPPORT_COMP}
|
||||
|
||||
|
||||
{$ifdef SUPPORT_FIXED}
|
||||
Procedure Read_Fixed(var f : TextRec;var d : fixed);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_FIXED'];
|
||||
var
|
||||
code : Word;
|
||||
Begin
|
||||
val(ReadRealStr(f),d,code);
|
||||
If code<>0 Then
|
||||
HandleError(106);
|
||||
End;
|
||||
{$endif SUPPORT_FIXED}
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Initializing
|
||||
*****************************************************************************}
|
||||
@ -1239,7 +1199,12 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.30 1998-09-29 08:39:07 michael
|
||||
Revision 1.31 1998-10-10 15:28:48 peter
|
||||
+ read single,fixed
|
||||
+ val with code:longint
|
||||
+ val for fixed
|
||||
|
||||
Revision 1.30 1998/09/29 08:39:07 michael
|
||||
+ Ansistring write now gets pointer.
|
||||
|
||||
Revision 1.29 1998/09/28 14:27:08 michael
|
||||
|
||||
Loading…
Reference in New Issue
Block a user