mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 15:49:26 +02:00
* ansistring fixes
This commit is contained in:
peter
parent
7469443729
commit
5727090134
@ -172,16 +172,15 @@ Procedure AssignAnsiString (Var S1 : Pointer;S2 : Pointer);
|
||||
{
|
||||
Assigns S2 to S1 (S1:=S2), taking in account reference counts.
|
||||
}
|
||||
|
||||
begin
|
||||
If S2<>nil then
|
||||
If PAnsiRec(S2-FirstOff)^.Ref>0 then
|
||||
Inc(PAnsiRec(S2-FirstOff)^.ref);
|
||||
Temp:=S2;
|
||||
{ Temp:=S2;
|
||||
end;
|
||||
end
|
||||
else
|
||||
temp:=S2;
|
||||
temp:=S2; }
|
||||
{ Decrease the reference count on the old S1 }
|
||||
Decr_Ansi_Ref (S1);
|
||||
{ And finally, have S1 pointing to S2 (or its copy) }
|
||||
@ -391,7 +390,7 @@ Procedure SetLength (Var S : AnsiString; l : Longint);
|
||||
Makes sure S is unique, and contains enough room.
|
||||
}
|
||||
Var Temp : Pointer;
|
||||
|
||||
|
||||
begin
|
||||
If (Pointer(S)=Nil) and (l>0) then
|
||||
begin
|
||||
@ -406,7 +405,7 @@ begin
|
||||
If (PAnsiRec(Pointer(S)-FirstOff)^.Maxlen < L) or
|
||||
(PAnsiRec(Pointer(S)-FirstOff)^.Ref <> 1) then
|
||||
begin
|
||||
{ Reallocation is needed... }
|
||||
{ Reallocation is needed... }
|
||||
Temp:=Pointer(NewAnsiString(L));
|
||||
if Length(S)>0 then
|
||||
Move (Pointer(S)^,Temp^,Length(S)+1);
|
||||
@ -681,7 +680,7 @@ end;
|
||||
Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
|
||||
|
||||
var s3,s4,s5 : Pointer;
|
||||
|
||||
|
||||
begin
|
||||
If Length(Source)=0 then exit;
|
||||
if index <= 0 then index := 1;
|
||||
@ -702,7 +701,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.26 1998-11-02 09:46:12 michael
|
||||
Revision 1.27 1998-11-04 10:20:48 peter
|
||||
* ansistring fixes
|
||||
|
||||
Revision 1.26 1998/11/02 09:46:12 michael
|
||||
+ Fix for assign of null string
|
||||
|
||||
Revision 1.25 1998/10/30 21:42:48 michael
|
||||
@ -787,4 +789,4 @@ end;
|
||||
* removed logs
|
||||
* removed $ifdef ver_above
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
|
||||
{$I real2str.inc}
|
||||
|
||||
function copy(const s : string;index : StrLenInt;count : StrLenInt): string;
|
||||
function copy(const s : shortstring;index : StrLenInt;count : StrLenInt): shortstring;
|
||||
begin
|
||||
if count<0 then
|
||||
count:=0;
|
||||
@ -36,7 +36,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure delete(var s : string;index : StrLenInt;count : StrLenInt);
|
||||
procedure delete(var s : shortstring;index : StrLenInt;count : StrLenInt);
|
||||
begin
|
||||
if index<=0 then
|
||||
begin
|
||||
@ -54,7 +54,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure insert(const source : string;var s : string;index : StrLenInt);
|
||||
procedure insert(const source : shortstring;var s : shortstring;index : StrLenInt);
|
||||
begin
|
||||
if index>1 then
|
||||
dec(index)
|
||||
@ -64,9 +64,9 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function pos(const substr : string;const s : string): byte;
|
||||
function pos(const substr : shortstring;const s : shortstring):StrLenInt;
|
||||
var
|
||||
i,j : longint;
|
||||
i,j : StrLenInt;
|
||||
e : boolean;
|
||||
begin
|
||||
i := 0;
|
||||
@ -86,9 +86,9 @@ end;
|
||||
|
||||
|
||||
{Faster when looking for a single char...}
|
||||
function pos(c:char;const s:string):byte;
|
||||
function pos(c:char;const s:shortstring):StrLenInt;
|
||||
var
|
||||
i : longint;
|
||||
i : StrLenInt;
|
||||
begin
|
||||
for i:=1 to length(s) do
|
||||
if s[i]=c then
|
||||
@ -100,10 +100,42 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure SetLength(var s:shortstring;len:StrLenInt);
|
||||
begin
|
||||
if Len>255 then
|
||||
Len:=255;
|
||||
s[0]:=chr(len);
|
||||
end;
|
||||
|
||||
|
||||
function copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
|
||||
begin
|
||||
if (index=1) and (Count>0) then
|
||||
Copy:=c
|
||||
else
|
||||
Copy:='';
|
||||
end;
|
||||
|
||||
|
||||
function pos(const substr : shortstring;c:char): StrLenInt;
|
||||
begin
|
||||
if (length(substr)=1) and (substr[1]=c) then
|
||||
Pos:=1
|
||||
else
|
||||
Pos:=0;
|
||||
end;
|
||||
|
||||
|
||||
function length(c:char):StrLenInt;
|
||||
begin
|
||||
Length:=1;
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef IBM_CHAR_SET}
|
||||
const
|
||||
UpCaseTbl : string[7]=#154#142#153#144#128#143#165;
|
||||
LoCaseTbl : string[7]=#129#132#148#130#135#134#164;
|
||||
UpCaseTbl : shortstring[7]=#154#142#153#144#128#143#165;
|
||||
LoCaseTbl : shortstring[7]=#129#132#148#130#135#134#164;
|
||||
{$endif}
|
||||
|
||||
function upcase(c : char) : char;
|
||||
@ -129,7 +161,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function upcase(const s : string) : string;
|
||||
function upcase(const s : shortstring) : shortstring;
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
@ -164,7 +196,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function lowercase(const s : string) : string;
|
||||
function lowercase(const s : shortstring) : shortstring;
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
@ -174,7 +206,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function hexstr(val : longint;cnt : byte) : string;
|
||||
function hexstr(val : longint;cnt : byte) : shortstring;
|
||||
const
|
||||
HexTbl : array[0..15] of char='0123456789ABCDEF';
|
||||
var
|
||||
@ -189,7 +221,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function binstr(val : longint;cnt : byte) : string;
|
||||
function binstr(val : longint;cnt : byte) : shortstring;
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
@ -204,7 +236,7 @@ end;
|
||||
{$endif RTLLITE}
|
||||
|
||||
|
||||
function space (b : byte): string;
|
||||
function space (b : byte): shortstring;
|
||||
begin
|
||||
space[0] := chr(b);
|
||||
FillChar (Space[1],b,' ');
|
||||
@ -215,7 +247,7 @@ end;
|
||||
Str() Helpers
|
||||
*****************************************************************************}
|
||||
|
||||
procedure int_str_real(d : real;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_REAL'{$else}'STR_REAL'{$endif}];
|
||||
procedure int_str_real(d : real;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_REAL'{$else}'STR_REAL'{$endif}];
|
||||
begin
|
||||
{$ifdef i386}
|
||||
str_real(len,fr,d,rt_s64real,s);
|
||||
@ -226,7 +258,7 @@ 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}];
|
||||
procedure int_str_single(d : single;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_SINGLE'{$else}'STR_SINGLE'{$endif}];
|
||||
begin
|
||||
str_real(len,fr,d,rt_s32real,s);
|
||||
end;
|
||||
@ -234,7 +266,7 @@ end;
|
||||
|
||||
|
||||
{$ifdef SUPPORT_EXTENDED}
|
||||
procedure int_str_extended(d : extended;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_EXTENDED'{$else}'STR_EXTENDED'{$endif}];
|
||||
procedure int_str_extended(d : extended;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_EXTENDED'{$else}'STR_EXTENDED'{$endif}];
|
||||
begin
|
||||
str_real(len,fr,d,rt_s80real,s);
|
||||
end;
|
||||
@ -242,7 +274,7 @@ end;
|
||||
|
||||
|
||||
{$ifdef SUPPORT_COMP}
|
||||
procedure int_str_comp(d : comp;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_COMP'{$else}'STR_COMP'{$endif}];
|
||||
procedure int_str_comp(d : comp;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_COMP'{$else}'STR_COMP'{$endif}];
|
||||
begin
|
||||
str_real(len,fr,d,rt_s64bit,s);
|
||||
end;
|
||||
@ -250,14 +282,14 @@ end;
|
||||
|
||||
|
||||
{$ifdef SUPPORT_FIXED}
|
||||
procedure int_str_fixed(d : fixed;len,fr : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_FIXED'{$else}'STR_FIXED'{$endif}];
|
||||
procedure int_str_fixed(d : fixed;len,fr : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_FIXED'{$else}'STR_FIXED'{$endif}];
|
||||
begin
|
||||
str_real(len,fr,d,rt_f32bit,s);
|
||||
end;
|
||||
{$endif SUPPORT_FIXED}
|
||||
|
||||
|
||||
procedure int_str_longint(v : longint;len : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_LONGINT'{$else}'STR_LONGINT'{$endif}];
|
||||
procedure int_str_longint(v : longint;len : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_LONGINT'{$else}'STR_LONGINT'{$endif}];
|
||||
begin
|
||||
int_str(v,s);
|
||||
if length(s)<len then
|
||||
@ -265,7 +297,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure int_str_cardinal(v : cardinal;len : longint;var s : string);[public, alias : {$ifdef FPCNAMES}'FPC_STR_CARDINAL'{$else}'STR_CARDINAL'{$endif}];
|
||||
procedure int_str_cardinal(v : cardinal;len : longint;var s : shortstring);[public, alias : {$ifdef FPCNAMES}'FPC_STR_CARDINAL'{$else}'STR_CARDINAL'{$endif}];
|
||||
begin
|
||||
int_str(v,s);
|
||||
if length(s)<len then
|
||||
@ -277,7 +309,7 @@ end;
|
||||
Val() Functions
|
||||
*****************************************************************************}
|
||||
|
||||
Function InitVal(const s:string;var negativ:boolean;var base:byte):Word;
|
||||
Function InitVal(const s:shortstring;var negativ:boolean;var base:byte):Word;
|
||||
var
|
||||
Code : Longint;
|
||||
begin
|
||||
@ -317,7 +349,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var l : longint;var code : word);
|
||||
procedure val(const s : shortstring;var l : longint;var code : word);
|
||||
var
|
||||
base,u : byte;
|
||||
negativ : boolean;
|
||||
@ -357,13 +389,13 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var l : longint;var code : integer);
|
||||
procedure val(const s : shortstring;var l : longint;var code : integer);
|
||||
begin
|
||||
val(s,l,word(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var l : longint;var code : longint);
|
||||
procedure val(const s : shortstring;var l : longint;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
begin
|
||||
@ -372,7 +404,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var l : longint);
|
||||
procedure val(const s : shortstring;var l : longint);
|
||||
var
|
||||
code : word;
|
||||
begin
|
||||
@ -380,7 +412,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : byte);
|
||||
procedure val(const s : shortstring;var b : byte);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -389,7 +421,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : byte;var code : word);
|
||||
procedure val(const s : shortstring;var b : byte;var code : word);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -398,13 +430,13 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : byte;var code : Integer);
|
||||
procedure val(const s : shortstring;var b : byte;var code : Integer);
|
||||
begin
|
||||
val(s,b,word(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : byte;var code : longint);
|
||||
procedure val(const s : shortstring;var b : byte;var code : longint);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -413,7 +445,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : shortint);
|
||||
procedure val(const s : shortstring;var b : shortint);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -422,7 +454,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : shortint;var code : word);
|
||||
procedure val(const s : shortstring;var b : shortint;var code : word);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -431,13 +463,13 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : shortint;var code : Integer);
|
||||
procedure val(const s : shortstring;var b : shortint;var code : Integer);
|
||||
begin
|
||||
val(s,b,word(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : shortint;var code : longint);
|
||||
procedure val(const s : shortstring;var b : shortint;var code : longint);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -446,7 +478,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : word);
|
||||
procedure val(const s : shortstring;var b : word);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -455,7 +487,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : word;var code : word);
|
||||
procedure val(const s : shortstring;var b : word;var code : word);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -464,13 +496,13 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : word;var code : Integer);
|
||||
procedure val(const s : shortstring;var b : word;var code : Integer);
|
||||
begin
|
||||
val(s,b,word(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : word;var code : longint);
|
||||
procedure val(const s : shortstring;var b : word;var code : longint);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -479,7 +511,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : integer);
|
||||
procedure val(const s : shortstring;var b : integer);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -488,7 +520,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : integer;var code : word);
|
||||
procedure val(const s : shortstring;var b : integer;var code : word);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -497,13 +529,13 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : integer;var code : Integer);
|
||||
procedure val(const s : shortstring;var b : integer;var code : Integer);
|
||||
begin
|
||||
val(s,b,word(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var b : integer;var code : longint);
|
||||
procedure val(const s : shortstring;var b : integer;var code : longint);
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
@ -512,7 +544,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var v : cardinal;var code : word);
|
||||
procedure val(const s : shortstring;var v : cardinal;var code : word);
|
||||
var
|
||||
negativ : boolean;
|
||||
base,u : byte;
|
||||
@ -544,7 +576,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var v : cardinal);
|
||||
procedure val(const s : shortstring;var v : cardinal);
|
||||
var
|
||||
code : word;
|
||||
begin
|
||||
@ -552,13 +584,13 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var v : cardinal;var code : integer);
|
||||
procedure val(const s : shortstring;var v : cardinal;var code : integer);
|
||||
begin
|
||||
val(s,v,word(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var v : cardinal;var code : longint);
|
||||
procedure val(const s : shortstring;var v : cardinal;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
begin
|
||||
@ -567,7 +599,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : valreal;var code : word);
|
||||
procedure val(const s : shortstring;var d : valreal;var code : word);
|
||||
var
|
||||
hd,
|
||||
esign,sign : valreal;
|
||||
@ -667,13 +699,13 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : valreal;var code : integer);
|
||||
procedure val(const s : shortstring;var d : valreal;var code : integer);
|
||||
begin
|
||||
val(s,d,word(code));
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : valreal;var code : longint);
|
||||
procedure val(const s : shortstring;var d : valreal;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
begin
|
||||
@ -682,7 +714,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : valreal);
|
||||
procedure val(const s : shortstring;var d : valreal);
|
||||
var
|
||||
code : word;
|
||||
begin
|
||||
@ -691,7 +723,7 @@ end;
|
||||
|
||||
|
||||
{$ifdef SUPPORT_SINGLE}
|
||||
procedure val(const s : string;var d : single;var code : word);
|
||||
procedure val(const s : shortstring;var d : single;var code : word);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
@ -700,7 +732,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : single;var code : integer);
|
||||
procedure val(const s : shortstring;var d : single;var code : integer);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
@ -709,7 +741,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : single;var code : longint);
|
||||
procedure val(const s : shortstring;var d : single;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
e : valreal;
|
||||
@ -720,7 +752,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : single);
|
||||
procedure val(const s : shortstring;var d : single);
|
||||
var
|
||||
code : word;
|
||||
e : valreal;
|
||||
@ -736,7 +768,7 @@ end;
|
||||
{ with extended as default the valreal is extended so for real there need
|
||||
to be a new val }
|
||||
|
||||
procedure val(const s : string;var d : real;var code : word);
|
||||
procedure val(const s : shortstring;var d : real;var code : word);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
@ -745,7 +777,7 @@ end;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : real;var code : integer);
|
||||
procedure val(const s : shortstring;var d : real;var code : integer);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
@ -754,7 +786,7 @@ end;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : real;var code : longint);
|
||||
procedure val(const s : shortstring;var d : real;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
e : valreal;
|
||||
@ -765,7 +797,7 @@ end;
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : real);
|
||||
procedure val(const s : shortstring;var d : real);
|
||||
var
|
||||
code : word;
|
||||
e : valreal;
|
||||
@ -780,7 +812,7 @@ end;
|
||||
|
||||
{$ifdef SUPPORT_EXTENDED}
|
||||
|
||||
procedure val(const s : string;var d : extended;var code : word);
|
||||
procedure val(const s : shortstring;var d : extended;var code : word);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
@ -788,7 +820,7 @@ end;
|
||||
d:=e;
|
||||
end;
|
||||
|
||||
procedure val(const s : string;var d : extended;var code : integer);
|
||||
procedure val(const s : shortstring;var d : extended;var code : integer);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
@ -796,7 +828,7 @@ end;
|
||||
d:=e;
|
||||
end;
|
||||
|
||||
procedure val(const s : string;var d : extended;var code : longint);
|
||||
procedure val(const s : shortstring;var d : extended;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
e : valreal;
|
||||
@ -806,7 +838,7 @@ end;
|
||||
code:=cw;
|
||||
end;
|
||||
|
||||
procedure val(const s : string;var d : extended);
|
||||
procedure val(const s : shortstring;var d : extended);
|
||||
var
|
||||
code : word;
|
||||
e : valreal;
|
||||
@ -821,7 +853,7 @@ end;
|
||||
|
||||
|
||||
{$ifdef SUPPORT_COMP}
|
||||
procedure val(const s : string;var d : comp;var code : word);
|
||||
procedure val(const s : shortstring;var d : comp;var code : word);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
@ -830,7 +862,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : comp;var code : integer);
|
||||
procedure val(const s : shortstring;var d : comp;var code : integer);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
@ -839,7 +871,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : comp;var code : longint);
|
||||
procedure val(const s : shortstring;var d : comp;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
e : valreal;
|
||||
@ -850,7 +882,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : comp);
|
||||
procedure val(const s : shortstring;var d : comp);
|
||||
var
|
||||
code : word;
|
||||
e : valreal;
|
||||
@ -862,7 +894,7 @@ end;
|
||||
|
||||
|
||||
{$ifdef SUPPORT_FIXED}
|
||||
procedure val(const s : string;var d : fixed;var code : word);
|
||||
procedure val(const s : shortstring;var d : fixed;var code : word);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
@ -871,7 +903,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : fixed;var code : integer);
|
||||
procedure val(const s : shortstring;var d : fixed;var code : integer);
|
||||
var
|
||||
e : valreal;
|
||||
begin
|
||||
@ -880,7 +912,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : fixed;var code : longint);
|
||||
procedure val(const s : shortstring;var d : fixed;var code : longint);
|
||||
var
|
||||
cw : word;
|
||||
e : valreal;
|
||||
@ -891,7 +923,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure val(const s : string;var d : fixed);
|
||||
procedure val(const s : shortstring;var d : fixed);
|
||||
var
|
||||
code : word;
|
||||
e : valreal;
|
||||
@ -904,7 +936,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 1998-10-11 14:30:19 peter
|
||||
Revision 1.15 1998-11-04 10:20:50 peter
|
||||
* ansistring fixes
|
||||
|
||||
Revision 1.14 1998/10/11 14:30:19 peter
|
||||
* small typo :(
|
||||
|
||||
Revision 1.13 1998/10/10 15:28:46 peter
|
||||
|
||||
@ -67,7 +67,9 @@ Type
|
||||
{ some type aliases }
|
||||
dword = cardinal;
|
||||
longword = cardinal;
|
||||
ShortString = String[255];
|
||||
{$ifndef useansistrings}
|
||||
shortstring = string;
|
||||
{$endif}
|
||||
|
||||
{ Zero - terminated strings }
|
||||
PChar = ^Char;
|
||||
@ -182,80 +184,88 @@ Function Sseg:Word;
|
||||
PChar and String Handling
|
||||
****************************************************************************}
|
||||
|
||||
function strpas(p:pchar):string;
|
||||
function strpas(p:pchar):shortstring;
|
||||
function strlen(p:pchar):longint;
|
||||
|
||||
Function Copy(const s:string;index:StrLenInt;count:StrLenInt):string;
|
||||
Procedure Delete(Var s:string;index:StrLenInt;count:StrLenInt);
|
||||
Procedure Insert(const source:string;Var s:string;index:StrLenInt);
|
||||
Function Pos(const substr:string;const s:string):byte;
|
||||
Function Pos(C:Char;const s:string):byte;
|
||||
{ Shortstring functions }
|
||||
Function Copy(const s:shortstring;index:StrLenInt;count:StrLenInt):shortstring;
|
||||
Procedure Delete(Var s:shortstring;index:StrLenInt;count:StrLenInt);
|
||||
Procedure Insert(const source:shortstring;Var s:shortstring;index:StrLenInt);
|
||||
Function Pos(const substr:shortstring;const s:shortstring):StrLenInt;
|
||||
Function Pos(C:Char;const s:shortstring):StrLenInt;
|
||||
Procedure SetLength(var s:shortstring;len:StrLenInt);
|
||||
|
||||
{ Char functions to overcome overloading problem with ansistrings }
|
||||
function copy(c:char;index : StrLenInt;count : StrLenInt): shortstring;
|
||||
function pos(const substr : shortstring;c:char): StrLenInt;
|
||||
function length(c:char):StrLenInt;
|
||||
|
||||
Function upCase(const s:shortstring):shortstring;
|
||||
Function upCase(c:Char):Char;
|
||||
Function upCase(const s:string):string;
|
||||
{$ifndef RTLLITE}
|
||||
Function lowerCase(c:Char):Char;
|
||||
Function lowerCase(const s:string):string;
|
||||
Function hexStr(Val:Longint;cnt:byte):string;
|
||||
Function binStr(Val:Longint;cnt:byte):string;
|
||||
Function lowerCase(const s:shortstring):shortstring;
|
||||
Function hexStr(Val:Longint;cnt:byte):shortstring;
|
||||
Function binStr(Val:Longint;cnt:byte):shortstring;
|
||||
{$endif RTLLITE}
|
||||
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);
|
||||
Function Space(b:byte):shortstring;
|
||||
Procedure Val(const s:shortstring;Var l:Longint;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var l:Longint;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var l:Longint;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;Var l:Longint);
|
||||
Procedure Val(const s:shortstring;Var b:byte;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var b:byte;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var b:byte;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;Var b:byte);
|
||||
Procedure Val(const s:shortstring;Var b:shortint;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var b:shortint;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var b:shortint;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;Var b:shortint);
|
||||
Procedure Val(const s:shortstring;Var b:Word;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var b:Word;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var b:Word;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;Var b:Word);
|
||||
Procedure Val(const s:shortstring;Var b:Integer;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var b:Integer;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var b:Integer;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;Var b:Integer);
|
||||
Procedure Val(const s:shortstring;Var v:cardinal;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var v:cardinal;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var v:cardinal;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;Var v:cardinal);
|
||||
Procedure Val(const s:shortstring;Var d:ValReal;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var d:ValReal;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var d:ValReal;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;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);
|
||||
Procedure Val(const s:shortstring;Var d:single;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var d:single;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var d:single;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;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);
|
||||
Procedure Val(const s:shortstring;Var d:comp;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var d:comp;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var d:comp;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;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);
|
||||
Procedure Val(const s:shortstring;Var d:fixed;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var d:fixed;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var d:fixed;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;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);
|
||||
Procedure Val(const s:shortstring;Var d:Real;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var d:Real;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var d:Real;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;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);
|
||||
Procedure Val(const s:shortstring;Var d:Extended;Var code:Word);
|
||||
Procedure Val(const s:shortstring;Var d:Extended;Var code:Integer);
|
||||
Procedure Val(const s:shortstring;Var d:Extended;Var code:Longint);
|
||||
Procedure Val(const s:shortstring;Var d:Extended);
|
||||
{$endif}
|
||||
{$endif DEFAULT_EXTENDED}
|
||||
|
||||
@ -422,7 +432,10 @@ const
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.37 1998-10-10 15:28:47 peter
|
||||
Revision 1.38 1998-11-04 10:20:51 peter
|
||||
* ansistring fixes
|
||||
|
||||
Revision 1.37 1998/10/10 15:28:47 peter
|
||||
+ read single,fixed
|
||||
+ val with code:longint
|
||||
+ val for fixed
|
||||
|
||||
@ -453,7 +453,7 @@ begin
|
||||
Writeln (S);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
Procedure DoFormatError (ErrCode : Longint);
|
||||
|
||||
Var S : String;
|
||||
@ -484,28 +484,28 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
|
||||
|
||||
{
|
||||
ReadFormat reads the format string. It returns the type character in
|
||||
uppercase, and sets index, Width, Prec to their correct values,
|
||||
or -1 if not set. It sets Left to true if left alignment was requested.
|
||||
uppercase, and sets index, Width, Prec to their correct values,
|
||||
or -1 if not set. It sets Left to true if left alignment was requested.
|
||||
In case of an error, DoFormatError is called.
|
||||
}
|
||||
|
||||
|
||||
Function ReadFormat : Char;
|
||||
|
||||
Var Value : longint;
|
||||
|
||||
Procedure ReadInteger;
|
||||
Procedure ReadInteger;
|
||||
|
||||
Var Code : Word;
|
||||
|
||||
begin
|
||||
If Value<>-1 then exit; // Was already read.
|
||||
OldPos:=chPos;
|
||||
While (Chpos<Len) and
|
||||
While (Chpos<Len) and
|
||||
(Pos(Fmt[chpos],'1234567890')<>0) do inc(chpos);
|
||||
If Chpos=len then DoFormatError(feInvalidFormat);
|
||||
If Fmt[Chpos]='*' then
|
||||
If Fmt[Chpos]='*' then
|
||||
begin
|
||||
If (Chpos>OldPos) or (ArgPos>High(Args))
|
||||
If (Chpos>OldPos) or (ArgPos>High(Args))
|
||||
or (Args[ArgPos].Vtype<>vtInteger) then
|
||||
DoFormatError(feInvalidFormat);
|
||||
Value:=Args[ArgPos].VInteger;
|
||||
@ -542,7 +542,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
|
||||
Procedure ReadLeft;
|
||||
|
||||
begin
|
||||
If Fmt[chpos]='-' then
|
||||
If Fmt[chpos]='-' then
|
||||
begin
|
||||
left:=True;
|
||||
Inc(chpos);
|
||||
@ -559,7 +559,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
|
||||
If Value<>-1 then
|
||||
begin
|
||||
Width:=Value;
|
||||
Value:=-1;
|
||||
Value:=-1;
|
||||
end;
|
||||
Log ('Read width');
|
||||
end;
|
||||
@ -611,7 +611,7 @@ Procedure Checkarg (AT : Longint);
|
||||
DoArg is set to the argument that must be used.
|
||||
}
|
||||
begin
|
||||
If Index=-1 then
|
||||
If Index=-1 then
|
||||
begin
|
||||
DoArg:=Argpos;
|
||||
inc(ArgPos);
|
||||
@ -623,7 +623,7 @@ begin
|
||||
end;
|
||||
|
||||
Const Zero = '000000000000000000000000000000000000000000000000000000000000000';
|
||||
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
Len:=Length(Fmt)+1;
|
||||
@ -634,7 +634,7 @@ begin
|
||||
begin
|
||||
// uses shortcut evaluation !!
|
||||
While (ChPos<=Len) and (Fmt[chpos]<>'%') do inc(chpos);
|
||||
If ChPos>OldPos Then
|
||||
If ChPos>OldPos Then
|
||||
Result:=Result+Copy(Fmt,OldPos,Chpos-Oldpos);
|
||||
If ChPos<Len then
|
||||
begin
|
||||
@ -661,7 +661,7 @@ begin
|
||||
Prec:=Prec+5; // correct dot, eXXX
|
||||
If ExtVal<0 then Inc(Prec); // Corect for minus sign
|
||||
If Abs(Extval)<1 then Inc(Prec); // correct for - in E
|
||||
Writeln('STRING ',prec);
|
||||
Writeln('STRING ',prec);
|
||||
Str(Args[doarg].VExtended^:prec,ToAdd);
|
||||
WRITELN('DID');
|
||||
end;
|
||||
@ -682,15 +682,15 @@ begin
|
||||
end;
|
||||
'X' : begin
|
||||
Checkarg(vtinteger);
|
||||
If Prec>32 then
|
||||
If Prec>32 then
|
||||
ToAdd:=HexStr(Args[Doarg].VInteger,Prec)
|
||||
else
|
||||
begin
|
||||
// determine minimum needed number of hex digits.
|
||||
Index:=1;
|
||||
While (1 shl (Index*4))<Args[DoArg].VInteger do
|
||||
While (1 shl (Index*4))<Args[DoArg].VInteger do
|
||||
inc(Index);
|
||||
If Index>Prec then
|
||||
If Index>Prec then
|
||||
Prec:=Index;
|
||||
ToAdd:=HexStr(Args[DoArg].VInteger,Prec);
|
||||
end;
|
||||
@ -700,11 +700,11 @@ begin
|
||||
end;
|
||||
If Width<>-1 then
|
||||
If Length(ToAdd)<Width then
|
||||
If not Left then
|
||||
If not Left then
|
||||
ToAdd:=Space(Width-Length(ToAdd))+ToAdd
|
||||
else
|
||||
ToAdd:=ToAdd+space(Width-Length(ToAdd));
|
||||
Result:=Result+ToAdd;
|
||||
Result:=Result+ToAdd;
|
||||
end;
|
||||
inc(chpos);
|
||||
Oldpos:=chpos;
|
||||
@ -716,18 +716,6 @@ end;
|
||||
{ extra functions }
|
||||
{==============================================================================}
|
||||
|
||||
{ SetLength sets the length of S to NewLength }
|
||||
// SetLength should be in the system unit
|
||||
// which lacks the ShortString version of SetLength
|
||||
|
||||
function SetLength(var S: string; NewLength: integer): integer;
|
||||
begin
|
||||
if (NewLength > 255) then
|
||||
NewLength := 255;
|
||||
S[0] := char(NewLength);
|
||||
Result := Ord(S[0]);
|
||||
end ;
|
||||
|
||||
{ LeftStr returns Count left-most characters from S }
|
||||
|
||||
function LeftStr(const S: string; Count: integer): string;
|
||||
@ -906,7 +894,10 @@ end ;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 1998-10-02 13:57:38 michael
|
||||
Revision 1.9 1998-11-04 10:20:52 peter
|
||||
* ansistring fixes
|
||||
|
||||
Revision 1.8 1998/10/02 13:57:38 michael
|
||||
Format error now causes exception
|
||||
|
||||
Revision 1.7 1998/10/02 12:17:17 michael
|
||||
@ -929,7 +920,10 @@ end ;
|
||||
Update from gertjan Schouten, plus small fix for linux
|
||||
|
||||
$Log$
|
||||
Revision 1.8 1998-10-02 13:57:38 michael
|
||||
Revision 1.9 1998-11-04 10:20:52 peter
|
||||
* ansistring fixes
|
||||
|
||||
Revision 1.8 1998/10/02 13:57:38 michael
|
||||
Format error now causes exception
|
||||
|
||||
Revision 1.7 1998/10/02 12:17:17 michael
|
||||
|
||||
@ -77,14 +77,16 @@ Function Format (Const Fmt : String; const Args : Array of const) : String;
|
||||
{ extra functions }
|
||||
{==============================================================================}
|
||||
|
||||
function SetLength(var S: string; NewLength: integer): integer; // should be in the system unit
|
||||
function LeftStr(const S: string; Count: integer): string;
|
||||
function RightStr(const S: string; Count: integer): string;
|
||||
function BCDToInt(Value: integer): integer;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1998-11-02 12:53:53 michael
|
||||
Revision 1.4 1998-11-04 10:20:53 peter
|
||||
* ansistring fixes
|
||||
|
||||
Revision 1.3 1998/11/02 12:53:53 michael
|
||||
+ Added format function
|
||||
|
||||
Revision 1.2 1998/09/16 08:28:43 michael
|
||||
|
||||
Loading…
Reference in New Issue
Block a user