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

* format support for ansistring (from mailinglist)

Browse Source 
* fixed length checking in Trim()
This commit is contained in:
peter 1999-04-04 10:19:07 +00:00
parent 8630e6c954
commit d94060a283
1 changed files with 60 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
rtl/objpas/sysstr.inc
View File

@ -26,8 +26,8 @@
function NewStr(const S: string): PString; function NewStr(const S: string): PString;
begin begin
result := Nil; result := Nil;
if Length(S) <> 0 then if Length(S) <> 0 then
begin begin
New(Result); New(Result);
result^ := S; result^ := S;
@ -245,13 +245,13 @@ end ;
function Trim(const S: string): string; function Trim(const S: string): string;
var Ofs, Len: integer; var Ofs, Len: integer;
begin begin
len := Length(S); len := Length(S);
while (S[Len] = ' ') and (Len > 0) do while (Len>0) and (S[Len] = ' ') do
dec(Len); dec(Len);
Ofs := 1; Ofs := 1;
while (S[Ofs] = ' ') and (Ofs <= Len) do while (Ofs<=Len) and (S[Ofs] = ' ') do
Inc(Ofs); Inc(Ofs);
result := Copy(S, Ofs, 1 + Len - Ofs); result := Copy(S, Ofs, 1 + Len - Ofs);
end ; end ;
{ TrimLeft returns a copy of S with all blank characters on the left stripped off } { TrimLeft returns a copy of S with all blank characters on the left stripped off }
@ -259,10 +259,11 @@ end ;
function TrimLeft(const S: string): string; function TrimLeft(const S: string): string;
var i,l:integer; var i,l:integer;
begin begin
l := length(s); l := length(s);
i := 1; i := 1;
while (s[i] = ' ') and (i <= l) do inc(i); while (i<=l) and (s[i] = ' ') do
Result := copy(s, i, l); inc(i);
Result := copy(s, i, l);
end ; end ;
{ TrimRight returns a copy of S with all blank characters on the right stripped off } { TrimRight returns a copy of S with all blank characters on the right stripped off }
@ -270,9 +271,10 @@ end ;
function TrimRight(const S: string): string; function TrimRight(const S: string): string;
var l:integer; var l:integer;
begin begin
l := length(s); l := length(s);
while (s[l] = ' ') and (l > 0) do dec(l); while (l>0) and (s[l] = ' ') do
result := copy(s,1,l); dec(l);
result := copy(s,1,l);
end ; end ;
{ QuotedStr returns S quoted left and right and every single quote in S { QuotedStr returns S quoted left and right and every single quote in S
@ -457,7 +459,7 @@ end;
Function Format (Const Fmt : String; const Args : Array of const) : String; Function Format (Const Fmt : String; const Args : Array of const) : String;
Var ChPos,OldPos,ArgPos,DoArg,Len : Longint; Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
ToAdd : String; Hs,ToAdd : String;
Index,Width,Prec : Longint; Index,Width,Prec : Longint;
Left : Boolean; Left : Boolean;
ExtVal: Extended; ExtVal: Extended;
@ -585,14 +587,15 @@ begin
Writeln (' Type : ',C); Writeln (' Type : ',C);
end; end;
Procedure Checkarg (AT : Longint); function Checkarg (AT : Longint;err:boolean):boolean;
{ {
Check if argument INDEX is of correct type (AT) Check if argument INDEX is of correct type (AT)
If Index=-1, ArgPos is used, and argpos is augmented with 1 If Index=-1, ArgPos is used, and argpos is augmented with 1
DoArg is set to the argument that must be used. DoArg is set to the argument that must be used.
} }
begin begin
If Index=-1 then result:=false;
if Index=-1 then
begin begin
DoArg:=Argpos; DoArg:=Argpos;
inc(ArgPos); inc(ArgPos);
@ -600,7 +603,12 @@ begin
else else
DoArg:=Index; DoArg:=Index;
If (Doarg>High(Args)) or (Args[Doarg].Vtype<>AT) then If (Doarg>High(Args)) or (Args[Doarg].Vtype<>AT) then
DoFormatError(feInvalidArgindex); begin
if err then
DoFormatError(feInvalidArgindex);
exit;
end;
result:=true;
end; end;
Const Zero = '000000000000000000000000000000000000000000000000000000000000000'; Const Zero = '000000000000000000000000000000000000000000000000000000000000000';
@ -625,7 +633,7 @@ begin
{$endif} {$endif}
Case FChar of Case FChar of
'D' : begin 'D' : begin
Checkarg(vtinteger); Checkarg(vtinteger,true);
Width:=Abs(width); Width:=Abs(width);
Str(Args[Doarg].VInteger,ToAdd); Str(Args[Doarg].VInteger,ToAdd);
While Length(ToAdd)<Prec do While Length(ToAdd)<Prec do
@ -636,33 +644,38 @@ begin
end; end;
end; end;
'E' : begin 'E' : begin
CheckArg(vtExtended); CheckArg(vtExtended,true);
If Prec=-1 then prec:=15; If Prec=-1 then prec:=15;
ExtVal:=Args[doarg].VExtended^; ExtVal:=Args[doarg].VExtended^;
Prec:=Prec+5; // correct dot, eXXX Prec:=Prec+5; // correct dot, eXXX
If ExtVal<0 then Inc(Prec); // Corect for minus sign If ExtVal<0 then Inc(Prec); // Corect for minus sign
If Abs(Extval)<1 then Inc(Prec); // correct for - in E If Abs(Extval)<1 then Inc(Prec); // correct for - in E
Writeln('STRING ',prec);
Str(Args[doarg].VExtended^:prec,ToAdd); Str(Args[doarg].VExtended^:prec,ToAdd);
WRITELN('DID');
end; end;
'F' : begin 'F' : begin
end; end;
'S' : begin 'S' : begin
CheckArg(vtString); if CheckArg(vtString,false) then
Index:=Length(Args[doarg].VString^); hs:=Args[doarg].VString^
If (Prec<>-1) and (Index>Prec) then else
Index:=Prec; begin
ToAdd:=Copy(Args[DoArg].VString^,1,Index); dec(argpos);
if CheckArg(vtAnsiString,true) then
hs:=ansistring(Args[doarg].VAnsiString);
end;
Index:=Length(hs);
If (Prec<>-1) and (Index>Prec) then
Index:=Prec;
ToAdd:=Copy(hs,1,Index);
end; end;
'P' : Begin 'P' : Begin
CheckArg(vtpointer); CheckArg(vtpointer,true);
ToAdd:=HexStr(Longint(Args[DoArg].VPointer),8); ToAdd:=HexStr(Longint(Args[DoArg].VPointer),8);
// Insert ':'. Is this needed in 32 bit ? No it isn't. // Insert ':'. Is this needed in 32 bit ? No it isn't.
// Insert(':',ToAdd,5); // Insert(':',ToAdd,5);
end; end;
'X' : begin 'X' : begin
Checkarg(vtinteger); Checkarg(vtinteger,true);
If Prec>32 then If Prec>32 then
ToAdd:=HexStr(Args[Doarg].VInteger,Prec) ToAdd:=HexStr(Args[Doarg].VInteger,Prec)
else else
@ -676,7 +689,6 @@ begin
ToAdd:=HexStr(Args[DoArg].VInteger,Prec); ToAdd:=HexStr(Args[DoArg].VInteger,Prec);
end; end;
end; end;
'%': ToAdd:='%'; '%': ToAdd:='%';
end; end;
If Width<>-1 then If Width<>-1 then
@ -692,8 +704,8 @@ begin
end; end;
end; end;
Function FormatBuf (Var Buffer; BufLen : Cardinal; Function FormatBuf (Var Buffer; BufLen : Cardinal;
Const Fmt; fmtLen : Cardinal; Const Fmt; fmtLen : Cardinal;
Const Args : Array of const) : Cardinal; Const Args : Array of const) : Cardinal;
Var S,F : String; Var S,F : String;
@ -707,7 +719,7 @@ begin
else else
Result:=Buflen; Result:=Buflen;
Move(S[1],Buffer,Result); Move(S[1],Buffer,Result);
end; end;
Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const); Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const);
@ -782,7 +794,7 @@ Begin
End; End;
End; End;
End; End;
If Result[1] = ' ' Then If Result[1] = ' ' Then
System.Delete(Result, 1, 1); System.Delete(Result, 1, 1);
End; End;
@ -792,7 +804,7 @@ Begin
If Digits = -1 Then Digits := 2 If Digits = -1 Then Digits := 2
Else If Digits > 15 Then Digits := 15; Else If Digits > 15 Then Digits := 15;
Str(Value:0:Digits, Result); Str(Value:0:Digits, Result);
If Result[1] = ' ' Then If Result[1] = ' ' Then
System.Delete(Result, 1, 1); System.Delete(Result, 1, 1);
P := Pos('.', Result); P := Pos('.', Result);
If P <> 0 Then Result[P] := DecimalSeparator; If P <> 0 Then Result[P] := DecimalSeparator;
@ -900,14 +912,14 @@ for i := 0 to SizeOf(Value) shr 1 - 1 do begin
end ; end ;
{ {
Case Translation Tables Case Translation Tables
Can be used in internationalization support. Can be used in internationalization support.
Although these tables can be obtained through system calls Although these tables can be obtained through system calls
it is better to not use those, since most implementation are not 100% it is better to not use those, since most implementation are not 100%
WARNING: WARNING:
before modifying a translation table make sure that the current codepage before modifying a translation table make sure that the current codepage
of the OS corresponds to the one you make changes to of the OS corresponds to the one you make changes to
} }
const const
@ -957,7 +969,11 @@ const
{ {
$Log$ $Log$
Revision 1.14 1999-03-01 12:40:06 michael Revision 1.15 1999-04-04 10:19:07 peter
* format support for ansistring (from mailinglist)
* fixed length checking in Trim()
Revision 1.14 1999/03/01 12:40:06 michael
changed delete to system.delete changed delete to system.delete
Revision 1.13 1999/02/28 13:17:35 michael Revision 1.13 1999/02/28 13:17:35 michael