+ implemented WideFormat

+ some Widestring stuff implemented
  * some Widestring stuff fixed

rtl/inc/wstringh.inc

@@ -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 (Const Substr : WideString; Const Source : WideString) : SizeInt;
-Function  Pos (c : Char; Const s : WideString) : SizeInt;
+Function Pos (c : Char; Const s : WideString) : SizeInt;
-Function  Pos (c : WideChar; 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

rtl/inc/wstrings.inc

@@ -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;
+  Old:=widestringmanager;
-        widestringmanager:=New;
+  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

rtl/objpas/sysutils/sysformt.inc

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

rtl/objpas/sysutils/sysstr.inc

@@ -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;
+{$macro on}
-    Hs,ToAdd : String;
+{$define INFORMAT}
-    Index,Width,Prec : Longint;
+{$define TFormatString:=ansistring}
-    Left : Boolean;
+{$define TFormatChar:=char}
-    Fchar : char;
-{$ifdef ver1_0}
-    vl : int64;
-{$else}
-    vq : qword;
-{$endif}
 
-  {
+Function Format (Const Fmt : AnsiString; const Args : Array of const) : AnsiString;
-    ReadFormat reads the format string. It returns the type character in
+{$i sysformt.inc}
-    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;
+{$undef TFormatString}
-
+{$undef TFormatChar}
-  Var Value : longint;
+{$undef INFORMAT}
-
+{$macro off}
-    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;
 
 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

rtl/objpas/sysutils/syswide.inc

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

rtl/objpas/sysutils/syswideh.inc

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

rtl/win32/system.pp

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