mein Helper für UCS4String (UTF-32)

[Jorg3000]

Hi!
In den letzten Jahren ist mir in den deutschen und englischen Foren wiederholt aufgefallen, dass Anfänger und alte Hasen manchmal über UTF-8 stolpern, insbesondere weil ein Char in einem String hier nicht mehr unbedingt ein Zeichen repräsentiert, wie man es früher von Codepages gewöhnt war.

Zum Beispiel geht Folgendes bei UTF-8 nicht, weil die Umlaute in 2 Bytes kodiert werden (ähnliches gilt für asiatische Schriftzeichen und Unicode-Sonderzeichen)

Code: Alles auswählen

s[i]:='ö';
if s[i]='ä' then ...

Es gibt zwar spezielle UTF8-Routinen, aber die müssen bei jedem Aufruf den String de-kodieren (zumindest bis zur betreffenden Stelle) und sind somit eher lahm.
Für direkte Zugriffe auf jedes Zeichen wäre es am besten, wenn man nicht in einem komprimierten/kodierten String arbeiten müsste. Dieses Problem soll eigentlich ein UCS4String lösen, aber UCS4String ist anders als ein Pascal-String und wird schlecht unterstützt. Die meisten üblichen Routinen, die man für AnsiStrings kennt, funktionieren nicht mit UCS4String.
Deshalb habe ich den Helper programmiert, mit dem z.B. Folgendes möglich ist:

Code: Alles auswählen

var s: UCS4String;
    i: SizeInt;   
begin
 s.SetStr('Frühliche');
 s.Add(' Weihnachten!');
 for i:=1 to s.Length do 
   if s.Chars[i]='ü' then s.Chars[i]='ö';
 ShowMessage( s.toUtf8 );
end;

Außerdem habe ich Methoden wie Pos(), Copy(), Insert(), Delete() gebaut.
Die Unit ist gerade ganz frisch (siehe Quellcode oder Anhang) und nur kurz getestet. Vielleicht findet sich irgendwann irgendjemand, der die Unit gebrauchen kann.
Frohe Weihnachten!
Grüße, Jörg

Code: Alles auswählen

unit UCS4Helper;

{$mode objfpc}{$H+}{$modeswitch typehelpers}


//  Unit UCS4Helper by Jorg3000, Version 1.0 from 2023-12-24


interface


type
     { TUCS4Helper }

     TUCS4Helper = type helper for UCS4String

       function  GetLength: SizeInt;
       procedure SetLength(NewLen: SizeInt);

       procedure SetStr(const s: String);        overload;
       procedure SetStr(const ws: WideString);     inline;
       procedure SetStr(const ws: UnicodeString);  inline;

       procedure Add(const s:  String);      overload;
       procedure Add(const us: UCS4String);

       function  CharAsUtf8(i: SizeInt): String;
       procedure SetChar(i: SizeInt; const s: String);

       function  toUtf8:  String;
       function  toUtf16: UnicodeString;  inline;

       function  Copy(Index, Len: SizeInt): UCS4String;
       function  CopyAsUtf8(Index, Len: SizeInt): String;

       procedure Delete(Index, Len: SizeInt);

       procedure Insert(const Source: String;     Index: SizeInt);  overload;
       procedure Insert(const Source: UCS4String; Index: SizeInt);

       function  Pos(const s:  String;     Offset: SizeInt=1): SizeInt;  overload;
       function  Pos(const us: UCS4String; Offset: SizeInt=1): SizeInt;

       property  Length: SizeInt  read GetLength  write SetLength;

       property  Chars[i: SizeInt]: String  read CharAsUtf8  write SetChar;  // "default" funzt nicht weil UCS4String = Array
     end;


implementation


{ TUCS4Helper }


function TUCS4Helper.GetLength: SizeInt;
begin
  Result:=System.Length(self);
  if Result>0 then dec(Result);
end;


procedure TUCS4Helper.SetLength(NewLen: SizeInt);
var OldLen: SizeInt;
begin
  if NewLen<=0 then begin self:=nil; Exit; end;

  OldLen:=self.GetLength;
  if OldLen=NewLen then Exit;

  System.SetLength(self,NewLen+1);
  self[NewLen]:=0;
end;


procedure TUCS4Helper.SetStr(const s: String);
begin
  if s='' then self:=nil
          else self:=WideStringToUCS4String(WideString(s));
end;


procedure TUCS4Helper.SetStr(const ws: WideString);
begin
  self:=WideStringToUCS4String(ws);
end;


procedure TUCS4Helper.SetStr(const ws: UnicodeString);
begin
  self:=UnicodeStringToUCS4String(ws);
end;


procedure TUCS4Helper.Add(const s: String);
begin
  self.Add( WideStringToUCS4String(WideString(s)) );
end;


procedure TUCS4Helper.Add(const us: UCS4String);
var Len1, Len2: SizeInt;
begin
  Len2:=System.Length(us)-1;
  if Len2<=0 then Exit;

  Len1:=System.Length(self)-1;
  if Len1<=0 then begin self:=us; Exit; end;

  System.SetLength(self,Len1+Len2+1);
  Move( us[0], self[Len1], (Len2+1)*SizeOf(UCS4Char) );
end;


procedure decodeUCS4Char(c4: UCS4Char; out w1, w2: WideChar);  // ähnlich wie in ustrings.inc:UCS4Decode()
begin
  w2:=#0;  // default for 1 UTF16 codepoint only
  if c4<=$ffff then begin w1:=WideChar(Lo(c4)); Exit; end;
  if DWord(c4)>$10ffff then begin w1:='?'; Exit; end;  // invalid codepoint
  w1:=WideChar(c4 shr 10 + $d7c0);
  w2:=WideChar(c4 and $3ff + $dc00);
end;


function TUCS4Helper.CharAsUtf8(i: SizeInt): String;
var c4: UCS4Char;
    w1, w2: WideChar;
    ws: WideString;
begin
  c4:=self[i-1];
  if c4<128 then begin System.SetLength(Result,1); Result[1]:=Char(c4); Exit; end;  // shortcut for ASCII

  decodeUCS4Char(c4,{out}w1,w2);
  if w2=#0 then begin System.SetLength(ws,1); ws[1]:=w1; end
           else begin System.SetLength(ws,2); ws[1]:=w1; ws[2]:=w2; end;
  Result:=UTF8Encode(ws);
end;


procedure TUCS4Helper.SetChar(i: SizeInt; const s: String);
var us: UCS4String;
    Len2: SizeInt;
begin
  us:=WideStringToUCS4String(WideString(s));
  Len2:=System.Length(us)-1;
  if Len2<=0 then Exit;
  self[i-1]:=us[0];
end;


function TUCS4Helper.toUtf8: String;
begin
  Result:=UTF8Encode(UCS4StringToWideString(self));
end;


function TUCS4Helper.toUtf16: UnicodeString;   inline;
begin
  Result:=UCS4StringToUnicodeString(self);
end;


function TUCS4Helper.Copy(Index, Len: SizeInt): UCS4String;
var Len1, Len2: SizeInt;
begin
  if (Index<=0) or (Len<=0) then Exit;

  Len1:=self.GetLength;
  Len2:=Len1+1-Index;  // maximal mögliche Länge ab Index
  if Len2<=0 then Exit;
  if Len<Len2 then Len2:=Len;

  System.SetLength(Result,Len2+1);
  Move( self[Index-1], Result[0], Len2*SizeOf(UCS4Char) );
  Result[Len2]:=0;
end;


function TUCS4Helper.CopyAsUtf8(Index, Len: SizeInt): String;
begin
  Result:=UTF8Encode(UCS4StringToWideString( self.Copy(Index,Len) ));
end;


procedure TUCS4Helper.Delete(Index, Len: SizeInt);
var Len1, Len2: SizeInt;
begin
  if (Index<=0) or (Len<=0) then Exit;

  Len1:=self.GetLength;
  if (Len1<=0) or (Index>Len1) then Exit;

  Len2:=Len1+1-Index;  // maximal mögliche Länge ab Index
  if Len2<=0 then Exit;
  if Len<Len2 then Len2:=Len;

  System.Delete(self,Index-1,Len2);
  // Move( self[Index+Len2-1], self[Index-1], (Len2+1)*SizeOf(UCS4Char) );
  // System.SetLength(self,Index+Len2);
end;


procedure TUCS4Helper.Insert(const Source: String; Index: SizeInt);
begin
  self.Insert( WideStringToUCS4String(WideString(Source)), Index);
end;


procedure TUCS4Helper.Insert(const Source: UCS4String; Index: SizeInt);
var Len2: SizeInt;
begin
  if Index<=0 then Exit;
  Len2:=Source.GetLength;
  if Len2<=0 then Exit;
  System.Insert(Source,{var}self,Index-1);
  System.Delete({var}self,Index-1+Len2,1);  // remove the terminating zero of Source
end;


function TUCS4Helper.Pos(const s: String; Offset: SizeInt=1): SizeInt;
begin
  Result:=self.Pos( WideStringToUCS4String(WideString(s)), Offset );
end;


function TUCS4Helper.Pos(const us: UCS4String; Offset: SizeInt=1): SizeInt;
var i, Len1, Len2, Len2Bytes: SizeInt;
begin
  Result:=0;
  Len1:=System.Length(self)-1;
  if Len1<=0 then Exit{0};

  Len2:=System.Length(us)-1;
  if Len2<=0 then Exit{0};

  if Offset<1 then Offset:=1;
  dec(Offset);
  if Len2>Len1-Offset then Exit{0};

  Len2Bytes:=Len2*SizeOf(UCS4Char);

  // note "dec(Offset)" see above  =>  e.g. Offset=0
  for i:=Offset to Len1-Len2 do
    if CompareByte(us[0],self[i],Len2Bytes)=0 then Exit(i+1);
end;

end.

[theo]

Ist vielleicht nicht genau das gleiche Problem, aber ich hatte vor hundert Jahren mal den Unistring gebastelt.
viewtopic.php?f=29&t=5894&p=54025

[Mathias]

Ist vielleicht nicht genau das gleiche Problem, aber ich hatte vor hundert Jahren mal den Unistring gebastelt.
viewtopic.php?f=29&t=5894&p=54025

Hattest du ein Relaiscomputer, oder hatte der schon Röhren.

Es gibt zwar spezielle UTF8-Routinen, aber die müssen bei jedem Aufruf den String de-kodieren (zumindest bis zur betreffenden Stelle) und sind somit eher lahm.

Dies ist leider ein Manko mit den UTF8-Strings. Im Vergleich war es mit den 256 ASCII-Zeichen Ultraschnell.