jclwidestrings.pas

East make Tray Icon in delphi

      else
        Inc(Result);
    end;
  end;
  Result := nil;
end;

function StrLenW(P: PWideChar): Integer;
begin
  Result := 0;
  if P <> nil then
    while P[Result] <> #0 do
      Inc(Result);
end;

function StrScanW(P: PWideChar; Ch: WideChar): PWideChar;
begin
  Result := P;
  if Result <> nil then
    while (Result^ <> #0) and (Result^ <> Ch) do
      Inc(Result);
end;

function StrEndW(P: PWideChar): PWideChar;
begin
  Result := P;
  if Result <> nil then
    while Result^ <> #0 do
      Inc(Result);
end;

function StrCopyW(Dest, Source: PWideChar): PWideChar;
begin
  Result := Dest;
  if Dest <> nil then
  begin
    if Source <> nil then
      while Source^ <> #0 do
      begin
        Dest^ := Source^;
        Inc(Source);
        Inc(Dest);
      end;
    Dest^ := #0;
  end;
end;

function StrECopyW(Dest, Source: PWideChar): PWideChar;
begin
  if Dest <> nil then
  begin
    if Source <> nil then
      while Source^ <> #0 do
      begin
        Dest^ := Source^;
        Inc(Source);
        Inc(Dest);
      end;
    Dest^ := #0;
  end;
  Result := Dest;
end;

function StrLCopyW(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar;
begin
  Result := Dest;
  if (Dest <> nil) and (MaxLen > 0) then
  begin
    if Source <> nil then
      while (MaxLen > 0) and (Source^ <> #0) do
      begin
        Dest^ := Source^;
        Inc(Source);
        Inc(Dest);
        Dec(MaxLen);
      end;
    Dest^ := #0;
  end;
end;

function StrCatW(Dest, Source: PWideChar): PWideChar;
begin
  Result := Dest;
  while Dest^ <> #0 do
    Inc(Dest);
  StrCopyW(Dest, Source);
end;

function StrLCatW(Dest, Source: PWideChar; MaxLen: Cardinal): PWideChar;
begin
  Result := Dest;
  while Dest^ <> #0 do
  begin
    Inc(Dest);
    if MaxLen = 0 then
      Exit;
    Dec(MaxLen);
  end;
  StrLCopyW(Dest, Source, MaxLen);
end;

function StrMoveW(Dest: PWideChar; const Source: PWideChar; Count: Cardinal): PWideChar;
begin
  Result := Dest;
  Move(Source^, Dest^, Integer(Count) * SizeOf(WideChar));
end;

function StrPCopyW(Dest: PWideChar; const Source: WideString): PWideChar;
begin
  Result := StrLCopyW(Dest, PWideChar(Source), Length(Source));
end;

function StrPLCopyW(Dest: PWideChar; const Source: WideString; MaxLen: Cardinal): PWideChar;
begin
  Result := StrLCopyW(Dest, PWideChar(Source), MaxLen);
end;

function StrRScanW(const Str: PWideChar; Chr: WideChar): PWideChar;
var
  P: PWideChar;
begin
  Result := nil;
  if Str <> nil then
  begin
    P := Str;
    repeat
      if P^ = Chr then
        Result := P;
      Inc(P);
    until P^ = #0;
  end;
end;

//=== WideString functions ===================================================

function WidePos(const SubStr, S: WideString): Integer;
var
  P: PWideChar;
begin
  P := StrPosW(PWideChar(S), PWideChar(SubStr));
  if P <> nil then
    Result := P - PWideChar(S) + 1
  else
    Result := 0;
end;

// original code by Mike Lischke (extracted from JclUnicode.pas)

function WideQuotedStr(const S: WideString; Quote: WideChar): WideString;
var
  P, Src,
  Dest: PWideChar;
  AddCount: Integer;
begin
  AddCount := 0;
  P := StrScanW(PWideChar(S), Quote);
  while P <> nil do
  begin
    Inc(P);
    Inc(AddCount);
    P := StrScanW(P, Quote);
  end;

  if AddCount = 0 then
    Result := Quote + S + Quote
  else
  begin
    SetLength(Result, Length(S) + AddCount + 2);
    Dest := PWideChar(Result);
    Dest^ := Quote;
    Inc(Dest);
    Src := PWideChar(S);
    P := StrScanW(Src, Quote);
    repeat
      Inc(P);
      MoveWideChar(Src^, Dest^, P - Src);
      Inc(Dest, P - Src);
      Dest^ := Quote;
      Inc(Dest);
      Src := P;
      P := StrScanW(Src, Quote);
    until P = nil;
    P := StrEndW(Src);
    MoveWideChar(Src^, Dest^, P - Src);
    Inc(Dest, P - Src);
    Dest^ := Quote;
  end;
end;

// original code by Mike Lischke (extracted from JclUnicode.pas)

function WideExtractQuotedStr(var Src: PWideChar; Quote: WideChar): WideString;
var
  P, Dest: PWideChar;
  DropCount: Integer;
begin
  Result := '';
  if (Src = nil) or (Src^ <> Quote) then
    Exit;

  Inc(Src);
  DropCount := 1;
  P := Src;
  Src := StrScanW(Src, Quote);
  while Src <> nil do   // count adjacent pairs of quote chars
  begin
    Inc(Src);
    if Src^ <> Quote then
      Break;
    Inc(Src);
    Inc(DropCount);
    Src := StrScanW(Src, Quote);
  end;

  if Src = nil then
    Src := StrEndW(P);
  if (Src - P) <= 1 then
    Exit;

  if DropCount = 1 then
    SetString(Result, P, Src - P - 1)
  else
  begin
    SetLength(Result, Src - P - DropCount);
    Dest := PWideChar(Result);
    Src := StrScanW(P, Quote);
    while Src <> nil do
    begin
      Inc(Src);
      if Src^ <> Quote then
        Break;
      MoveWideChar(P^, Dest^, Src - P);
      Inc(Dest, Src - P);
      Inc(Src);
      P := Src;
      Src := StrScanW(Src, Quote);
    end;
    if Src = nil then
      Src := StrEndW(P);
    MoveWideChar(P^, Dest^, Src - P - 1);
  end;
end;


function TrimW(const S: WideString): WideString;
// available from Delphi 7 up
{$IFDEF RTL150_UP}
begin
  Result := Trim(S);
end;
{$ELSE ~RTL150_UP}
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do
    Inc(I);
  if I > L then
    Result := ''
  else
  begin
    while S[L] <= ' ' do
      Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;
{$ENDIF ~RTL150_UP}

function TrimLeftW(const S: WideString): WideString;
// available from Delphi 7 up
{$IFDEF RTL150_UP}
begin
  Result := TrimLeft(S);
end;
{$ELSE ~RTL150_UP}
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do
    Inc(I);
  Result := Copy(S, I, Maxint);
end;
{$ENDIF ~RTL150_UP}

function TrimRightW(const S: WideString): WideString;
// available from Delphi 7 up
{$IFDEF RTL150_UP}
begin
  Result := TrimRight(S);
end;
{$ELSE ~RTL150_UP}
var
  I: Integer;
begin
  I := Length(S);
  while (I > 0) and (S[I] <= ' ') do
    Dec(I);
  Result := Copy(S, 1, I);
end;
{$ENDIF ~RTL150_UP}

// functions missing in Delphi 5 / FPC
{$IFNDEF RTL140_UP}

function WideCompareText(const S1, S2: WideString): Integer;
begin
  {$IFDEF MSWINDOWS}
  if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
    Result := AnsiCompareText(string(S1), string(S2))
  else
    Result := CompareStringW(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
      PWideChar(S1), Length(S1), PWideChar(S2), Length(S2)) - 2;
  {$ELSE ~MSWINDOWS}
  { TODO : Don't cheat here }
  Result := CompareText(S1, S2);
  {$ENDIF MSWINDOWS}
end;

function WideCompareStr(const S1, S2: WideString): Integer;
begin
  {$IFDEF MSWINDOWS}
  if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
    Result := AnsiCompareStr(string(S1), string(S2))
  else
    Result := CompareStringW(LOCALE_USER_DEFAULT, 0,
      PWideChar(S1), Length(S1), PWideChar(S2), Length(S2)) - 2;
  {$ELSE ~MSWINDOWS}
  { TODO : Don't cheat here }
  Result := CompareString(S1, S2);
  {$ENDIF ~MSWINDOWS}
end;

function WideUpperCase(const S: WideString): WideString;
begin
  Result := S;
  if Result <> '' then
    {$IFDEF MSWINDOWS}
    CharUpperBuffW(Pointer(Result), Length(Result));
    {$ELSE ~MSWINDOWS}
    { TODO : Don't cheat here }
    Result := UpperCase(Result);
    {$ENDIF ~MSWINDOWS}
end;

function WideLowerCase(const S: WideString): WideString;
begin
  Result := S;
  if Result <> '' then
    {$IFDEF MSWINDOWS}
    CharLowerBuffW(Pointer(Result), Length(Result));
    {$ELSE ~MSWINDOWS}
    { TODO : Don't cheat here }
    Result := LowerCase(Result);
    {$ENDIF ~MSWINDOWS}
end;

{$ENDIF ~RTL140_UP}

function TrimLeftLengthW(const S: WideString): Integer;
var
  Len: Integer;
begin
  Len := Length(S);
  Result := 1;
  while (Result <= Len) and (S[Result] <= #32) do
    Inc(Result);
  Result := Len - Result + 1;
end;

function TrimRightLengthW(const S: WideString): Integer;
begin
  Result := Length(S);
  while (Result > 0) and (S[Result] <= #32) do
    Dec(Result);
end;

//=== { TWStrings } ==========================================================

constructor TWStrings.Create;
begin
  inherited Create;
  // FLineSeparator := WideChar($2028);
  {$IFDEF MSWINDOWS}
  FLineSeparator := WideChar(13) + '' + WideChar(10); // compiler wants it this way
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}
  FLineSeparator := WideChar(10);
  {$ENDIF UNIX}
  FNameValueSeparator := '=';
  FDelimiter := ',';
  FQuoteChar := '"';
end;

function TWStrings.Add(const S: WideString): Integer;
begin
  Result := AddObject(S, nil);
end;

function TWStrings.AddObject(const S: WideString; AObject: TObject): Integer;
begin
  Result := Count;
  InsertObject(Result, S, AObject);
end;

procedure TWStrings.AddStrings(Strings: TWStrings);
var
  I: Integer;
begin
  for I := 0 to Strings.Count - 1 do
    AddObject(Strings.GetP(I)^, Strings.Objects[I]);
end;

procedure TWStrings.AddStrings(Strings: TStrings);
var
  I: Integer;
begin
  for I := 0 to Strings.Count - 1 do
    AddObject(Strings.Strings[I], Strings.Objects[I]);
end;

procedure TWStrings.AddStringsTo(Dest: TStrings);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Dest.AddObject(GetP(I)^, Objects[I]);
end;

procedure TWStrings.Append(const S: WideString);
begin
  Add(S);
end;

procedure TWStrings.Assign(Source: TPersistent);
begin
  if Source is TWStrings then
  begin
    BeginUpdate;
    try
      Clear;
      FDelimiter := TWStrings(Source).FDelimiter;
      FNameValueSeparator := TWStrings(Source).FNameValueSeparator;
      FQuoteChar := TWStrings(Source).FQuoteChar;
      AddStrings(TWStrings(Source));
    finally
      EndUpdate;
    end;
  end
  else
  if Source is TStrings then
  begin
    BeginUpdate;
    try
      Clear;
      {$IFDEF RTL150_UP}
      FNameValueSeparator := CharToWideChar(TStrings(Source).NameValueSeparator);
      {$ENDIF RTL150_UP}