Componentes.Terceros.jcl/official/1.96/source/common/JclLinkedLists.pas

2597 lines
60 KiB
ObjectPascal

{**************************************************************************************************}
{ }
{ 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/05/07 14:33:48 $
// For history see end of file
unit JclLinkedLists;
{$I jcl.inc}
interface
uses
Classes,
JclBase, JclAbstractContainers, JclContainerIntf;
type
{$IFDEF CLR}
TJclIntfLinkedListItem = class;
PJclIntfLinkedListItem = TJclIntfLinkedListItem;
TJclIntfLinkedListItem = class
{$ELSE}
PJclIntfLinkedListItem = ^TJclIntfLinkedListItem;
TJclIntfLinkedListItem = record
{$ENDIF CLR}
Obj: IInterface;
Next: PJclIntfLinkedListItem;
end;
{$IFDEF CLR}
TJclStrLinkedListItem = class;
PJclStrLinkedListItem = TJclStrLinkedListItem;
TJclStrLinkedListItem = class
{$ELSE}
PJclStrLinkedListItem = ^TJclStrLinkedListItem;
TJclStrLinkedListItem = record
{$ENDIF CLR}
Str: string;
Next: PJclStrLinkedListItem;
end;
{$IFDEF CLR}
TJclLinkedListItem = class;
PJclLinkedListItem = TJclLinkedListItem;
TJclLinkedListItem = class
{$ELSE}
PJclLinkedListItem = ^TJclLinkedListItem;
TJclLinkedListItem = record
{$ENDIF CLR}
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);
{$IFNDEF CLR}
destructor Destroy; override;
{$ENDIF ~CLR}
end;
constructor TIntfItr.Create(OwnList: TJclIntfLinkedList; Start: PJclIntfLinkedListItem);
begin
inherited Create;
FCursor := Start;
FOwnList := OwnList;
{$IFNDEF CLR}
FOwnList._AddRef; // Add a ref because FOwnList is not an interface !
{$ENDIF ~CLR}
FLastRet := nil;
FSize := FOwnList.Size;
end;
{$IFNDEF CLR}
destructor TIntfItr.Destroy;
begin
FOwnList._Release;
inherited Destroy;
end;
{$ENDIF ~CLR}
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;
{$IFDEF CLR}
NewItem := TJclIntfLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
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
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
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
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
end;
function TIntfItr.Previous: IInterface;
begin
// Unidirectional
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
end;
function TIntfItr.PreviousIndex: Integer;
begin
// No Index;
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
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;
{$IFDEF CLR}
Current.Free;
{$ELSE}
Dispose(Current);
{$ENDIF CLR}
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);
{$IFNDEF CLR}
destructor Destroy; override;
{$ENDIF ~CLR}
end;
constructor TStrItr.Create(OwnList: TJclStrLinkedList; Start: PJclStrLinkedListItem);
begin
inherited Create;
FCursor := Start;
FOwnList := OwnList;
{$IFNDEF CLR}
FOwnList._AddRef; // Add a ref because FOwnList is not an interface !
{$ENDIF ~CLR}
FLastRet := nil;
FSize := FOwnList.Size;
end;
{$IFNDEF CLR}
destructor TStrItr.Destroy;
begin
FOwnList._Release;
inherited Destroy;
end;
{$ENDIF ~CLR}
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;
{$IFDEF CLR}
NewItem := TJclStrLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
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
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
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
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
end;
function TStrItr.Previous: string;
begin
// Unidirectional
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
end;
function TStrItr.PreviousIndex: Integer;
begin
// No index
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
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 := '';
{$IFDEF CLR}
Current.Free;
{$ELSE}
Dispose(Current);
{$ENDIF CLR}
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);
{$IFNDEF CLR}
destructor Destroy; override;
{$ENDIF ~CLR}
end;
constructor TItr.Create(OwnList: TJclLinkedList; Start: PJclLinkedListItem);
begin
inherited Create;
FCursor := Start;
FOwnList := OwnList;
{$IFNDEF CLR}
FOwnList._AddRef; // Add a ref because FOwnList is not an interface !
{$ENDIF ~CLR}
FLastRet := nil;
FSize := FOwnList.Size;
end;
{$IFNDEF CLR}
destructor TItr.Destroy;
begin
FOwnList._Release;
inherited Destroy;
end;
{$ENDIF ~CLR}
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;
{$IFDEF CLR}
NewItem := TJclLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
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
// Unidirectional
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
end;
function TItr.Next: TObject;
{$IFDEF THREADSAFE}
var
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := FCursor.Obj;
FLastRet := FCursor;
FCursor := FCursor.Next;
end;
function TItr.NextIndex: Integer;
begin
// No Index
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
end;
function TItr.Previous: TObject;
begin
// Unidirectional
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
end;
function TItr.PreviousIndex: Integer;
begin
// No Index
{$IFDEF CLR}
raise EJclOperationNotSupportedError.Create(RsEOperationNotSupported);
{$ELSE}
raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
{$ENDIF CLR}
end;
procedure TItr.Remove;
var
Current: PJclLinkedListItem;
{$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;
if FOwnList.FOwnsObjects then
Current.Obj.Free;
Current.Obj := nil;
{$IFDEF CLR}
Current.Free;
{$ELSE}
Dispose(Current);
{$ENDIF CLR}
Dec(FOwnList.FSize);
Dec(FSize);
end;
procedure TItr.SetObject(AObject: TObject);
{$IFDEF THREADSAFE}
var
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
FCursor.Obj := AObject;
end;
//=== { TJclIntfLinkedList } =================================================
constructor TJclIntfLinkedList.Create(ACollection: IJclIntfCollection = nil);
var
It: IJclIntfIterator;
begin
inherited Create;
FStart := nil;
FEnd := nil;
FSize := 0;
if ACollection <> nil then
begin
It := ACollection.First;
while It.HasNext do
Add(It.Next);
end;
end;
destructor TJclIntfLinkedList.Destroy;
begin
Clear;
inherited Destroy;
end;
procedure TJclIntfLinkedList.Insert(Index: Integer; AInterface: IInterface);
var
I: Integer;
Current: PJclIntfLinkedListItem;
NewItem: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
if (Index < 0) or (Index > FSize) then
{$IFDEF CLR}
raise EJclOutOfBoundsError.Create(RsEOutOfBounds);
{$ELSE}
raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
{$ENDIF CLR}
if AInterface = nil then
Exit;
if FStart = nil then
begin
AddFirst(AInterface);
Exit;
end;
{$IFDEF CLR}
NewItem := TJclIntfLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
NewItem.Obj := AInterface;
if Index = 0 then
begin
NewItem.Next := FStart;
FStart := NewItem;
Inc(FSize);
end
else
begin
Current := FStart;
I := 0;
while (Current <> nil) and (I <> Index) do
Current := Current.Next;
NewItem.Next := Current.Next;
Current.Next := NewItem;
Inc(FSize);
end;
end;
function TJclIntfLinkedList.Add(AInterface: IInterface): Boolean;
var
NewItem: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if AInterface = nil then
Exit;
Result := True;
if FStart = nil then
begin
AddFirst(AInterface);
Exit;
end;
{$IFDEF CLR}
NewItem := TJclIntfLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
NewItem.Obj := AInterface;
NewItem.Next := nil;
FEnd.Next := NewItem;
FEnd := NewItem;
Inc(FSize);
end;
function TJclIntfLinkedList.AddAll(ACollection: IJclIntfCollection): Boolean;
var
It: IJclIntfIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if ACollection = nil then
Exit;
It := ACollection.First;
while It.HasNext do
Result := Add(It.Next) or Result;
end;
function TJclIntfLinkedList.InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean;
var
I: Integer;
It: IJclIntfIterator;
Current: PJclIntfLinkedListItem;
NewItem: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if (Index < 0) or (Index > FSize) then
{$IFDEF CLR}
raise EJclOutOfBoundsError.Create(RsEOutOfBounds);
{$ELSE}
raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
{$ENDIF CLR}
if ACollection = nil then
Exit;
It := ACollection.First;
// (rom) is this a bug? Only one element added.
if (FStart = nil) and It.HasNext then
begin
AddFirst(It.Next);
Exit;
end;
Current := FStart;
I := 0;
while (Current <> nil) and (I <> Index) do
Current := Current.Next;
while It.HasNext do
begin
{$IFDEF CLR}
NewItem := TJclIntfLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
NewItem.Obj := It.Next;
if Index = 0 then
begin
NewItem.Next := FStart;
FStart := NewItem;
Inc(FSize);
end
else
begin
NewItem.Next := Current.Next;
Current.Next := NewItem;
Inc(FSize);
end;
Inc(Index);
end;
Result := True;
end;
procedure TJclIntfLinkedList.AddFirst(AInterface: IInterface);
begin
{$IFDEF CLR}
FStart := TJclIntfLinkedListItem.Create;
{$ELSE}
New(FStart);
{$ENDIF CLR}
FStart.Obj := AInterface;
FStart.Next := nil;
FEnd := FStart;
Inc(FSize);
end;
procedure TJclIntfLinkedList.Clear;
var
I: Integer;
Old, Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Current := FStart;
for I := 0 to FSize - 1 do
begin
Current.Obj := nil;
//FreeObject(Current.Obj); //Daniele Teti 06 Maj 2005 // (outchy) wrong line
Old := Current;
Current := Current.Next;
{$IFDEF CLR}
Old.Free;
{$ELSE}
Dispose(Old);
{$ENDIF CLR}
end;
FSize := 0;
//Daniele Teti 27/12/2004
FStart := nil;
FEnd := nil;
end;
function TJclIntfLinkedList.Clone: IInterface;
var
NewList: IJclIntfList;
begin
NewList := TJclIntfLinkedList.Create;
NewList.AddAll(Self);
Result := NewList;
end;
function TJclIntfLinkedList.Contains(AInterface: IInterface): Boolean;
var
I: Integer;
Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if AInterface = nil then
Exit;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Obj = AInterface then
begin
Result := True;
Exit;
end;
Current := Current.Next;
end;
end;
function TJclIntfLinkedList.ContainsAll(ACollection: IJclIntfCollection): Boolean;
var
It: IJclIntfIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := True;
if ACollection = nil then
Exit;
It := ACollection.First;
while Result and It.HasNext do
Result := contains(It.Next);
end;
function TJclIntfLinkedList.Equals(ACollection: IJclIntfCollection): Boolean;
var
It, ItSelf: IJclIntfIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if ACollection = nil then
Exit;
if FSize <> ACollection.Size then
Exit;
It := ACollection.First;
ItSelf := First;
while ItSelf.HasNext do
if ItSelf.Next <> It.Next then
Exit;
Result := True;
end;
function TJclIntfLinkedList.GetObject(Index: Integer): IInterface;
var
I: Integer;
Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := nil;
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to Index - 1 do
Current := Current.Next;
Result := Current.Obj;
end;
function TJclIntfLinkedList.IndexOf(AInterface: IInterface): Integer;
var
I: Integer;
Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := -1;
if AInterface = nil then
Exit;
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Obj = AInterface then
begin
Result := I;
Break;
end;
Current := Current.Next;
end;
end;
function TJclIntfLinkedList.First: IJclIntfIterator;
begin
Result := TIntfItr.Create(Self, FStart);
end;
function TJclIntfLinkedList.IsEmpty: Boolean;
begin
Result := FSize = 0;
end;
function TJclIntfLinkedList.Last: IJclIntfIterator;
begin
Result := TIntfItr.Create(Self, FStart);
end;
function TJclIntfLinkedList.LastIndexOf(AInterface: IInterface): Integer;
var
I: Integer;
Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := -1;
if AInterface = nil then
Exit;
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Obj = AInterface then
Result := I;
Current := Current.Next;
end;
end;
function TJclIntfLinkedList.Remove(AInterface: IInterface): Boolean;
var
I: Integer;
Old, Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if AInterface = nil then
Exit;
if FStart = nil then
Exit;
Old := nil;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Obj = AInterface then
begin
Current.Obj := nil;
if Old <> nil then
begin
Old.Next := Current.Next;
if Old.Next = nil then
FEnd := Old;
end
else
FStart := Current.Next;
{$IFDEF CLR}
Current.Free;
{$ELSE}
Dispose(Current);
{$ENDIF CLR}
Dec(FSize);
Result := True;
Exit;
end;
Old := Current;
Current := Current.Next;
end;
end;
function TJclIntfLinkedList.Remove(Index: Integer): IInterface;
var
I: Integer;
Old, Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := nil;
if FStart = nil then
Exit;
Old := nil;
Current := FStart;
for I := 0 to Index - 1 do
begin
Old := Current;
Current := Current.Next;
end;
Current.Obj := nil;
if Old <> nil then
begin
Old.Next := Current.Next;
if Old.Next = nil then
FEnd := Old;
end
else
FStart := Current.Next;
{$IFDEF CLR}
Current.Free;
{$ELSE}
Dispose(Current);
{$ENDIF CLR}
Dec(FSize);
end;
function TJclIntfLinkedList.RemoveAll(ACollection: IJclIntfCollection): Boolean;
var
It: IJclIntfIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := True;
if ACollection = nil then
Exit;
It := ACollection.First;
while It.HasNext do
Result := Remove(It.Next) and Result;
end;
function TJclIntfLinkedList.RetainAll(ACollection: IJclIntfCollection): Boolean;
var
It: IJclIntfIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if ACollection = nil then
Exit;
It := First;
while It.HasNext do
if not ACollection.Contains(It.Next) then
It.Remove;
end;
procedure TJclIntfLinkedList.SetObject(Index: Integer; AInterface: IInterface);
var
I: Integer;
Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to Index - 1 do
Current := Current.Next;
Current.Obj := AInterface;
end;
function TJclIntfLinkedList.Size: Integer;
begin
Result := FSize;
end;
function TJclIntfLinkedList.SubList(First, Count: Integer): IJclIntfList;
var
I: Integer;
It: IJclIntfIterator;
Last: Integer;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Last := First + Count - 1;
if Last > FSize then
Last := FSize - 1;
Result := TJclIntfLinkedList.Create;
I := 0;
It := Self.First;
while (I < First) and It.HasNext do
begin
It.Next;
Inc(I);
end;
//I := 0;
while (I <= Last) and It.HasNext do
begin
Result.Add(It.Next);
Inc(I);
end;
end;
//=== { TJclStrLinkedList } ==================================================
constructor TJclStrLinkedList.Create(ACollection: IJclStrCollection = nil);
var
It: IJclStrIterator;
begin
inherited Create;
FStart := nil;
FEnd := nil;
FSize := 0;
if ACollection <> nil then
begin
It := ACollection.First;
while It.HasNext do
Add(It.Next);
end;
end;
destructor TJclStrLinkedList.Destroy;
begin
Clear;
inherited Destroy;
end;
procedure TJclStrLinkedList.Insert(Index: Integer; const AString: string);
var
I: Integer;
Current: PJclStrLinkedListItem;
NewItem: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
if (Index < 0) or (Index > FSize) then
{$IFDEF CLR}
raise EJclOutOfBoundsError.Create(RsEOutOfBounds);
{$ELSE}
raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
{$ENDIF CLR}
if AString = '' then
Exit;
if FStart = nil then
begin
AddFirst(AString);
Exit;
end;
{$IFDEF CLR}
NewItem := TJclStrLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
NewItem.Str := AString;
if Index = 0 then
begin
NewItem.Next := FStart;
FStart := NewItem;
Inc(FSize);
end
else
begin
Current := FStart;
I := 0;
while (Current <> nil) and (I <> Index) do
Current := Current.Next;
NewItem.Next := Current.Next;
Current.Next := NewItem;
Inc(FSize);
end;
end;
function TJclStrLinkedList.Add(const AString: string): Boolean;
var
NewItem: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if AString = '' then
Exit;
Result := True;
if FStart = nil then
begin
AddFirst(AString);
Exit;
end;
{$IFDEF CLR}
NewItem := TJclStrLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
NewItem.Str := AString;
NewItem.Next := nil;
FEnd.Next := NewItem;
FEnd := NewItem;
Inc(FSize);
end;
function TJclStrLinkedList.AddAll(ACollection: IJclStrCollection): Boolean;
var
It: IJclStrIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if ACollection = nil then
Exit;
It := ACollection.First;
while It.HasNext do
Result := Add(It.Next) or Result;
end;
function TJclStrLinkedList.InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean;
var
I: Integer;
It: IJclStrIterator;
Current: PJclStrLinkedListItem;
NewItem: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if ACollection = nil then
Exit;
if (Index < 0) or (Index >= FSize) then
{$IFDEF CLR}
raise EJclOutOfBoundsError.Create(RsEOutOfBounds);
{$ELSE}
raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
{$ENDIF CLR}
It := ACollection.First;
// (rom) is this a bug? Only one element added.
if (FStart = nil) and It.HasNext then
begin
AddFirst(It.Next);
//Exit; //Daniele Teti
end;
Current := FStart;
I := 0;
while (Current <> nil) and (I <> Index) do
begin
Current := Current.Next;
inc(I);
end;
while It.HasNext do
begin
{$IFDEF CLR}
NewItem := TJclStrLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
NewItem.Str := It.Next;
if Index = 0 then
begin
NewItem.Next := FStart;
FStart := NewItem;
Inc(FSize);
end
else
begin
NewItem.Next := Current.Next;
Current.Next := NewItem;
Inc(FSize);
end;
Inc(Index);
end;
Result := True;
end;
procedure TJclStrLinkedList.AddFirst(const AString: string);
begin
{$IFDEF CLR}
FStart := TJclStrLinkedListItem.Create;
{$ELSE}
New(FStart);
{$ENDIF CLR}
FStart.Str := AString;
FStart.Next := nil;
FEnd := FStart;
Inc(FSize);
end;
procedure TJclStrLinkedList.Clear;
var
I: Integer;
Old, Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Current := FStart;
for I := 0 to FSize - 1 do
begin
Current.Str := '';
Old := Current;
Current := Current.Next;
{$IFDEF CLR}
Old.Free;
{$ELSE}
Dispose(Old);
{$ENDIF CLR}
end;
FSize := 0;
//Daniele Teti 27/12/2004
FStart := nil;
FEnd := nil;
end;
function TJclStrLinkedList.Clone: TObject;
var
NewList: TJclStrLinkedList;
begin
NewList := TJclStrLinkedList.Create;
NewList.AddAll(Self);
Result := NewList;
end;
function TJclStrLinkedList.Contains(const AString: string): Boolean;
var
I: Integer;
Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if AString = '' then
Exit;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Str = AString then
begin
Result := True;
Exit;
end;
Current := Current.Next;
end;
end;
function TJclStrLinkedList.ContainsAll(ACollection: IJclStrCollection): Boolean;
var
It: IJclStrIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := True;
if ACollection = nil then
Exit;
It := ACollection.First;
while Result and It.HasNext do
Result := contains(It.Next);
end;
function TJclStrLinkedList.Equals(ACollection: IJclStrCollection): Boolean;
var
It, ItSelf: IJclStrIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if ACollection = nil then
Exit;
if FSize <> ACollection.Size then
Exit;
It := ACollection.First;
ItSelf := First;
while ItSelf.HasNext do
if ItSelf.Next <> It.Next then
Exit;
Result := True;
end;
function TJclStrLinkedList.First: IJclStrIterator;
begin
Result := TStrItr.Create(Self, FStart);
end;
function TJclStrLinkedList.GetString(Index: Integer): string;
var
I: Integer;
Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := '';
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to Index - 1 do
Current := Current.Next;
Result := Current.Str;
end;
function TJclStrLinkedList.IndexOf(const AString: string): Integer;
var
I: Integer;
Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := -1;
if AString = '' then
Exit;
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Str = AString then
begin
Result := I;
Break;
end;
Current := Current.Next;
end;
end;
function TJclStrLinkedList.IsEmpty: Boolean;
begin
Result := FSize = 0;
end;
function TJclStrLinkedList.Last: IJclStrIterator;
begin
Result := TStrItr.Create(Self, FStart);
end;
function TJclStrLinkedList.LastIndexOf(const AString: string): Integer;
var
I: Integer;
Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := -1;
if AString = '' then
Exit;
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Str = AString then
Result := I;
Current := Current.Next;
end;
end;
function TJclStrLinkedList.Remove(Index: Integer): string;
var
I: Integer;
Old, Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := '';
if FStart = nil then
Exit;
Old := nil;
Current := FStart;
for I := 0 to Index - 1 do
begin
Old := Current;
Current := Current.Next;
end;
Current.Str := '';
if Old <> nil then
begin
Old.Next := Current.Next;
if Old.Next = nil then
FEnd := Old;
end
else
FStart := Current.Next;
{$IFDEF CLR}
Current.Free;
{$ELSE}
Dispose(Current);
{$ENDIF CLR}
Dec(FSize);
end;
function TJclStrLinkedList.Remove(const AString: string): Boolean;
var
I: Integer;
Old, Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if AString = '' then
Exit;
if FStart = nil then
Exit;
Old := nil;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Str = AString then
begin
Current.Str := '';
if Old <> nil then
begin
Old.Next := Current.Next;
if Old.Next = nil then
FEnd := Old;
end
else
FStart := Current.Next;
{$IFDEF CLR}
Current.Free;
{$ELSE}
Dispose(Current);
{$ENDIF CLR}
Dec(FSize);
Result := True;
Exit;
end;
Old := Current;
Current := Current.Next;
end;
end;
function TJclStrLinkedList.RemoveAll(ACollection: IJclStrCollection): Boolean;
var
It: IJclStrIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := True;
if ACollection = nil then
Exit;
It := ACollection.First;
while It.HasNext do
Result := Remove(It.Next) and Result;
end;
function TJclStrLinkedList.RetainAll(ACollection: IJclStrCollection): Boolean;
var
It: IJclStrIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if ACollection = nil then
Exit;
It := First;
while It.HasNext do
if not ACollection.Contains(It.Next) then
It.Remove;
end;
procedure TJclStrLinkedList.SetString(Index: Integer; const AString: string);
var
I: Integer;
Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to Index - 1 do
Current := Current.Next;
Current.Str := AString;
end;
function TJclStrLinkedList.Size: Integer;
begin
Result := FSize;
end;
function TJclStrLinkedList.SubList(First, Count: Integer): IJclStrList;
var
I: Integer;
It: IJclStrIterator;
Last: Integer;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Last := First + Count - 1;
if Last > FSize then
Last := FSize - 1;
Result := TJclStrLinkedList.Create;
I := 0;
It := Self.First;
while (I < First) and It.HasNext do
begin
It.Next;
Inc(I);
end;
//I := 0;
while (I <= Last) and It.HasNext do
begin
Result.Add(It.Next);
Inc(I);
end;
end;
//=== { TJclLinkedList } =====================================================
constructor TJclLinkedList.Create(ACollection: IJclCollection = nil; AOwnsObjects: Boolean = True);
var
It: IJclIterator;
begin
inherited Create;
FStart := nil;
FEnd := nil;
FSize := 0;
FOwnsObjects := AOwnsObjects;
if ACollection <> nil then
begin
It := ACollection.First;
while It.HasNext do
Add(It.Next);
end;
end;
destructor TJclLinkedList.Destroy;
begin
Clear;
inherited Destroy;
end;
procedure TJclLinkedList.Insert(Index: Integer; AObject: TObject);
var
I: Integer;
Current: PJclLinkedListItem;
NewItem: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
if (Index < 0) or (Index > FSize) then
{$IFDEF CLR}
raise EJclOutOfBoundsError.Create(RsEOutOfBounds);
{$ELSE}
raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
{$ENDIF CLR}
if AObject = nil then
Exit;
if FStart = nil then
begin
AddFirst(AObject);
Exit;
end;
{$IFDEF CLR}
NewItem := TJclLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
NewItem.Obj := AObject;
if Index = 0 then
begin
NewItem.Next := FStart;
FStart := NewItem;
Inc(FSize);
end
else
begin
Current := FStart;
for I := 0 to Index - 2 do
Current := Current.Next;
NewItem.Next := Current.Next;
Current.Next := NewItem;
Inc(FSize);
end;
end;
function TJclLinkedList.Add(AObject: TObject): Boolean;
var
NewItem: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if AObject = nil then
Exit;
Result := True;
if FStart = nil then
begin
AddFirst(AObject);
Exit;
end;
{$IFDEF CLR}
NewItem := TJclLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
NewItem.Obj := AObject;
NewItem.Next := nil;
FEnd.Next := NewItem;
FEnd := NewItem;
Inc(FSize);
end;
function TJclLinkedList.AddAll(ACollection: IJclCollection): Boolean;
var
It: IJclIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if ACollection = nil then
Exit;
It := ACollection.First;
while It.HasNext do
Result := Add(It.Next) or Result;
Result := True;
end;
function TJclLinkedList.InsertAll(Index: Integer; ACollection: IJclCollection): Boolean;
var
I: Integer;
It: IJclIterator;
Current: PJclLinkedListItem;
NewItem: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if (Index < 0) or (Index > FSize) then
{$IFDEF CLR}
raise EJclOutOfBoundsError.Create(RsEOutOfBounds);
{$ELSE}
raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
{$ENDIF CLR}
if ACollection = nil then
Exit;
It := ACollection.First;
// (rom) is this a bug? Only one element added.
if (FStart = nil) and It.HasNext then
begin
AddFirst(It.Next);
Exit;
end;
Current := FStart;
I := 0;
while (Current <> nil) and (I <> Index) do
Current := Current.Next;
while It.HasNext do
begin
{$IFDEF CLR}
NewItem := TJclLinkedListItem.Create;
{$ELSE}
New(NewItem);
{$ENDIF CLR}
NewItem.Obj := It.Next;
if Index = 0 then
begin
NewItem.Next := FStart;
FStart := NewItem;
Inc(FSize);
end
else
begin
NewItem.Next := Current.Next;
Current.Next := NewItem;
Inc(FSize);
end;
Inc(Index);
end;
Result := True;
end;
procedure TJclLinkedList.AddFirst(AObject: TObject);
begin
{$IFDEF CLR}
FStart := TJclLinkedListItem.Create;
{$ELSE}
New(FStart);
{$ENDIF CLR}
FStart.Obj := AObject;
FStart.Next := nil;
FEnd := FStart;
Inc(FSize);
end;
procedure TJclLinkedList.Clear;
var
I: Integer;
Old, Current: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Current := FStart;
for I := 0 to FSize - 1 do
begin
FreeObject(Current.Obj); // (outchy) Fixed Memory Leak
//Current.Obj := nil;
Old := Current;
Current := Current.Next;
{$IFDEF CLR}
Old.Free;
{$ELSE}
Dispose(Old);
{$ENDIF CLR}
end;
FSize := 0;
//Daniele Teti 27/12/2004
FStart := nil;
FEnd := nil;
end;
function TJclLinkedList.Clone: TObject;
var
NewList: TJclLinkedList;
begin
NewList := TJclLinkedList.Create;
NewList.AddAll(Self);
Result := NewList;
end;
function TJclLinkedList.Contains(AObject: TObject): Boolean;
var
I: Integer;
Current: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if AObject = nil then
Exit;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Obj = AObject then
begin
Result := True;
Break;
end;
Current := Current.Next;
end;
end;
function TJclLinkedList.ContainsAll(ACollection: IJclCollection): Boolean;
var
It: IJclIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := True;
if ACollection = nil then
Exit;
It := ACollection.First;
while Result and It.HasNext do
Result := contains(It.Next);
end;
function TJclLinkedList.Equals(ACollection: IJclCollection): Boolean;
var
It, ItSelf: IJclIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if ACollection = nil then
Exit;
if FSize <> ACollection.Size then
Exit;
It := ACollection.First;
ItSelf := First;
while ItSelf.HasNext do
if ItSelf.Next <> It.Next then
Exit;
Result := True;
end;
procedure TJclLinkedList.FreeObject(var AObject: TObject);
begin
if FOwnsObjects then
FreeAndNil(AObject);
end;
function TJclLinkedList.GetObject(Index: Integer): TObject;
var
I: Integer;
Current: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := nil;
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to Index - 1 do
Current := Current.Next;
Result := Current.Obj;
end;
function TJclLinkedList.IndexOf(AObject: TObject): Integer;
var
I: Integer;
Current: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := -1;
if AObject = nil then
Exit;
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Obj = AObject then
begin
Result := I;
Break;
end;
Current := Current.Next;
end;
end;
function TJclLinkedList.First: IJclIterator;
begin
Result := TItr.Create(Self, FStart);
end;
function TJclLinkedList.IsEmpty: Boolean;
begin
Result := FSize = 0;
end;
function TJclLinkedList.Last: IJclIterator;
begin
Result := TItr.Create(Self, FStart);
end;
function TJclLinkedList.LastIndexOf(AObject: TObject): Integer;
var
I: Integer;
Current: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := -1;
if AObject = nil then
Exit;
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Obj = AObject then
Result := I;
Current := Current.Next;
end;
end;
function TJclLinkedList.Remove(AObject: TObject): Boolean;
var
I: Integer;
Old, Current: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if AObject = nil then
Exit;
if FStart = nil then
Exit;
Old := nil;
Current := FStart;
for I := 0 to FSize - 1 do
begin
if Current.Obj = AObject then
begin
FreeObject(Current.Obj);
if Old <> nil then
begin
Old.Next := Current.Next;
if Old.Next = nil then
FEnd := Old;
end
else
FStart := Current.Next;
{$IFDEF CLR}
Current.Free;
{$ELSE}
Dispose(Current);
{$ENDIF CLR}
Dec(FSize);
Result := True;
Exit;
end;
Old := Current;
Current := Current.Next;
end;
end;
function TJclLinkedList.Remove(Index: Integer): TObject;
var
I: Integer;
Old, Current: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := nil;
if FStart = nil then
Exit;
Old := nil;
Current := FStart;
for I := 0 to Index - 1 do
begin
Old := Current;
Current := Current.Next;
end;
FreeObject(Current.Obj);
if Old <> nil then
begin
Old.Next := Current.Next;
if Old.Next = nil then
FEnd := Old;
end
else
FStart := Current.Next;
{$IFDEF CLR}
Current.Free;
{$ELSE}
Dispose(Current);
{$ENDIF CLR}
Dec(FSize);
end;
function TJclLinkedList.RemoveAll(ACollection: IJclCollection): Boolean;
var
It: IJclIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := True;
if ACollection = nil then
Exit;
It := ACollection.First;
while It.HasNext do
Result := Remove(It.Next) and Result;
end;
function TJclLinkedList.RetainAll(ACollection: IJclCollection): Boolean;
var
It: IJclIterator;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Result := False;
if ACollection = nil then
Exit;
It := First;
while It.HasNext do
if not ACollection.Contains(It.Next) then
It.Remove;
end;
procedure TJclLinkedList.SetObject(Index: Integer; AObject: TObject);
var
I: Integer;
Current: PJclLinkedListItem;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
if FStart = nil then
Exit;
Current := FStart;
for I := 0 to Index - 1 do
Current := Current.Next;
Current.Obj := AObject;
end;
function TJclLinkedList.Size: Integer;
begin
Result := FSize;
end;
function TJclLinkedList.SubList(First, Count: Integer): IJclList;
var
I: Integer;
It: IJclIterator;
Last: Integer;
{$IFDEF THREADSAFE}
CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
Last := First + Count - 1;
if Last > FSize then
Last := FSize - 1;
Result := TJclLinkedList.Create;
I := 0;
It := Self.First;
while (I < First) and It.HasNext do
begin
It.Next;
Inc(I);
end;
while (I <= Last) and It.HasNext do
begin
Result.Add(It.Next);
Inc(I);
end;
end;
{
function TJclStrLinkedList.GetAsStrings: TStrings;
begin
Result := TStringList.Create;
try
AppendToStrings(Result);
except
Result.Free;
raise;
end;
end;
procedure TJclStrLinkedList.LoadFromStrings(Strings: TStrings);
begin
Clear;
AppendFromStrings(Strings);
end;
procedure TJclStrLinkedList.AppendToStrings(Strings: TStrings);
var
It: IJclStrIterator;
begin
It := First;
Strings.BeginUpdate;
try
while It.HasNext do
Strings.Add(It.Next);
finally
Strings.EndUpdate;
end;
end;
procedure TJclStrLinkedList.SaveToStrings(Strings: TStrings);
begin
Strings.Clear;
AppendToStrings(Strings);
end;
procedure TJclStrLinkedList.AppendFromStrings(Strings: TStrings);
var
I: Integer;
begin
for I := 0 to Strings.Count - 1 do
Add(Strings[I]);
end;
function TJclStrLinkedList.GetAsDelimited(Separator: string): string;
var
It: IJclStrIterator;
begin
It := First;
Result := '';
if It.HasNext then
Result := It.Next;
while It.HasNext do
Result := Result + Separator + It.Next;
end;
procedure TJclStrLinkedList.AppendDelimited(AString, Separator: string);
begin
DCLAppendDelimited(Self, AString, Separator);
end;
procedure TJclStrLinkedList.LoadDelimited(AString, Separator: string);
begin
Clear;
AppendDelimited(AString, Separator);
end;
}
// History:
// $Log: JclLinkedLists.pas,v $
// Revision 1.11 2005/05/07 14:33:48 outchy
// Now compile OK, corrected TJclLinkedList.Clear, TJclIntfLinkedList.Clear and TJclLinkedList.FreeObject
//
// Revision 1.10 2005/05/06 14:24:36 dade2004
// Fixed a memory leak in TJclLinkedList.Create
//
// Changed
// Current.Obj := nil;
// in
// FreeObject(Current.Obj);
//
// Revision 1.9 2005/05/05 20:08:43 ahuser
// JCL.NET support
//
// Revision 1.8 2005/03/08 15:14:00 dade2004
// Fixed some bug on
// IJclStrList.InsertAll implementation
//
// Revision 1.7 2005/03/08 08:33:16 marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.6 2005/03/03 08:02:57 marquardt
// various style cleanings, bugfixes and improvements
//
// Revision 1.5 2005/03/02 17:51:24 rrossmair
// - removed DCLAppendDelimited from JclAlgorithms, changed uses clauses accordingly
//
// Revision 1.4 2005/03/02 09:59:30 dade2004
// Added
// -TJclStrCollection in JclContainerIntf
// Every common methods for IJclStrCollection are implemented here
//
// -Every class that implement IJclStrCollection now derive from TJclStrCollection instead of TJclAbstractContainer
// -Every abstract method in TJclStrCollection has been marked as "override" in descendent classes
//
// DCLAppendDelimited has been removed from JclAlgorothms, his body has been fixed for a bug and put into
// relative method in TJclStrCollection
//
// Revision 1.3 2005/02/27 07:27:47 marquardt
// changed interface names from I to IJcl, moved resourcestrings to JclResource.pas
//
// Revision 1.2 2005/02/24 07:36:24 marquardt
// resolved the compiler warnings, style cleanup, removed code from JclContainerIntf.pas
//
// Revision 1.1 2005/02/24 03:57:10 rrossmair
// - donated DCL code, initial check-in
//
end.