unit StrClass;

{$mode objfpc}{$H+}

interface

//uses
//  Classes, SysUtils;

type

  { TStr }

  TStr = class
  private
    AnsiStr: AnsiString;  // wird nur gespeichert, wenn es gesetzt oder gelesen wird
    UTF8Str: AnsiString;  // wird nur gespeichert, wenn es gesetzt oder gelesen wird
    UTF16Str: WideString;  // wird nur gespeichert, wenn es gesetzt oder gelesen wird
    UCS4Str: UCS4String;  // wird nur gespeichert, wenn es gesetzt oder gelesen wird

    AnsiStrSet: Boolean;  // true, wenn AnsiStr gesetzt ist, mit false initialisiert
    UTF8StrSet: Boolean;  // true, wenn UTF8Str gesetzt ist, mit false initialisiert
    UTF16StrSet: Boolean;  // true, wenn UTF16Str gesetzt ist, mit false initialisiert
    UCS4StrSet: Boolean;  // true, wenn UCS4Str gesetzt ist, mit false initialisiert

    function GetAnsiString: AnsiString;  // AnsiStr setzen, falls ein anderer String bereits gesetzt ist
    function GetUTF8String: UTF8String;  // UTF8Str setzen, falls ein anderer String bereits gesetzt ist
    function GetUTF16String: WideString;  // UTF16Str setzen, falls ein anderer String bereits gesetzt ist
    function GetUCS4String: UCS4String;  // UCS4Str setzen, falls ein anderer String bereits gesetzt ist

    procedure SetAnsiString(const AValue: AnsiString);  // AnsiStr setzen, alle anderen leeren
    procedure SetUTF8String(const AValue: UTF8String);  // UTF8Str setzen, alle anderen leeren
    procedure SetUTF16String(const AValue: WideString);  // UTF16Str setzen, alle anderen leeren
    procedure SetUCS4String(const AValue: UCS4String);  // UCS4Str setzen, alle anderen leeren

    function GetAnsiSubStr(AStartPosition, ACharacterCount: Cardinal): AnsiString;
    function GetUTF8SubStr(AStartPosition, ACharacterCount: Cardinal): UTF8String;
    function GetUTF16SubStr(AStartPosition, ACharacterCount: Cardinal): WideString;
    function GetUCS4SubStr(AStartPosition, ACharacterCount: Cardinal): UCS4String;

    procedure SetAnsiSubStr(AStartPosition, ACharacterCount: Cardinal; const AValue: AnsiString);
    procedure SetUTF8SubStr(AStartPosition, ACharacterCount: Cardinal; const AValue: UTF8String);
    procedure SetUTF16SubStr(AStartPosition, ACharacterCount: Cardinal; const AValue: WideString);
    procedure SetUCS4SubStr(AStartPosition, ACharacterCount: Cardinal; const AValue: UCS4String);

    function GetAnsiChar(const APosition: Cardinal): Char;
    function GetUTF8Char(const APosition: Cardinal): UTF8String;
    function GetUTF16Char(const APosition: Cardinal): WideString;
    function GetUCS4Char(const APosition: Cardinal): UCS4Char;

    procedure SetAnsiChar(const APosition: Cardinal; const AValue: Char);
    procedure SetUTF8Char(const APosition: Cardinal; const AValue: UTF8String);
    procedure SetUTF16Char(const APosition: Cardinal; const AValue: WideString);
    procedure SetUCS4Char(const APosition: Cardinal; const AValue: UCS4Char);
  public
    constructor create;  // alle xxxStrSet auf false setzen

    property AnsiString: AnsiString read GetAnsiString write SetAnsiString;
    property UTF8String: UTF8String read GetUTF8String write SetUTF8String;
    property UTF16String: WideString read GetUTF16String write SetUTF16String;
    property UCS4String: UCS4String read GetUCS4String write SetUCS4String;

    property AnsiSubStr[AStartPosition, ACharacterCount: Cardinal]: AnsiString
      read GetAnsiSubStr write SetAnsiSubStr;
    property UTF8SubStr[AStartPosition, ACharacterCount: Cardinal]: UTF8String
      read GetUTF8SubStr write SetUTF8SubStr;
    property UTF16SubStr[AStartPosition, ACharacterCount: Cardinal]: WideString
      read GetUTF16SubStr write SetUTF16SubStr;
    property UCS4SubStr[AStartPosition, ACharacterCount: Cardinal]: UCS4String
      read GetUCS4SubStr write SetUCS4SubStr;

    property AnsiChar[APosition: Cardinal]: Char read GetAnsiChar write SetAnsiChar;
    property UTF8Char[APosition: Cardinal]: UTF8String read GetUTF8Char write SetUTF8Char;
    property UTF16Char[APosition: Cardinal]: WideString read GetUTF16Char write SetUTF16Char;
    property UCS4Char[APosition: Cardinal]: UCS4Char read GetUCS4Char write SetUCS4Char;

    function Count: Cardinal;
    function SubStrLength(const AStartPosition, ACharacterCount: Cardinal): Cardinal;

//    property CodePage: ? read GetCodePage write SetCodePage;  // aktuell verwendete Codepage, Voreinstellung ist z.B. die Codepage im System, falls es mit Ansi arbeitet
//    function Suitable(ACodePage: ?): Boolean  // true, wenn der aktuell gespeicherte String mit der übergebenen Codepage komplett dargestellt werden kann.
//    function GetSuitableCodepages: ?;  // Gibt eine Liste aller im System vorhandenen oder sonstwie bekannten Codepages zurück, die den aktuellen String darstellen können
  end;

implementation

{ TStr }

function TStr.GetAnsiString: AnsiString;
begin
  if (not AnsiStrSet) and (UTF8StrSet or UTF16StrSet or UCS4StrSet) then begin
    AnsiStr := UTF8ToAnsi(GetUTF8String);  // String umcoden
    AnsiStrSet := true;
  end;
  result := AnsiStr  // Falls noch kein String gesetzt war, wird hier schlimmstenfalls '' zurückgegeben
end;

function TStr.GetUTF8String: UTF8String;
begin
  result := '';
  if UTF8StrSet then begin
    result := UTF8Str;
    exit;
  end;
  if UTF16StrSet or UCS4StrSet then begin  // Zuerst die anderen Unicoderepräsentationen prüfen
    UTF8Str := UTF8Decode(GetUTF16String);
    UTF8StrSet := true;
    result := UTF8Str;
    exit;
  end;
  if AnsiStrSet then begin  // Zuletzt Ansi prüfen, da Ansi die einzige Codierung mit kleinerem Wertebereich ist
    UTF8Str := AnsiToUTF8(AnsiStr);
    UTF8StrSet := true;
    result := UTF8Str;
  end;
end;

function TStr.GetUTF16String: WideString;
begin
  result := '';
  if UTF16StrSet then begin
    result := UTF16Str;
    exit;
  end;
  if UTF8StrSet then begin  // Zuerst die anderen Unicoderepräsentationen prüfen
    UTF16Str := UTF8Decode(UTF8Str);
    UTF16StrSet := true;
    result := UTF16Str;
    exit;
  end;
  if UCS4StrSet then begin  // Zuerst die anderen Unicoderepräsentationen prüfen
    UTF16Str := UCS4StringToWideString(UCS4Str);
    UTF16StrSet := true;
    result := UTF16Str;
    exit;
  end;
  if AnsiStrSet then begin  // Zuletzt Ansi prüfen, da Ansi die einzige Codierung mit kleinerem Wertebereich ist
    UTF16Str := UTF8Decode(GetUTF8String);  // Es gibt keine direkte Funktion, daher über Zwischenschritt UTF-8
    UTF16StrSet := true;
    result := UTF16Str;
  end;
end;

function TStr.GetUCS4String: UCS4String;
begin
  if (not UCS4StrSet) and (UTF8StrSet or UTF16StrSet or UCS4StrSet) then begin
    UCS4Str := WideStringToUCS4String(GetUTF16String);  // String umcoden
    UCS4StrSet := true;
  end;
  result := UCS4Str;  // Falls noch kein String gesetzt war, wird hier schlimmstenfalls '' zurückgegeben
end;

procedure TStr.SetAnsiString(const AValue: AnsiString);
begin
  AnsiStr := AValue;
  AnsiStrSet := true;
  UTF8Str := '';        // alle anderen Strings leeren, um Konsistenz zu wahren
  UTF8StrSet := false;
  UTF16Str := '';
  UTF16StrSet := false;
  UCS4Str := WideStringToUCS4String('');
  UCS4StrSet := false;
end;

procedure TStr.SetUTF8String(const AValue: UTF8String);
begin
  AnsiString := '';  // alle Strings leeren, um Konsistenz zu wahren
  UTF8Str := AValue;
  UTF8StrSet := true;
end;

procedure TStr.SetUTF16String(const AValue: WideString);
begin
  AnsiString := '';  // alle Strings leeren, um Konsistenz zu wahren
  UTF16Str := AValue;
  UTF16StrSet := true;
end;

procedure TStr.SetUCS4String(const AValue: UCS4String);
begin
  AnsiString := '';  // alle Strings leeren, um Konsistenz zu wahren
  UCS4Str := AValue;
  UCS4StrSet := true;
end;

function TStr.GetAnsiSubStr(AStartPosition, ACharacterCount: Cardinal): AnsiString;
begin
  if not AnsiStrSet then  // sicherstellen, dass AnsiStr gesetzt ist
    GetAnsiString;  // sonst setzen
  result := copy(AnsiStr,AStartPosition,ACharacterCount);  // das geht direkt
end;

function TStr.GetUTF8SubStr(AStartPosition, ACharacterCount: Cardinal): UTF8String;
begin
  if not UCS4StrSet then  // sicherstellen, dass UCS4Str gesetzt ist
    GetUCS4String;  // sonst setzen
  result := UTF8Encode(UCS4StringToWideString(copy(UCS4Str,AStartPosition,ACharacterCount)));  // Umweg über UCS4 nötig
end;

function TStr.GetUTF16SubStr(AStartPosition, ACharacterCount: Cardinal): WideString;
begin
  if not UCS4StrSet then  // sicherstellen, dass UCS4Str gesetzt ist
    GetUCS4String;  // sonst setzen
  result := UCS4StringToWideString(copy(UCS4Str,AStartPosition,ACharacterCount));  // Umweg über UCS4 nötig
end;

function TStr.GetUCS4SubStr(AStartPosition, ACharacterCount: Cardinal): UCS4String;
begin
  if not UCS4StrSet then  // sicherstellen, dass UCS4Str gesetzt ist
    GetUCS4String;  // sonst setzen
  result := copy(UCS4Str,AStartPosition,ACharacterCount);  // das geht direkt
end;

procedure TStr.SetAnsiSubStr(AStartPosition, ACharacterCount: Cardinal; const AValue: AnsiString);
begin
  if UTF8StrSet or UTF16StrSet or UCS4StrSet then
// Umweg über UCS4 ist nötig, da evtl. in Unicode vorhandene andere Zeichen sonst verlorengehen würden
    SetUTF8SubStr(AStartPosition,ACharacterCount,AnsiToUtf8(AValue))
  else
    AnsiString := copy(AnsiString,1,AStartPosition-1)+AValue+
                  copy(AnsiString,AStartPosition+ACharacterCount,High(Integer));  // High(Cardinal) funktioniert komischerweise nicht
end;

procedure TStr.SetUTF8SubStr(AStartPosition, ACharacterCount: Cardinal; const AValue: UTF8String);
begin
  SetUTF16SubStr(AStartPosition,ACharacterCount,UTF8Decode(AValue));  // Umweg über UCS4
end;

procedure TStr.SetUTF16SubStr(AStartPosition, ACharacterCount: Cardinal; const AValue: WideString);
begin
  SetUCS4SubStr(AStartPosition,ACharacterCount,WideStringToUCS4String(AValue));  // Umweg über UCS4
end;

procedure TStr.SetUCS4SubStr(AStartPosition, ACharacterCount: Cardinal; const AValue: UCS4String);
begin
// Lesezugriff auf UCS4String stellt die Existenz von UCS4Str sicher, falls überhaupt ein String gesetzt ist
// Schreibzugriff auf UCS4String stellt sicher, dass die anderen Strings zurückgesetzt werden
{  UCS4String := copy(UCS4String,1,AStartPosition-1)+AValue+
                copy(UCS4String,AStartPosition+ACharacterCount,High(Cardinal));}
end;

function TStr.GetAnsiChar(const APosition: Cardinal): Char;
begin
  if not AnsiStrSet then
    GetAnsiString;  // sicherstellen, dass AnsiStr gesetzt ist
  result := AnsiStr[APosition];  // Access Violation möglich, falls APosition > Count
end;

function TStr.GetUTF8Char(const APosition: Cardinal): UTF8String;
begin
  result := UTF8SubStr[APosition,1];
end;

function TStr.GetUTF16Char(const APosition: Cardinal): WideString;
begin
  result := UTF16SubStr[APosition,1];
end;

function TStr.GetUCS4Char(const APosition: Cardinal): UCS4Char;
begin
  if not UCS4StrSet then
    GetUCS4String;  // sicherstellen, dass UCS4Str gesetzt ist
  result := UCS4Str[APosition];  // Access Violation möglich, falls APosition > Count
end;

procedure TStr.SetAnsiChar(const APosition: Cardinal; const AValue: Char);
begin
  if UTF8StrSet or UTF16StrSet or UCS4StrSet then
// Umweg über UCS4 ist nötig, da evtl. in Unicode vorhandene andere Zeichen sonst verlorengehen würden
    SetUTF8SubStr(APosition,1,AnsiToUTF8(AValue))
  else
    AnsiStr[APosition] := AValue;  // Access Violation möglich, falls APosition > Count
end;

procedure TStr.SetUTF8Char(const APosition: Cardinal; const AValue: UTF8String);
begin
  SetUTF8SubStr(APosition,1,AValue);  // Umweg über UCS4
end;

procedure TStr.SetUTF16Char(const APosition: Cardinal; const AValue: WideString);
begin
  SetUTF16SubStr(APosition,1,AValue);  // Umweg über UCS4
end;

procedure TStr.SetUCS4Char(const APosition: Cardinal; const AValue: UCS4Char);
begin
  if not UCS4StrSet then
    GetUCS4String;  // sicherstellen, dass UCS4Str gesetzt ist
  UCS4Str[APosition] := AValue;  // Access Violation möglich, falls APosition > Count
end;

constructor TStr.create;
begin
  inherited;
  AnsiStrSet := false;  // zu Anfang ist noch kein String gesetzt
  UTF8StrSet := false;
  UTF16StrSet := false;
  UCS4StrSet := false;
end;

function TStr.Count: Cardinal;
begin
  if UCS4StrSet then begin  // UCS4 wird bevorzugt
    result := length(UCS4Str);
    exit;
  end;
  if AnsiStrSet then begin  // Ansi ist auch möglich
    result := length(AnsiStr);
    exit;
  end;
  GetUCS4String;  // Ansonsten muss UCS4Str gesetzt werden
  result := length(UCS4Str);  // Falls kein String gesetzt ist, wird richtigerweise 0 zurückgegeben
end;

function TStr.SubStrLength(const AStartPosition, ACharacterCount: Cardinal): Cardinal;
begin
  if UCS4StrSet then begin  // UCS4 wird bevorzugt
    result := length(copy(UCS4Str,AStartPosition,ACharacterCount));
    exit;
  end;
  if AnsiStrSet then begin  // Ansi ist auch möglich
    result := length(copy(AnsiStr,AStartPosition,ACharacterCount));
    exit;
  end;
  GetUCS4String;  // Ansonsten muss UCS4Str gesetzt werden
  result := length(copy(UCS4Str,AStartPosition,ACharacterCount));  // Falls kein String gesetzt ist, oder der SubStr leer ist, wird richtigerweise 0 zurückgegeben
end;

end.