jvstringholder.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvStrHlder.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvStringHolder.pas,v 1.23 2005/02/17 10:20:54 marquardt Exp $

unit JvStringHolder;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  {$IFDEF HAS_UNIT_RTLCONSTS}
  RTLConsts,
  {$ENDIF HAS_UNIT_RTLCONSTS}
  SysUtils, Classes;

type
  TJvMacros = class;
  TMacroTextEvent = procedure(Sender: TObject; Data: Variant; var Text: string) of object;

  TJvMacro = class(TCollectionItem)
  private
    FName: string;
    FData: Variant;
    FOnGetText: TMacroTextEvent;
    function IsMacroStored: Boolean;
    function GetText: string;
    function GetMacros: TJvMacros;
  protected
    function GetDisplayName: string; override;
    procedure SetDisplayName(const Value: string); override;
    procedure GetMacroText(var AText: string);
    function GetAsVariant: Variant;
    procedure SetAsVariant(Value: Variant);
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    function IsEqual(Value: TJvMacro): Boolean;
    property Macros: TJvMacros read GetMacros;
    property Text: string read GetText;
  published
    property Name: string read FName write SetDisplayName;
    property Value: Variant read GetAsVariant write SetAsVariant stored IsMacroStored;
    property OnGetText: TMacroTextEvent read FOnGetText write FOnGetText;
  end;

  TJvMacros = class(TOwnedCollection)
  private
    function GetMacroValue(const MacroName: string): Variant;
    procedure SetMacroValue(const MacroName: string; const Value: Variant);
    function GetItem(Index: Integer): TJvMacro;
    procedure SetItem(Index: Integer; Value: TJvMacro);
  public
    constructor Create(AOwner: TPersistent);
    procedure AssignValues(Value: TJvMacros);
    procedure AddMacro(Value: TJvMacro);
    procedure RemoveMacro(Value: TJvMacro);
    function CreateMacro(const MacroName: string): TJvMacro;
    procedure GetMacroList(List: TList; const MacroNames: string);
    function IndexOf(const AName: string): Integer;
    function IsEqual(Value: TJvMacros): Boolean;
    function ParseString(const Value: string; DoCreate: Boolean; SpecialChar: Char): string;
    function MacroByName(const Value: string): TJvMacro;
    function FindMacro(const Value: string): TJvMacro;
    property Items[Index: Integer]: TJvMacro read GetItem write SetItem; default;
    property MacroValues[const MacroName: string]: Variant read GetMacroValue write SetMacroValue;
  end;

  TJvStrHolder = class(TComponent)
  private
    FStrings: TStringList;
    FXorKey: string;
    FReserved: Integer;
    FMacros: TJvMacros;
    FMacroChar: Char;
    FOnExpandMacros: TNotifyEvent;
    FOnChange: TNotifyEvent;
    FOnChanging: TNotifyEvent;
    function GetDuplicates: TDuplicates;
    procedure SetDuplicates(Value: TDuplicates);
    function GetSorted: Boolean;
    procedure SetSorted(Value: Boolean);
    function GetStrings: TStrings;
    procedure SetStrings(Value: TStrings);
    procedure StringsChanged(Sender: TObject);
    procedure StringsChanging(Sender: TObject);
    procedure ReadStrings(Reader: TReader);
    procedure WriteStrings(Writer: TWriter);
    procedure ReadVersion(Reader: TReader);
    procedure WriteVersion(Writer: TWriter);
    function GetCommaText: string;
    procedure SetCommaText(const Value: string);
    function GetCapacity: Integer;
    procedure SetCapacity(NewCapacity: Integer);
    procedure SetMacros(Value: TJvMacros);
    procedure RecreateMacros;
    procedure SetMacroChar(Value: Char);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure Changed; dynamic;
    procedure Changing; dynamic;
    procedure BeforeExpandMacros; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    function MacroCount: Integer;
    function MacroByName(const MacroName: string): TJvMacro;
    function ExpandMacros: string;
    property CommaText: string read GetCommaText write SetCommaText;
  published
    property Capacity: Integer read GetCapacity write SetCapacity default 0;
    property MacroChar: Char read FMacroChar write SetMacroChar default '%';
    property Macros: TJvMacros read FMacros write SetMacros;
    property OnExpandMacros: TNotifyEvent read FOnExpandMacros write FOnExpandMacros;
    property Duplicates: TDuplicates read GetDuplicates write SetDuplicates default dupIgnore;
    property KeyString: string read FXorKey write FXorKey stored False;
    property Sorted: Boolean read GetSorted write SetSorted default False;
    property Strings: TStrings read GetStrings write SetStrings stored False;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
  end;

  { MultiStringHolder }

  EJvMultiStringHolderException = class(Exception);

  TJvMultiStringHolderCollectionItem = class(TCollectionItem)
  private
    FName: string;
    FStrings: TStrings;
    procedure SetName(Value: string);
    procedure SetStrings(const Value: TStrings);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property Name: string read FName write SetName;
    property Strings: TStrings read FStrings write SetStrings;
  end;

  TJvMultiStringHolderCollection = class(TOwnedCollection)
  protected
    function GetItem(Index: Integer): TJvMultiStringHolderCollectionItem;
    procedure SetItem(Index: Integer; Value: TJvMultiStringHolderCollectionItem);
  public
    function DoesNameExist(const Name: string): Boolean;
    property Items[Index: Integer]: TJvMultiStringHolderCollectionItem read GetItem write SetItem;
    function Add: TJvMultiStringHolderCollectionItem;
    function Insert(Index: Integer): TJvMultiStringHolderCollectionItem;
  end;

  TJvMultiStringHolder = class(TComponent)
  private
    FMultipleStrings: TJvMultiStringHolderCollection;
    procedure SetMultipleStrings(Value: TJvMultiStringHolderCollection);
    function GetItemByName(const Name: string): TJvMultiStringHolderCollectionItem;
    function GetStringsByName(const Name: string): TStrings;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property ItemByName[const Name: string]: TJvMultiStringHolderCollectionItem read GetItemByName;
    property StringsByName[const Name: string]: TStrings read GetStringsByName;
  published
    property MultipleStrings: TJvMultiStringHolderCollection read FMultipleStrings write SetMultipleStrings;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvStringHolder.pas,v $';
    Revision: '$Revision: 1.23 $';
    Date: '$Date: 2005/02/17 10:20:54 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF VCL}
  Consts,
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  QConsts,
  {$ENDIF VisualCLX}
  JvJCLUtils, JvResources, JvConsts, JvTypes;

const
  XorVersion = 1;

function ExtractName(const Items: string; var Pos: Integer): string;
var
  I: Integer;
begin
  I := Pos;
  while (I <= Length(Items)) and (Items[I] <> ';') do
    Inc(I);
  Result := Trim(Copy(Items, Pos, I - Pos));
  if (I <= Length(Items)) and (Items[I] = ';') then
    Inc(I);
  Pos := I;
end;

function NameDelimiter(C: Char; Delims: TCharSet): Boolean;
begin
  Result := (C in [' ', ',', ';', ')', Cr, Lf]) or (C in Delims);
end;

function IsLiteral(C: Char): Boolean;
begin
  Result := C in ['''', '"'];
end;

procedure CreateMacros(List: TJvMacros; const Value: PChar; SpecialChar: Char; Delims: TCharSet);
var
  CurPos, StartPos: PChar;
  CurChar: Char;
  Literal: Boolean;
  EmbeddedLiteral: Boolean;
  Name: string;

  function StripLiterals(Buffer: PChar): string;
  var
    Len: Word;
    TempBuf: PChar;

    procedure StripChar(Value: Char);
    begin
      if TempBuf^ = Value then
        StrMove(TempBuf, TempBuf + 1, Len - 1);
      if TempBuf[StrLen(TempBuf) - 1] = Value then
        TempBuf[StrLen(TempBuf) - 1] := #0;
    end;

  begin
    Len := StrLen(Buffer) + 1;
    TempBuf := AllocMem(Len);
    Result := '';
    try
      StrCopy(TempBuf, Buffer);
      StripChar('''');
      StripChar('"');
      Result := StrPas(TempBuf);
    finally
      FreeMem(TempBuf, Len);
    end;
  end;

begin
  if SpecialChar = #0 then
    Exit;
  CurPos := Value;
  Literal := False;
  EmbeddedLiteral := False;
  repeat
    CurChar := CurPos^;
    if (CurChar = SpecialChar) and not Literal and ((CurPos + 1)^ <> SpecialChar) then
    begin
      StartPos := CurPos;
      while (CurChar <> #0) and (Literal or not NameDelimiter(CurChar, Delims)) do
      begin
        Inc(CurPos);
        CurChar := CurPos^;
        if IsLiteral(CurChar) then
        begin
          Literal := Literal xor True;
          if CurPos = StartPos + 1 then
            EmbeddedLiteral := True;
        end;
      end;
      CurPos^ := #0;
      if EmbeddedLiteral then
      begin
        Name := StripLiterals(StartPos + 1);
        EmbeddedLiteral := False;
      end
      else
        Name := StrPas(StartPos + 1);
      if Assigned(List) then
      begin
        if List.FindMacro(Name) = nil then
          List.CreateMacro(Name);
      end;
      CurPos^ := CurChar;
      StartPos^ := '?';
      Inc(StartPos);
      StrMove(StartPos, CurPos, StrLen(CurPos) + 1);
      CurPos := StartPos;
    end
    else
    if (CurChar = SpecialChar) and not Literal and ((CurPos + 1)^ = SpecialChar) then
      StrMove(CurPos, CurPos + 1, StrLen(CurPos) + 1)
    else
    if IsLiteral(CurChar) then
      Literal := Literal xor True;
    Inc(CurPos);
  until CurChar = #0;
end;

//=== { TJvMacro } ===========================================================

constructor TJvMacro.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FData := Unassigned;
end;

procedure TJvMacro.Assign(Source: TPersistent);
begin
  if Source is TJvMacro then
  begin
    if VarIsEmpty(TJvMacro(Source).FData) then
      Clear
    else
      Value := TJvMacro(Source).FData;
    Name := TJvMacro(Source).Name;
  end
  else
    inherited Assign(Source);
end;

function TJvMacro.GetDisplayName: string;
begin
  if FName = '' then
    Result := inherited GetDisplayName
  else
    Result := FName;
end;

procedure TJvMacro.SetDisplayName(const Value: string);
begin
  if (Value <> '') and (AnsiCompareText(Value, FName) <> 0) and
    (Collection is TJvMacros) and (TJvMacros(Collection).IndexOf(Value) >= 0) then
    raise EJVCLException.CreateRes(@SDuplicateString);
  FName := Value;
  inherited SetDisplayName(Value);
end;

procedure TJvMacro.GetMacroText(var AText: string);
begin
  if Assigned(FOnGetText) then
    FOnGetText(Self, FData, AText);
end;

function TJvMacro.GetText: string;
begin
  Result := FData;
  GetMacroText(Result);
end;

function TJvMacro.GetMacros: TJvMacros;
begin
  if Collection is TJvMacros then
    Result := TJvMacros(Collection)
  else
    Result := nil;
end;

procedure TJvMacro.Clear;
begin
  FData := Unassigned;
end;

function TJvMacro.IsMacroStored: Boolean;
begin
  Result := not VarIsEmpty(FData);
end;

function TJvMacro.GetAsVariant: Variant;
begin
  Result := FData;
end;

procedure TJvMacro.SetAsVariant(Value: Variant);
begin
  FData := Value;
end;

function TJvMacro.IsEqual(Value: TJvMacro): Boolean;
begin
  Result := (VarType(FData) = VarType(Value.FData)) and
    (VarIsEmpty(FData) or (FData = Value.FData)) and
    (Name = Value.Name);
end;

//=== { TJvMacros } ==========================================================

constructor TJvMacros.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TJvMacro);
end;

function TJvMacros.IndexOf(const AName: string): Integer;
begin
  for Result := 0 to Count - 1 do
    if AnsiSameText(TJvMacro(Items[Result]).Name, AName) then
      Exit;
  Result := -1;
end;

function TJvMacros.GetItem(Index: Integer): TJvMacro;
begin
  Result := TJvMacro(inherited Items[Index]);
end;

procedure TJvMacros.SetItem(Index: Integer; Value: TJvMacro);
begin
  inherited SetItem(Index, TCollectionItem(Value));
end;

procedure TJvMacros.AddMacro(Value: TJvMacro);
begin
  Value.Collection := Self;
end;

procedure TJvMacros.RemoveMacro(Value: TJvMacro);
begin
  if Value.Collection = Self then
    Value.Collection := nil;
end;

function TJvMacros.CreateMacro(const MacroName: string): TJvMacro;
begin
  Result := Add as TJvMacro;
  Result.Name := MacroName;
end;

function TJvMacros.IsEqual(Value: TJvMacros): Boolean;
var
  I: Integer;
begin
  Result := Count = Value.Count;
  if Result then
    for I := 0 to Count - 1 do
    begin
      Result := Items[I].IsEqual(Value.Items[I]);
      if not Result then
        Break;
    end;
end;

function TJvMacros.MacroByName(const Value: string): TJvMacro;
begin
  Result := FindMacro(Value);
  if Result = nil then
    raise EJVCLException.CreateRes(@SInvalidPropertyValue);
end;