jcllinkedlists.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ 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/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is LinkedList.pas.                                                             }
{                                                                                                  }
{ The Initial Developer of the Original Code is Jean-Philippe BEMPEL aka RDM. Portions created by  }
{ Jean-Philippe BEMPEL are Copyright (C) Jean-Philippe BEMPEL (rdm_30 att yahoo dott com)          }
{ All rights reserved.                                                                             }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ The Delphi Container Library                                                                     }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/03/08 15:14:00 $
// For history see end of file

unit JclLinkedLists;

{$I jcl.inc}

interface

uses
  Classes,
  JclBase, JclAbstractContainers, JclContainerIntf;

type
  PJclIntfLinkedListItem = ^TJclIntfLinkedListItem;
  TJclIntfLinkedListItem = record
    Obj: IInterface;
    Next: PJclIntfLinkedListItem;
  end;

  PJclStrLinkedListItem = ^TJclStrLinkedListItem;
  TJclStrLinkedListItem = record
    Str: string;
    Next: PJclStrLinkedListItem;
  end;

  PJclLinkedListItem = ^TJclLinkedListItem;
  TJclLinkedListItem = record
    Obj: TObject;
    Next: PJclLinkedListItem;
  end;

  TJclIntfLinkedList = class(TJclAbstractContainer, IJclIntfCollection,
      IJclIntfList, IJclIntfCloneable)
  private
    FStart: PJclIntfLinkedListItem;
    FEnd: PJclIntfLinkedListItem;
    FSize: Integer;
  protected
    procedure AddFirst(AInterface: IInterface);
    { IJclIntfCollection }
    function Add(AInterface: IInterface): Boolean; overload;
    function AddAll(ACollection: IJclIntfCollection): Boolean; overload;
    procedure Clear;
    function Contains(AInterface: IInterface): Boolean;
    function ContainsAll(ACollection: IJclIntfCollection): Boolean;
    function Equals(ACollection: IJclIntfCollection): Boolean;
    function First: IJclIntfIterator;
    function IsEmpty: Boolean;
    function Last: IJclIntfIterator;
    function Remove(AInterface: IInterface): Boolean; overload;
    function RemoveAll(ACollection: IJclIntfCollection): Boolean;
    function RetainAll(ACollection: IJclIntfCollection): Boolean;
    function Size: Integer;
    { IJclIntfList }
    procedure Insert(Index: Integer; AInterface: IInterface); overload;
    function InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean; overload;
    function GetObject(Index: Integer): IInterface;
    function IndexOf(AInterface: IInterface): Integer;
    function LastIndexOf(AInterface: IInterface): Integer;
    function Remove(Index: Integer): IInterface; overload;
    procedure SetObject(Index: Integer; AInterface: IInterface);
    function SubList(First, Count: Integer): IJclIntfList;
    { IJclIntfCloneable }
    function Clone: IInterface;
  public
    constructor Create(ACollection: IJclIntfCollection = nil);
    destructor Destroy; override;
  end;

  //Daniele Teti 02/03/2005
  TJclStrLinkedList = class(TJclStrCollection, IJclStrList, IJclCloneable)
  private
    FStart: PJclStrLinkedListItem;
    FEnd: PJclStrLinkedListItem;
    FSize: Integer;
  protected
    procedure AddFirst(const AString: string);
    { IJclIntfCollection }
    function Add(const AString: string): Boolean; overload; override;
    function AddAll(ACollection: IJclStrCollection): Boolean; overload; override;
    procedure Clear; override;
    function Contains(const AString: string): Boolean; override;
    function ContainsAll(ACollection: IJclStrCollection): Boolean; override;
    function Equals(ACollection: IJclStrCollection): Boolean; override;
    function First: IJclStrIterator; override;
    function IsEmpty: Boolean; override;
    function Last: IJclStrIterator; override;
    function Remove(const AString: string): Boolean; overload; override;
    function RemoveAll(ACollection: IJclStrCollection): Boolean; override;
    function RetainAll(ACollection: IJclStrCollection): Boolean; override;
    function Size: Integer; override;
    { IJclIntfList }
    procedure Insert(Index: Integer; const AString: string); overload;
    function InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean; overload;
    function GetString(Index: Integer): string;
    function IndexOf(const AString: string): Integer;
    function LastIndexOf(const AString: string): Integer;
    function Remove(Index: Integer): string; overload;
    procedure SetString(Index: Integer; const AString: string);
    function SubList(First, Count: Integer): IJclStrList;
    { IJclCloneable }
    function Clone: TObject;
  public
    constructor Create(ACollection: IJclStrCollection = nil);
    destructor Destroy; override;
  end;

  TJclLinkedList = class(TJclAbstractContainer, IJclCollection, IJclList,
      IJclCloneable)
  private
    FStart: PJclLinkedListItem;
    FEnd: PJclLinkedListItem;
    FSize: Integer;
    FOwnsObjects: Boolean;
  protected
    procedure AddFirst(AObject: TObject);
    procedure FreeObject(var AObject: TObject);
    { IJclCollection }
    function Add(AObject: TObject): Boolean; overload;
    function AddAll(ACollection: IJclCollection): Boolean; overload;
    procedure Clear;
    function Contains(AObject: TObject): Boolean;
    function ContainsAll(ACollection: IJclCollection): Boolean;
    function Equals(ACollection: IJclCollection): Boolean;
    function First: IJclIterator;
    function IsEmpty: Boolean;
    function Last: IJclIterator;
    function Remove(AObject: TObject): Boolean; overload;
    function RemoveAll(ACollection: IJclCollection): Boolean;
    function RetainAll(ACollection: IJclCollection): Boolean;
    function Size: Integer;
    { IJclList }
    procedure Insert(Index: Integer; AObject: TObject); overload;
    function InsertAll(Index: Integer; ACollection: IJclCollection): Boolean; overload;
    function GetObject(Index: Integer): TObject;
    function IndexOf(AObject: TObject): Integer;
    function LastIndexOf(AObject: TObject): Integer;
    function Remove(Index: Integer): TObject; overload;
    procedure SetObject(Index: Integer; AObject: TObject);
    function SubList(First, Count: Integer): IJclList;
    { IJclCloneable }
    function Clone: TObject;
  public
    constructor Create(ACollection: IJclCollection = nil; AOwnsObjects: Boolean = True);
    destructor Destroy; override;
    property OwnsObjects: Boolean read FOwnsObjects;
  end;

implementation

uses
  SysUtils,
  JclResources;

//=== { TIntfItr } ===========================================================

type
  TIntfItr = class(TJclAbstractContainer, IJclIntfIterator)
  private
    FCursor: PJclIntfLinkedListItem;
    FOwnList: TJclIntfLinkedList;
    FLastRet: PJclIntfLinkedListItem;
    FSize: Integer;
  protected
    { IJclIterator}
    procedure Add(AInterface: IInterface);
    function GetObject: IInterface;
    function HasNext: Boolean;
    function HasPrevious: Boolean;
    function Next: IInterface;
    function NextIndex: Integer;
    function Previous: IInterface;
    function PreviousIndex: Integer;
    procedure Remove;
    procedure SetObject(AInterface: IInterface);
  public
    constructor Create(OwnList: TJclIntfLinkedList; Start: PJclIntfLinkedListItem);
    destructor Destroy; override;
  end;

constructor TIntfItr.Create(OwnList: TJclIntfLinkedList; Start: PJclIntfLinkedListItem);
begin
  inherited Create;
  FCursor := Start;
  FOwnList := OwnList;
  FOwnList._AddRef; // Add a ref because FOwnList is not an interface !
  FLastRet := nil;
  FSize := FOwnList.Size;
end;

destructor TIntfItr.Destroy;
begin
  FOwnList._Release;
  inherited Destroy;
end;

procedure TIntfItr.Add(AInterface: IInterface);
var
  NewItem: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if AInterface = nil then
    Exit;
  New(NewItem);
  NewItem.Obj := AInterface;
  if FCursor = nil then
  begin
    FCursor := NewItem;
    NewItem.Next := nil;
  end
  else
  begin
    NewItem.Next := FCursor.Next;
    FCursor.Next := NewItem;
  end;
  Inc(FOwnList.FSize);
  Inc(FSize);
end;

function TIntfItr.GetObject: IInterface;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := FCursor.Obj;
end;

function TIntfItr.HasNext: Boolean;
begin
  Result := FCursor <> nil;
end;

function TIntfItr.HasPrevious: Boolean;
begin
  // Unidirectional
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

function TIntfItr.Next: IInterface;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := FCursor.Obj;
  FLastRet := FCursor;
  FCursor := FCursor.Next;
end;

function TIntfItr.NextIndex: Integer;
begin
  // No index
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

function TIntfItr.Previous: IInterface;
begin
  // Unidirectional
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

function TIntfItr.PreviousIndex: Integer;
begin
  // No Index;
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

procedure TIntfItr.Remove;
var
  Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if FCursor = nil then
    Exit;
  Current := FCursor;
  FCursor := FCursor.Next;
  if FLastRet = nil then
    FOwnList.FStart := FCursor
  else
    FLastRet.Next := FCursor;
  Current.Next := nil;
  Current.Obj := nil;
  Dispose(Current);
  Dec(FOwnList.FSize);
  Dec(FSize);
end;

procedure TIntfItr.SetObject(AInterface: IInterface);
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  FCursor.Obj := AInterface;
end;

//=== { TStrItr } ============================================================

type
  TStrItr = class(TJclAbstractContainer, IJclStrIterator)
  private
    FCursor: PJclStrLinkedListItem;
    FOwnList: TJclStrLinkedList;
    FLastRet: PJclStrLinkedListItem;
    FSize: Integer;
  protected
    { IJclStrIterator}
    procedure Add(const AString: string);
    function GetString: string;
    function HasNext: Boolean;
    function HasPrevious: Boolean;
    function Next: string;
    function NextIndex: Integer;
    function Previous: string;
    function PreviousIndex: Integer;
    procedure Remove;
    procedure SetString(const AString: string);
  public
    constructor Create(OwnList: TJclStrLinkedList; Start: PJclStrLinkedListItem);
    destructor Destroy; override;
  end;

constructor TStrItr.Create(OwnList: TJclStrLinkedList; Start: PJclStrLinkedListItem);
begin
  inherited Create;
  FCursor := Start;
  FOwnList := OwnList;
  FOwnList._AddRef; // Add a ref because FOwnList is not an interface !
  FLastRet := nil;
  FSize := FOwnList.Size;
end;

destructor TStrItr.Destroy;
begin
  FOwnList._Release;
  inherited Destroy;
end;

procedure TStrItr.Add(const AString: string);
var
  NewItem: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if AString = '' then
    Exit;
  New(NewItem);
  NewItem.Str := AString;
  if FCursor = nil then
  begin
    FCursor := NewItem;
    NewItem.Next := nil;
  end
  else
  begin
    NewItem.Next := FCursor.Next;
    FCursor.Next := NewItem;
  end;
  Inc(FOwnList.FSize);
  Inc(FSize);
end;

function TStrItr.GetString: string;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := FCursor.Str;
end;

function TStrItr.HasNext: Boolean;
begin
  Result := FCursor <> nil;
end;

function TStrItr.HasPrevious: Boolean;
begin
  // Unidirectional
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

function TStrItr.Next: string;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := FCursor.Str;
  FLastRet := FCursor;
  FCursor := FCursor.Next;
end;

function TStrItr.NextIndex: Integer;
begin
  // No index
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

function TStrItr.Previous: string;
begin
  // Unidirectional
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

function TStrItr.PreviousIndex: Integer;
begin
  // No index
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

procedure TStrItr.Remove;
var
  Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if FCursor = nil then
    Exit;
  Current := FCursor;
  FCursor := FCursor.Next;
  if FLastRet = nil then
    FOwnList.FStart := FCursor
  else
    FLastRet.Next := FCursor;
  Current.Next := nil;
  Current.Str := '';
  Dispose(Current);
  Dec(FOwnList.FSize);
  Dec(FSize);
end;

procedure TStrItr.SetString(const AString: string);
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  FCursor.Str := AString;
end;

//=== { TItr } ===============================================================

type
  TItr = class(TJclAbstractContainer, IJclIterator)
  private
    FCursor: PJclLinkedListItem;
    FOwnList: TJclLinkedList;
    FLastRet: PJclLinkedListItem;
    FSize: Integer;
  public
    { IJclIterator}
    procedure Add(AObject: TObject);
    function GetObject: TObject;
    function HasNext: Boolean;
    function HasPrevious: Boolean;
    function Next: TObject;
    function NextIndex: Integer;
    function Previous: TObject;
    function PreviousIndex: Integer;
    procedure Remove;
    procedure SetObject(AObject: TObject);
  public
    constructor Create(OwnList: TJclLinkedList; Start: PJclLinkedListItem);
    destructor Destroy; override;
  end;

constructor TItr.Create(OwnList: TJclLinkedList; Start: PJclLinkedListItem);
begin
  inherited Create;
  FCursor := Start;
  FOwnList := OwnList;
  FOwnList._AddRef; // Add a ref because FOwnList is not an interface !
  FLastRet := nil;
  FSize := FOwnList.Size;
end;

destructor TItr.Destroy;
begin
  FOwnList._Release;
  inherited Destroy;
end;

procedure TItr.Add(AObject: TObject);
var
  NewItem: PJclLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if AObject = nil then
    Exit;
  New(NewItem);
  NewItem.Obj := AObject;
  if FCursor = nil then
  begin
    FCursor := NewItem;
    NewItem.Next := nil;
  end
  else
  begin
    NewItem.Next := FCursor.Next;
    FCursor.Next := NewItem;
  end;
  Inc(FOwnList.FSize);
  Inc(FSize);
end;

function TItr.GetObject: TObject;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := FCursor.Obj;
end;

function TItr.HasNext: Boolean;
begin
  Result := FCursor <> nil;
end;

function TItr.HasPrevious: Boolean;
begin