paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 09:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ implemented WideFormat

Browse Source 
+ some Widestring stuff implemented
  * some Widestring stuff fixed
This commit is contained in:
florian 2005-02-26 10:21:17 +00:00
parent c55870ebb5
commit eb4b962cee
7 changed files with 502 additions and 368 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
rtl/inc/wstringh.inc
View File

@ -26,9 +26,13 @@ Function Length (Const S : WideString) : SizeInt;
{$ifndef InternCopy}
Function Copy (Const S : WideString; Index,Size : SizeInt) : WideString;
{$endif interncopy}
Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
Function Pos (c : Char; Const s : WideString) : SizeInt;
Function Pos (c : WideChar; Const s : WideString) : SizeInt;
Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
Function Pos (c : Char; Const s : WideString) : SizeInt;
Function Pos (c : WideChar; Const s : WideString) : SizeInt;
Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
Function UpCase(const s : WideString) : WideString;
Procedure Insert (Const Source : WideString; Var S : WideString; Index : SizeInt);
Procedure Delete (Var S : WideString; Index,Size: SizeInt);
Procedure SetString (Var S : WideString; Buf : PWideChar; Len : SizeInt);
@ -82,7 +86,12 @@ Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideSt
{
$Log$
Revision 1.3 2005-02-06 09:38:45 florian
Revision 1.4 2005-02-26 10:21:17 florian
+ implemented WideFormat
+ some Widestring stuff implemented
* some Widestring stuff fixed
Revision 1.3 2005/02/06 09:38:45 florian
+ StrCharLength infrastructure
Revision 1.2 2005/02/03 18:40:50 florian

46
rtl/inc/wstrings.inc
View File

@ -83,19 +83,19 @@ end;
Procedure GetWideStringManager (Var Manager : TWideStringManager);
begin
manager:=widestringmanager;
manager:=widestringmanager;
end;
Procedure SetWideStringManager (Const New : TWideStringManager; Var Old: TWideStringManager);
begin
Old:=widestringmanager;
widestringmanager:=New;
Old:=widestringmanager;
widestringmanager:=New;
end;
Procedure SetWideStringManager (Const New : TWideStringManager);
begin
widestringmanager:=New;
widestringmanager:=New;
end;
(*
@ -930,6 +930,26 @@ begin
end;
Function Pos (c : WideChar; Const s : AnsiString) : SizeInt;
var
i: SizeInt;
pc : pchar;
begin
pc:=@s[1];
for i:=1 to length(s) do
begin
if widechar(pc^)=c then
begin
pos:=i;
exit;
end;
inc(pc);
end;
pos:=0;
end;
{ Faster version for a char alone. Must be implemented because }
{ pos(c: char; const s: shortstring) also exists, so otherwise }
{ using pos(char,pchar) will always call the shortstring version }
@ -1004,6 +1024,12 @@ begin
end;
function UpCase(const s : WideString) : WideString;
begin
result:=widestringmanager.UpperWideStringProc(s);
end;
Procedure SetString (Var S : WideString; Buf : PWideChar; Len : SizeInt);
var
BufLen: SizeInt;
@ -1406,9 +1432,9 @@ function CompareTextWideString(const s1, s2 : WideString): PtrInt;
end;
function CharLengthPChar(const Str: PChar): PtrInt;
begin
begin
unimplementedwidestring;
end;
end;
procedure initwidestringmanager;
begin
@ -1416,6 +1442,7 @@ procedure initwidestringmanager;
widestringmanager.Wide2AnsiMoveProc:=@Wide2AnsiMove;
widestringmanager.Ansi2WideMoveProc:=@Ansi2WideMove;
widestringmanager.UpperWideStringProc:=@GenericWideCase;
widestringmanager.LowerWideStringProc:=@GenericWideCase;
widestringmanager.CompareWideStringProc:=@CompareWideString;
widestringmanager.SameWideStringProc:=@SameWideString;
widestringmanager.CompareTextWideStringProc:=@CompareTextWideString;
@ -1425,7 +1452,12 @@ procedure initwidestringmanager;
{
$Log$
Revision 1.51 2005-02-14 17:13:30 peter
Revision 1.52 2005-02-26 10:21:17 florian
+ implemented WideFormat
+ some Widestring stuff implemented
* some Widestring stuff fixed
Revision 1.51 2005/02/14 17:13:30 peter
* truncate log
Revision 1.50 2005/02/06 09:38:45 florian

361
rtl/objpas/sysutils/sysformt.inc Normal file
View File

@ -0,0 +1,361 @@
Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
Hs,ToAdd : TFormatString;
Index : SizeInt;
Width,Prec : Longint;
Left : Boolean;
Fchar : char;
{$ifdef ver1_0}
vl : int64;
{$else}
vq : qword;
{$endif}
{
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.
In case of an error, DoFormatError is called.
}
Function ReadFormat : Char;
Var Value : longint;
Procedure ReadInteger;
{$IFDEF VIRTUALPASCAL}
var Code: longint;
{$ELSE}
var Code: word;
{$ENDIF}
begin
If Value<>-1 then exit; // Was already read.
OldPos:=chPos;
While (Chpos<=Len) and
(Pos(Fmt[chpos],'1234567890')<>0) do inc(chpos);
If Chpos>len then
DoFormatError(feInvalidFormat);
If Fmt[Chpos]='*' then
begin
If (Chpos>OldPos) or (ArgPos>High(Args))
or (Args[ArgPos].Vtype<>vtInteger) then
DoFormatError(feInvalidFormat);
Value:=Args[ArgPos].VInteger;
Inc(ArgPos);
Inc(chPos);
end
else
begin
If (OldPos<chPos) Then
begin
Val (Copy(Fmt,OldPos,ChPos-OldPos),value,code);
// This should never happen !!
If Code>0 then DoFormatError (feInvalidFormat);
end
else
Value:=-1;
end;
end;
Procedure ReadIndex;
begin
ReadInteger;
If Fmt[ChPos]=':' then
begin
If Value=-1 then DoFormatError(feMissingArgument);
Index:=Value;
Value:=-1;
Inc(Chpos);
end;
{$ifdef fmtdebug}
Log ('Read index');
{$endif}
end;
Procedure ReadLeft;
begin
If Fmt[chpos]='-' then
begin
left:=True;
Inc(chpos);
end
else
Left:=False;
{$ifdef fmtdebug}
Log ('Read Left');
{$endif}
end;
Procedure ReadWidth;
begin
ReadInteger;
If Value<>-1 then
begin
Width:=Value;
Value:=-1;
end;
{$ifdef fmtdebug}
Log ('Read width');
{$endif}
end;
Procedure ReadPrec;
begin
If Fmt[chpos]='.' then
begin
inc(chpos);
ReadInteger;
If Value=-1 then
Value:=0;
prec:=Value;
end;
{$ifdef fmtdebug}
Log ('Read precision');
{$endif}
end;
var
FormatChar : TFormatChar;
begin
{$ifdef fmtdebug}
Log ('Start format');
{$endif}
Index:=-1;
Width:=-1;
Prec:=-1;
Value:=-1;
inc(chpos);
If Fmt[Chpos]='%' then
begin
Result:='%';
exit; // VP fix
end;
ReadIndex;
ReadLeft;
ReadWidth;
ReadPrec;
{$ifdef INWIDEFORMAT}
FormatChar:=UpCase(Fmt[ChPos])[1];
if word(FormatChar)>255 then
ReadFormat:=#255
else
ReadFormat:=FormatChar;
{$else INWIDEFORMAT}
ReadFormat:=Upcase(Fmt[ChPos]);
{$endif INWIDEFORMAT}
{$ifdef fmtdebug}
Log ('End format');
{$endif}
end;
{$ifdef fmtdebug}
Procedure DumpFormat (C : char);
begin
Write ('Fmt : ',fmt:10);
Write (' Index : ',Index:3);
Write (' Left : ',left:5);
Write (' Width : ',Width:3);
Write (' Prec : ',prec:3);
Writeln (' Type : ',C);
end;
{$endif}
function Checkarg (AT : SizeInt;err:boolean):boolean;
{
Check if argument INDEX is of correct type (AT)
If Index=-1, ArgPos is used, and argpos is augmented with 1
DoArg is set to the argument that must be used.
}
begin
result:=false;
if Index=-1 then
DoArg:=Argpos
else
DoArg:=Index;
ArgPos:=DoArg+1;
If (Doarg>High(Args)) or (Args[Doarg].Vtype<>AT) then
begin
if err then
DoFormatError(feInvalidArgindex);
dec(ArgPos);
exit;
end;
result:=true;
end;
Const Zero = '000000000000000000000000000000000000000000000000000000000000000';
begin
Result:='';
Len:=Length(Fmt);
Chpos:=1;
OldPos:=1;
ArgPos:=0;
While chpos<=len do
begin
While (ChPos<=Len) and (Fmt[chpos]<>'%') do
inc(chpos);
If ChPos>OldPos Then
Result:=Result+Copy(Fmt,OldPos,Chpos-Oldpos);
If ChPos<Len then
begin
FChar:=ReadFormat;
{$ifdef fmtdebug}
DumpFormat(FCHar);
{$endif}
Case FChar of
'D' : begin
if Checkarg(vtinteger,false) then
Str(Args[Doarg].VInteger,ToAdd)
{$IFNDEF VIRTUALPASCAL}
else if CheckArg(vtInt64,true) then
Str(Args[DoArg].VInt64^,toadd)
{$ENDIF}
;
Width:=Abs(width);
Index:=Prec-Length(ToAdd);
If ToAdd[1]<>'-' then
ToAdd:=StringOfChar('0',Index)+ToAdd
else
// + 1 to accomodate for - sign in length !!
Insert(StringOfChar('0',Index+1),toadd,2);
end;
'U' : begin
if Checkarg(vtinteger,false) then
Str(cardinal(Args[Doarg].VInteger),ToAdd)
{$IFNDEF VIRTUALPASCAL}
else if CheckArg(vtInt64,true) then
Str(qword(Args[DoArg].VInt64^),toadd)
{$ENDIF}
;
Width:=Abs(width);
Index:=Prec-Length(ToAdd);
ToAdd:=StringOfChar('0',Index)+ToAdd
end;
'E' : begin
CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffexponent,Prec,3);
end;
'F' : begin
CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffFixed,9999,Prec);
end;
'G' : begin
CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffGeneral,Prec,3);
end;
'N' : begin
CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffNumber,9999,Prec);
end;
'M' : begin
CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffCurrency,9999,Prec);
end;
'S' : begin
if CheckArg(vtString,false) then
hs:=Args[doarg].VString^
else
if CheckArg(vtChar,false) then
hs:=Args[doarg].VChar
else
if CheckArg(vtPChar,false) then
hs:=Args[doarg].VPChar
else
{$ifndef VER1_0}
if CheckArg(vtPWideChar,false) then
hs:=WideString(Args[doarg].VPWideChar)
else
if CheckArg(vtWideChar,false) then
hs:=WideString(Args[doarg].VWideChar)
else
if CheckArg(vtWidestring,false) then
hs:=WideString(Args[doarg].VWideString)
else
{$endif VER1_0}
if CheckArg(vtAnsiString,true) then
hs:=ansistring(Args[doarg].VAnsiString);
Index:=Length(hs);
If (Prec<>-1) and (Index>Prec) then
Index:=Prec;
ToAdd:=Copy(hs,1,Index);
end;
'P' : Begin
CheckArg(vtpointer,true);
ToAdd:=HexStr(ptrint(Args[DoArg].VPointer),sizeof(Ptrint)*2);
// Insert ':'. Is this needed in 32 bit ? No it isn't.
// Insert(':',ToAdd,5);
end;
'X' : begin
{$ifdef ver1_0}
if Checkarg(vtinteger,false) then
begin
vl:=Args[Doarg].VInteger and int64($ffffffff);
index:=16;
end
else
begin
CheckArg(vtInt64,true);
vl:=Args[DoArg].VInt64^;
index:=31;
end;
If Prec>index then
ToAdd:=HexStr(vl,index)
else
begin
// determine minimum needed number of hex digits.
Index:=1;
While (DWord(1 shl (Index*4))<=DWord(Args[DoArg].VInteger)) and (index<8) do
inc(Index);
If Index>Prec then
Prec:=Index;
ToAdd:=HexStr(int64(vl),Prec);
end;
{$else}
if Checkarg(vtinteger,false) then
begin
vq:=Cardinal(Args[Doarg].VInteger);
index:=16;
end
else
begin
CheckArg(vtInt64,true);
vq:=Qword(Args[DoArg].VInt64^);
index:=31;
end;
If Prec>index then
ToAdd:=HexStr(vq,index)
else
begin
// determine minimum needed number of hex digits.
Index:=1;
While (qWord(1) shl (Index*4)<=vq) and (index<16) do
inc(Index);
If Index>Prec then
Prec:=Index;
ToAdd:=HexStr(vq,Prec);
end;
{$endif}
end;
'%': ToAdd:='%';
end;
If Width<>-1 then
If Length(ToAdd)<Width then
If not Left then
ToAdd:=Space(Width-Length(ToAdd))+ToAdd
else
ToAdd:=ToAdd+space(Width-Length(ToAdd));
Result:=Result+ToAdd;
end;
inc(chpos);
Oldpos:=chpos;
end;
end;

366
rtl/objpas/sysutils/sysstr.inc
View File

@ -781,357 +781,20 @@ begin
end;
Function Format (Const Fmt : String; const Args : Array of const) : String;
{ we've no templates, but with includes we can simulate this :) }
Var ChPos,OldPos,ArgPos,DoArg,Len : Longint;
Hs,ToAdd : String;
Index,Width,Prec : Longint;
Left : Boolean;
Fchar : char;
{$ifdef ver1_0}
vl : int64;
{$else}
vq : qword;
{$endif}
{$macro on}
{$define INFORMAT}
{$define TFormatString:=ansistring}
{$define TFormatChar:=char}
{
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.
In case of an error, DoFormatError is called.
}
Function Format (Const Fmt : AnsiString; const Args : Array of const) : AnsiString;
{$i sysformt.inc}
Function ReadFormat : Char;
Var Value : longint;
Procedure ReadInteger;
{$IFDEF VIRTUALPASCAL}
var Code: longint;
{$ELSE}
var Code: word;
{$ENDIF}
begin
If Value<>-1 then exit; // Was already read.
OldPos:=chPos;
While (Chpos<=Len) and
(Pos(Fmt[chpos],'1234567890')<>0) do inc(chpos);
If Chpos>len then
DoFormatError(feInvalidFormat);
If Fmt[Chpos]='*' then
begin
If (Chpos>OldPos) or (ArgPos>High(Args))
or (Args[ArgPos].Vtype<>vtInteger) then
DoFormatError(feInvalidFormat);
Value:=Args[ArgPos].VInteger;
Inc(ArgPos);
Inc(chPos);
end
else
begin
If (OldPos<chPos) Then
begin
Val (Copy(Fmt,OldPos,ChPos-OldPos),value,code);
// This should never happen !!
If Code>0 then DoFormatError (feInvalidFormat);
end
else
Value:=-1;
end;
end;
Procedure ReadIndex;
begin
ReadInteger;
If Fmt[ChPos]=':' then
begin
If Value=-1 then DoFormatError(feMissingArgument);
Index:=Value;
Value:=-1;
Inc(Chpos);
end;
{$ifdef fmtdebug}
Log ('Read index');
{$endif}
end;
Procedure ReadLeft;
begin
If Fmt[chpos]='-' then
begin
left:=True;
Inc(chpos);
end
else
Left:=False;
{$ifdef fmtdebug}
Log ('Read Left');
{$endif}
end;
Procedure ReadWidth;
begin
ReadInteger;
If Value<>-1 then
begin
Width:=Value;
Value:=-1;
end;
{$ifdef fmtdebug}
Log ('Read width');
{$endif}
end;
Procedure ReadPrec;
begin
If Fmt[chpos]='.' then
begin
inc(chpos);
ReadInteger;
If Value=-1 then
Value:=0;
prec:=Value;
end;
{$ifdef fmtdebug}
Log ('Read precision');
{$endif}
end;
begin
{$ifdef fmtdebug}
Log ('Start format');
{$endif}
Index:=-1;
Width:=-1;
Prec:=-1;
Value:=-1;
inc(chpos);
If Fmt[Chpos]='%' then
begin
Result:='%';
exit; // VP fix
end;
ReadIndex;
ReadLeft;
ReadWidth;
ReadPrec;
ReadFormat:=Upcase(Fmt[ChPos]);
{$ifdef fmtdebug}
Log ('End format');
{$endif}
end;
{$ifdef fmtdebug}
Procedure DumpFormat (C : char);
begin
Write ('Fmt : ',fmt:10);
Write (' Index : ',Index:3);
Write (' Left : ',left:5);
Write (' Width : ',Width:3);
Write (' Prec : ',prec:3);
Writeln (' Type : ',C);
end;
{$endif}
function Checkarg (AT : Longint;err:boolean):boolean;
{
Check if argument INDEX is of correct type (AT)
If Index=-1, ArgPos is used, and argpos is augmented with 1
DoArg is set to the argument that must be used.
}
begin
result:=false;
if Index=-1 then
DoArg:=Argpos
else
DoArg:=Index;
ArgPos:=DoArg+1;
If (Doarg>High(Args)) or (Args[Doarg].Vtype<>AT) then
begin
if err then
DoFormatError(feInvalidArgindex);
dec(ArgPos);
exit;
end;
result:=true;
end;
Const Zero = '000000000000000000000000000000000000000000000000000000000000000';
begin
Result:='';
Len:=Length(Fmt);
Chpos:=1;
OldPos:=1;
ArgPos:=0;
While chpos<=len do
begin
While (ChPos<=Len) and (Fmt[chpos]<>'%') do
inc(chpos);
If ChPos>OldPos Then
Result:=Result+Copy(Fmt,OldPos,Chpos-Oldpos);
If ChPos<Len then
begin
FChar:=ReadFormat;
{$ifdef fmtdebug}
DumpFormat(FCHar);
{$endif}
Case FChar of
'D' : begin
if Checkarg(vtinteger,false) then
Str(Args[Doarg].VInteger,ToAdd)
{$IFNDEF VIRTUALPASCAL}
else if CheckArg(vtInt64,true) then
Str(Args[DoArg].VInt64^,toadd)
{$ENDIF}
;
Width:=Abs(width);
Index:=Prec-Length(ToAdd);
If ToAdd[1]<>'-' then
ToAdd:=StringOfChar('0',Index)+ToAdd
else
// + 1 to accomodate for - sign in length !!
Insert(StringOfChar('0',Index+1),toadd,2);
end;
'U' : begin
if Checkarg(vtinteger,false) then
Str(cardinal(Args[Doarg].VInteger),ToAdd)
{$IFNDEF VIRTUALPASCAL}
else if CheckArg(vtInt64,true) then
Str(qword(Args[DoArg].VInt64^),toadd)
{$ENDIF}
;
Width:=Abs(width);
Index:=Prec-Length(ToAdd);
ToAdd:=StringOfChar('0',Index)+ToAdd
end;
'E' : begin
CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffexponent,Prec,3);
end;
'F' : begin
CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffFixed,9999,Prec);
end;
'G' : begin
CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffGeneral,Prec,3);
end;
'N' : begin
CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffNumber,9999,Prec);
end;
'M' : begin
CheckArg(vtExtended,true);
ToAdd:=FloatToStrF(Args[doarg].VExtended^,ffCurrency,9999,Prec);
end;
'S' : begin
if CheckArg(vtString,false) then
hs:=Args[doarg].VString^
else
if CheckArg(vtChar,false) then
hs:=Args[doarg].VChar
else
if CheckArg(vtPChar,false) then
hs:=Args[doarg].VPChar
else
{$ifndef VER1_0}
if CheckArg(vtPWideChar,false) then
hs:=WideString(Args[doarg].VPWideChar)
else
if CheckArg(vtWideChar,false) then
hs:=WideString(Args[doarg].VWideChar)
else
if CheckArg(vtWidestring,false) then
hs:=WideString(Args[doarg].VWideString)
else
{$endif VER1_0}
if CheckArg(vtAnsiString,true) then
hs:=ansistring(Args[doarg].VAnsiString);
Index:=Length(hs);
If (Prec<>-1) and (Index>Prec) then
Index:=Prec;
ToAdd:=Copy(hs,1,Index);
end;
'P' : Begin
CheckArg(vtpointer,true);
ToAdd:=HexStr(ptrint(Args[DoArg].VPointer),sizeof(Ptrint)*2);
// Insert ':'. Is this needed in 32 bit ? No it isn't.
// Insert(':',ToAdd,5);
end;
'X' : begin
{$ifdef ver1_0}
if Checkarg(vtinteger,false) then
begin
vl:=Args[Doarg].VInteger and int64($ffffffff);
index:=16;
end
else
begin
CheckArg(vtInt64,true);
vl:=Args[DoArg].VInt64^;
index:=31;
end;
If Prec>index then
ToAdd:=HexStr(vl,index)
else
begin
// determine minimum needed number of hex digits.
Index:=1;
While (DWord(1 shl (Index*4))<=DWord(Args[DoArg].VInteger)) and (index<8) do
inc(Index);
If Index>Prec then
Prec:=Index;
ToAdd:=HexStr(int64(vl),Prec);
end;
{$else}
if Checkarg(vtinteger,false) then
begin
vq:=Cardinal(Args[Doarg].VInteger);
index:=16;
end
else
begin
CheckArg(vtInt64,true);
vq:=Qword(Args[DoArg].VInt64^);
index:=31;
end;
If Prec>index then
ToAdd:=HexStr(vq,index)
else
begin
// determine minimum needed number of hex digits.
Index:=1;
While (qWord(1) shl (Index*4)<=vq) and (index<16) do
inc(Index);
If Index>Prec then
Prec:=Index;
ToAdd:=HexStr(vq,Prec);
end;
{$endif}
end;
'%': ToAdd:='%';
end;
If Width<>-1 then
If Length(ToAdd)<Width then
If not Left then
ToAdd:=Space(Width-Length(ToAdd))+ToAdd
else
ToAdd:=ToAdd+space(Width-Length(ToAdd));
Result:=Result+ToAdd;
end;
inc(chpos);
Oldpos:=chpos;
end;
end;
{$undef TFormatString}
{$undef TFormatChar}
{$undef INFORMAT}
{$macro off}
Function FormatBuf (Var Buffer; BufLen : Cardinal;
Const Fmt; fmtLen : Cardinal;
@ -2346,7 +2009,12 @@ const
{
$Log$
Revision 1.29 2005-02-14 17:13:31 peter
Revision 1.30 2005-02-26 10:21:17 florian
+ implemented WideFormat
+ some Widestring stuff implemented
* some Widestring stuff fixed
Revision 1.29 2005/02/14 17:13:31 peter
* truncate log
Revision 1.28 2005/02/07 08:29:00 michael

32
rtl/objpas/sysutils/syswide.inc
View File

@ -19,38 +19,58 @@
*********************************************************************
}
function WideUpperCase(const s : WideString) : WideString;
begin
result:=widestringmanager.UpperWideStringProc(s);
result:=widestringmanager.UpperWideStringProc(s);
end;
function WideLowerCase(const s : WideString) : WideString;
begin
result:=widestringmanager.LowerWideStringProc(s);
result:=widestringmanager.LowerWideStringProc(s);
end;
function WideCompareStr(const s1, s2 : WideString) : PtrInt;
begin
result:=widestringmanager.CompareWideStringProc(s1,s2);
result:=widestringmanager.CompareWideStringProc(s1,s2);
end;
function WideSameStr(const s1, s2 : WideString) : Boolean;
begin
result:=widestringmanager.SameWideStringProc(s1,s2);
result:=widestringmanager.SameWideStringProc(s1,s2);
end;
function WideCompareText(const s1, s2 : WideString) : PtrInt;
begin
result:=widestringmanager.CompareTextWideStringProc(s1,s2);
result:=widestringmanager.CompareTextWideStringProc(s1,s2);
end;
{ we've no templates, but with includes we can simulate this :) }
{$macro on}
{$define INWIDEFORMAT}
{$define TFormatString:=widestring}
{$define TFormatChar:=widechar}
Function WideFormat (Const Fmt : WideString; const Args : Array of const) : WideString;
{$i sysformt.inc}
{$undef TFormatString}
{$undef TFormatChar}
{$undef INWIDEFORMAT}
{$macro off}
{
$Log$
Revision 1.3 2005-02-14 17:13:31 peter
Revision 1.4 2005-02-26 10:21:17 florian
+ implemented WideFormat
+ some Widestring stuff implemented
* some Widestring stuff fixed
Revision 1.3 2005/02/14 17:13:31 peter
* truncate log
Revision 1.2 2005/02/03 18:40:02 florian

8
rtl/objpas/sysutils/syswideh.inc
View File

@ -24,10 +24,16 @@ function WideLowerCase(const s : WideString) : WideString;
function WideCompareStr(const s1, s2 : WideString) : PtrInt;
function WideSameStr(const s1, s2 : WideString) : Boolean;
function WideCompareText(const s1, s2 : WideString) : PtrInt;
Function WideFormat (Const Fmt : WideString; const Args : Array of const) : WideString;
{
$Log$
Revision 1.2 2005-02-03 18:40:02 florian
Revision 1.3 2005-02-26 10:21:17 florian
+ implemented WideFormat
+ some Widestring stuff implemented
* some Widestring stuff fixed
Revision 1.2 2005/02/03 18:40:02 florian
* compilation with 1.0.x fixed
+ infrastructure for WideCompareText implemented

40
rtl/win32/system.pp
View File

@ -909,6 +909,38 @@ end;
{$endif Set_i386_Exception_handler}
{****************************************************************************
OS dependend widestrings
****************************************************************************}
function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external 'user32' name 'CharUpperBuffW';
function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external 'user32' name 'CharLowerBuffW';
function Win32WideUpper(const s : WideString) : WideString;
begin
result:=s;
UniqueString(result);
if length(result)>0 then
CharUpperBuff(LPWSTR(result),length(result));
end;
function Win32WideLower(const s : WideString) : WideString;
begin
result:=s;
UniqueString(result);
if length(result)>0 then
CharLowerBuff(LPWSTR(result),length(result));
end;
procedure InitWin32Widestrings;
begin
widestringmanager.UpperWideStringProc:=@Win32WideUpper;
widestringmanager.LowerWideStringProc:=@Win32WideLower;
end;
{****************************************************************************
Error Message writing using messageboxes
@ -1061,12 +1093,18 @@ begin
{$endif HASVARIANT}
{$ifdef HASWIDESTRING}
initwidestringmanager;
InitWin32Widestrings
{$endif HASWIDESTRING}
end.
{
$Log$
Revision 1.68 2005-02-14 17:13:32 peter
Revision 1.69 2005-02-26 10:21:17 florian
+ implemented WideFormat
+ some Widestring stuff implemented
* some Widestring stuff fixed
Revision 1.68 2005/02/14 17:13:32 peter
* truncate log
Revision 1.67 2005/02/06 13:06:20 peter