aboutsummaryrefslogtreecommitdiffstats
path: root/src/lib/collections
diff options
context:
space:
mode:
Diffstat (limited to 'src/lib/collections')
-rw-r--r--src/lib/collections/CollArray.pas183
-rw-r--r--src/lib/collections/CollHash.pas1497
-rw-r--r--src/lib/collections/CollLibrary.pas131
-rw-r--r--src/lib/collections/CollList.pas270
-rw-r--r--src/lib/collections/CollPArray.pas689
-rw-r--r--src/lib/collections/CollWrappers.pas876
-rw-r--r--src/lib/collections/Collections.pas5318
7 files changed, 0 insertions, 8964 deletions
diff --git a/src/lib/collections/CollArray.pas b/src/lib/collections/CollArray.pas
deleted file mode 100644
index a10ba905..00000000
--- a/src/lib/collections/CollArray.pas
+++ /dev/null
@@ -1,183 +0,0 @@
-unit CollArray;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * This library is free software; you can redistribute it and/or modify it
- * under the terms of the GNU Lesser General Public License as published by the
- * Free Software Foundation; either version 2.1 of the License, or (at your
- * option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but WITHOUT
- * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
- * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
- * details. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.2 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollArray.qbt $
- *
- * Colllection implementations based on arrays.
- *
- * Revision 1.2 by: Matthew Greet Rev date: 12/06/04 20:02:16
- * Capacity property.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:30:36
- * Size property dropped.
- * Unused abstract functions still implemented.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- Collections;
-
-type
- TArray = class(TAbstractList)
- private
- FArray: array of ICollectable;
- protected
- function TrueGetItem(Index: Integer): ICollectable; override;
- procedure TrueSetItem(Index: Integer; const Value: ICollectable); override;
- procedure TrueAppend(const Item: ICollectable); override;
- procedure TrueClear; override;
- function TrueDelete(Index: Integer): ICollectable; override;
- procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean = false); override;
- constructor Create(Size: Integer; NaturalItemsOnly: Boolean = false); overload; virtual;
- constructor Create(const Collection: ICollection); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetFixedSize: Boolean; override;
- function GetSize: Integer; override;
- end;
-
-implementation
-
-constructor TArray.Create(NaturalItemsOnly: Boolean);
-begin
- Create(0, NaturalItemsOnly);
-end;
-
-constructor TArray.Create(Size: Integer; NaturalItemsOnly: Boolean = false);
-begin
- inherited Create(NaturalItemsOnly);
- SetLength(FArray, Size);
-end;
-
-constructor TArray.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-var
- Item: ICollectable;
- ItemError: TCollectionError;
- I: Integer;
-begin
- inherited Create(ItemArray, NaturalItemsOnly);
- SetLength(FArray, Length(ItemArray));
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else
- Items[I] := Item;
- end;
-end;
-
-constructor TArray.Create(const Collection: ICollection);
-var
- Iterator: IIterator;
- I: Integer;
-begin
- inherited Create(Collection);
- SetLength(FArray, Collection.GetSize);
- Iterator := Collection.GetIterator;
- I := 0;
- while not Iterator.EOF do
- begin
- Items[I] := Iterator.CurrentItem;
- Inc(I);
- Iterator.Next;
- end;
-end;
-
-destructor TArray.Destroy;
-var
- I: Integer;
-begin
- // Delete interface references to all items
- for I := Low(FArray) to High(FArray) do
- begin
- FArray[I] := nil;
- end;
- inherited Destroy;
-end;
-
-function TArray.TrueGetItem(Index: Integer): ICollectable;
-begin
- Result := FArray[Index];
-end;
-
-procedure TArray.TrueSetItem(Index: Integer; const Value: ICollectable);
-begin
- FArray[Index] := Value;
-end;
-
-procedure TArray.TrueAppend(const Item: ICollectable);
-begin
- // Ignored as collection is fixed size
-end;
-
-procedure TArray.TrueClear;
-begin
- // Ignored as collection is fixed size
-end;
-
-function TArray.TrueDelete(Index: Integer): ICollectable;
-begin
- // Ignored as collection is fixed size
-end;
-
-procedure TArray.TrueInsert(Index: Integer; const Item: ICollectable);
-begin
- // Ignored as collection is fixed size
-end;
-
-function TArray.GetCapacity: Integer;
-begin
- Result := Size;
-end;
-
-procedure TArray.SetCapacity(Value: Integer);
-begin
- // Ignored
-end;
-
-function TArray.GetFixedSize: Boolean;
-begin
- Result := true;
-end;
-
-function TArray.GetSize: Integer;
-begin
- Result := Length(FArray);
-end;
-
-end.
diff --git a/src/lib/collections/CollHash.pas b/src/lib/collections/CollHash.pas
deleted file mode 100644
index 796fc740..00000000
--- a/src/lib/collections/CollHash.pas
+++ /dev/null
@@ -1,1497 +0,0 @@
-unit CollHash;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * This library is free software; you can redistribute it and/or modify it
- * under the terms of the GNU Lesser General Public License as published by the
- * Free Software Foundation; either version 2.1 of the License, or (at your
- * option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but WITHOUT
- * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
- * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
- * details. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.1.1.2 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollHash.qbt $
- *
- * Collection implementations based on hash tables.
- *
- * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:04:30
- * Capacity property.
- *
- * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
- * v1.0 branch.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:40:16
- * Added integer map and string map versions.
- * THashSet uses its own implementation, not THashMap.
- * DefaulMaxLoadFactor changed.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- Classes, Math,
- Collections;
-
-const
- DefaultTableSize = 100;
- MaxLoadFactorMin = 0.01; // Minimum allowed value for MaxLoadFactor property.
- DefaultMaxLoadFactor = 5.0;
-
-type
- THashMap = class(TAbstractMap)
- private
- FArray: TListArray;
- FCapacity: Integer;
- FMaxLoadFactor: Double;
- FSize: Integer;
- FTableSize: Integer;
- protected
- function GetAssociationIterator: IMapIterator; override;
- procedure SetMaxLoadFactor(Value: Double); virtual;
- procedure SetTableSize(Value: Integer); virtual;
- procedure ChangeCapacity(Value: TListArray); virtual;
- procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
- function GetHash(const Key: ICollectable): Integer; virtual;
- function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
- procedure Rehash;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): IAssociation; override;
- function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
- function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
- public
- constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
- destructor Destroy; override;
- class function GetAlwaysNaturalKeys: Boolean; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetNaturalKeyIID: TGUID; override;
- function GetSize: Integer; override;
- property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
- property TableSize: Integer read FTableSize write SetTableSize;
- end;
-
- THashSet = class(TAbstractSet)
- private
- FArray: TListArray;
- FCapacity: Integer;
- FMaxLoadFactor: Double;
- FSize: Integer;
- FTableSize: Integer;
- protected
- procedure SetMaxLoadFactor(Value: Double); virtual;
- procedure SetTableSize(Value: Integer); virtual;
- procedure ChangeCapacity(Value: TListArray); virtual;
- procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
- function GetHash(const Item: ICollectable): Integer; virtual;
- function GetPosition(const Item: ICollectable): TCollectionPosition; override;
- procedure Rehash;
- procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): ICollectable; override;
- procedure TrueRemove2(Position: TCollectionPosition); override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- destructor Destroy; override;
- class function GetAlwaysNaturalItems: Boolean; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetIterator: IIterator; override;
- function GetNaturalItemIID: TGUID; override;
- function GetSize: Integer; override;
- property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
- property TableSize: Integer read FTableSize write SetTableSize;
- end;
-
- THashIntegerMap = class(TAbstractIntegerMap)
- private
- FArray: TListArray;
- FCapacity: Integer;
- FMaxLoadFactor: Double;
- FSize: Integer;
- FTableSize: Integer;
- protected
- function GetAssociationIterator: IIntegerMapIterator; override;
- procedure SetMaxLoadFactor(Value: Double); virtual;
- procedure SetTableSize(Value: Integer); virtual;
- procedure ChangeCapacity(Value: TListArray); virtual;
- procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
- function GetHash(const Key: Integer): Integer; virtual;
- function GetKeyPosition(const Key: Integer): TCollectionPosition; override;
- procedure Rehash;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): IIntegerAssociation; override;
- function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; override;
- function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; override;
- public
- constructor Create; override;
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetSize: Integer; override;
- property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
- property TableSize: Integer read FTableSize write SetTableSize;
- end;
-
- THashStringMap = class(TAbstractStringMap)
- private
- FArray: TListArray;
- FCapacity: Integer;
- FMaxLoadFactor: Double;
- FSize: Integer;
- FTableSize: Integer;
- protected
- function GetAssociationIterator: IStringMapIterator; override;
- procedure SetMaxLoadFactor(Value: Double); virtual;
- procedure SetTableSize(Value: Integer); virtual;
- procedure ChangeCapacity(Value: TListArray); virtual;
- procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
- function GetHash(const Key: String): Integer; virtual;
- function GetKeyPosition(const Key: String): TCollectionPosition; override;
- procedure Rehash;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): IStringAssociation; override;
- function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; override;
- function TrueRemove2(Position: TCollectionPosition): IStringAssociation; override;
- public
- constructor Create; override;
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetSize: Integer; override;
- property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
- property TableSize: Integer read FTableSize write SetTableSize;
- end;
-
-implementation
-
-const
- (* (sqrt(5) - 1)/2
- See Introduction to Algorithms in Pascal, 1995, by Thomas W. Parsons,
- published by John Wiley & Sons, Inc, ISBN 0-471-11600-9
- *)
- HashFactor = 0.618033988749894848204586834365638;
-
-type
- THashIterator = class(TAbstractIterator)
- private
- FHashSet: THashSet;
- FHash: Integer;
- FChainIndex: Integer;
- protected
- constructor Create(HashSet: THashSet);
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- end;
-
- THashAssociationIterator = class(TAbstractAssociationIterator)
- private
- FHashMap: THashMap;
- FHash: Integer;
- FChainIndex: Integer;
- protected
- constructor Create(HashMap: THashMap);
- function TrueFirst: IAssociation; override;
- function TrueNext: IAssociation; override;
- procedure TrueRemove; override;
- end;
-
- THashIntegerIterator = class(TAbstractIntegerAssociationIterator)
- private
- FHashIntegerMap: THashIntegerMap;
- FHash: Integer;
- FChainIndex: Integer;
- protected
- constructor Create(HashIntegerMap: THashIntegerMap);
- function TrueFirst: IIntegerAssociation; override;
- function TrueNext: IIntegerAssociation; override;
- procedure TrueRemove; override;
- end;
-
- THashStringIterator = class(TAbstractStringAssociationIterator)
- private
- FHashStringMap: THashStringMap;
- FHash: Integer;
- FChainIndex: Integer;
- protected
- constructor Create(HashStringMap: THashStringMap);
- function TrueFirst: IStringAssociation; override;
- function TrueNext: IStringAssociation; override;
- procedure TrueRemove; override;
- end;
-
- THashPosition = class(TCollectionPosition)
- private
- FChain: TList;
- FIndex: Integer;
- public
- constructor Create(Found: Boolean; Chain: TList; Index: Integer);
- property Chain: TList read FChain;
- property Index: Integer read FIndex;
- end;
-
-{ THashMap }
-constructor THashMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-var
- I: Integer;
-begin
- // Force use of natural keys
- inherited Create(NaturalItemsOnly, true);
- FTableSize := DefaultTableSize;
- FMaxLoadFactor := DefaultMaxLoadFactor;
- SetLength(FArray, FTableSize);
- for I := Low(FArray) to High(FArray) do
- FArray[I] := TList.Create;
- FCapacity := 0;
- FSize := 0;
- ChangeCapacity(FArray);
-end;
-
-destructor THashMap.Destroy;
-var
- I: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- FArray[I].Free;
- FArray := nil;
- inherited Destroy;
-end;
-
-class function THashMap.GetAlwaysNaturalKeys: Boolean;
-begin
- Result := true;
-end;
-
-function THashMap.GetNaturalKeyIID: TGUID;
-begin
- Result := HashableIID;
-end;
-
-function THashMap.GetAssociationIterator: IMapIterator;
-begin
- Result := THashAssociationIterator.Create(Self);
-end;
-
-procedure THashMap.SetTableSize(Value: Integer);
-begin
- if (FTableSize <> Value) and (Value >= 1) then
- begin
- FTableSize := Value;
- Rehash;
- end;
-end;
-
-procedure THashMap.SetMaxLoadFactor(Value: Double);
-begin
- if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
- begin
- FMaxLoadFactor := Value;
- CheckLoadFactor(false);
- end;
-end;
-
-procedure THashMap.ChangeCapacity(Value: TListArray);
-var
- Chain: TList;
- I, Total, ChainCapacity: Integer;
-begin
- if FCapacity mod FTableSize = 0 then
- ChainCapacity := Trunc(FCapacity / FTableSize)
- else
- ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
- Total := 0;
- for I := Low(Value) to High(Value) do
- begin
- Chain := Value[I];
- Chain.Capacity := ChainCapacity;
- Total := Total + Chain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
-var
- LoadFactor: Double;
-begin
- LoadFactor := Capacity / TableSize;
- if LoadFactor > MaxLoadFactor then
- TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
- else if AlwaysChangeCapacity then
- ChangeCapacity(FArray);
-end;
-
-function THashMap.GetHash(const Key: ICollectable): Integer;
-var
- Hashable: IHashable;
- HashCode: Cardinal;
-begin
- Key.QueryInterface(IHashable, Hashable);
- HashCode := Hashable.HashCode;
- Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
-end;
-
-function THashMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
-var
- Chain: TList;
- I: Integer;
- Success: Boolean;
-begin
- Chain := FArray[GetHash(Key)];
- Success := false;
- for I := 0 to Chain.Count - 1 do
- begin
- Success := KeyComparator.Equals(Key, IAssociation(Chain[I]).GetKey);
- if Success then
- Break;
- end;
- Result := THashPosition.Create(Success, Chain, I);
-end;
-
-procedure THashMap.Rehash;
-var
- NewArray: TListArray;
- OldChain, NewChain: TList;
- Association: IAssociation;
- Total: Integer;
- I, J: Integer;
- Hash: Integer;
-begin
- // Create new chains
- SetLength(NewArray, TableSize);
- for I := Low(NewArray) to High(NewArray) do
- begin
- NewChain := TList.Create;
- NewArray[I] := NewChain;
- end;
- ChangeCapacity(NewArray);
-
- // Transfer from old chains to new and drop old
- for I := Low(FArray) to High(FArray) do
- begin
- OldChain := FArray[I];
- for J := 0 to OldChain.Count - 1 do
- begin
- Association := IAssociation(OldChain[J]);
- Hash := GetHash(Association.GetKey);
- NewArray[Hash].Add(Pointer(Association));
- end;
- OldChain.Free;
- end;
- FArray := NewArray;
-
- // Find actual, new capacity
- Total := 0;
- for I := Low(FArray) to High(FArray) do
- begin
- NewChain := FArray[I];
- Total := Total + NewChain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashMap.TrueClear;
-var
- Association: IAssociation;
- Chain: TList;
- I, J: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- begin
- Chain := FArray[I];
- for J := 0 to Chain.Count - 1 do
- begin
- Association := IAssociation(Chain[J]);
- Chain[J] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
- end;
- Chain.Clear;
- end;
- FSize := 0;
-end;
-
-function THashMap.TrueGet(Position: TCollectionPosition): IAssociation;
-var
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Result := IAssociation(HashPosition.Chain.Items[HashPosition.Index]);
-end;
-
-function THashMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
-var
- HashPosition: THashPosition;
- OldAssociation: IAssociation;
-begin
- HashPosition := THashPosition(Position);
- if HashPosition.Found then
- begin
- OldAssociation := IAssociation(HashPosition.Chain.Items[HashPosition.Index]);
- HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
- Result := OldAssociation;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- OldAssociation._Release;
- end
- else
- begin
- HashPosition.Chain.Add(Pointer(Association));
- Inc(FSize);
- Result := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- end;
-end;
-
-function THashMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
-var
- Association: IAssociation;
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Association := IAssociation(TrueGet(Position));
- HashPosition.Chain.Delete(HashPosition.Index);
- Dec(FSize);
- Result := Association;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-function THashMap.GetCapacity;
-begin
- Result := FCapacity;
-end;
-
-procedure THashMap.SetCapacity(Value: Integer);
-begin
- FCapacity := Value;
- CheckLoadFactor(true);
-end;
-
-function THashMap.GetSize: Integer;
-begin
- Result := FSize;
-end;
-
-{ THashSet }
-constructor THashSet.Create(NaturalItemsOnly: Boolean);
-var
- I: Integer;
-begin
- // Force use of natural items
- inherited Create(true);
- FTableSize := DefaultTableSize;
- FMaxLoadFactor := DefaultMaxLoadFactor;
- SetLength(FArray, FTableSize);
- for I := Low(FArray) to High(FArray) do
- FArray[I] := TList.Create;
- FSize := 0;
-end;
-
-destructor THashSet.Destroy;
-var
- I: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- FArray[I].Free;
- FArray := nil;
- inherited Destroy;
-end;
-
-procedure THashSet.SetTableSize(Value: Integer);
-begin
- if (FTableSize <> Value) and (Value >= 1) then
- begin
- FTableSize := Value;
- Rehash;
- end;
-end;
-
-procedure THashSet.SetMaxLoadFactor(Value: Double);
-begin
- if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
- begin
- FMaxLoadFactor := Value;
- CheckLoadFactor(false);
- end;
-end;
-
-procedure THashSet.ChangeCapacity(Value: TListArray);
-var
- Chain: TList;
- I, Total, ChainCapacity: Integer;
-begin
- if FCapacity mod FTableSize = 0 then
- ChainCapacity := Trunc(FCapacity / FTableSize)
- else
- ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
- Total := 0;
- for I := Low(Value) to High(Value) do
- begin
- Chain := Value[I];
- Chain.Capacity := ChainCapacity;
- Total := Total + Chain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashSet.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
-var
- LoadFactor: Double;
-begin
- LoadFactor := Capacity / TableSize;
- if LoadFactor > MaxLoadFactor then
- TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
- else if AlwaysChangeCapacity then
- ChangeCapacity(FArray);
-end;
-
-function THashSet.GetHash(const Item: ICollectable): Integer;
-var
- Hashable: IHashable;
- HashCode: Cardinal;
-begin
- Item.QueryInterface(IHashable, Hashable);
- HashCode := Hashable.HashCode;
- Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
-end;
-
-function THashSet.GetPosition(const Item: ICollectable): TCollectionPosition;
-var
- Chain: TList;
- I: Integer;
- Success: Boolean;
-begin
- Chain := FArray[GetHash(Item)];
- Success := false;
- for I := 0 to Chain.Count - 1 do
- begin
- Success := Comparator.Equals(Item, ICollectable(Chain[I]));
- if Success then
- Break;
- end;
- Result := THashPosition.Create(Success, Chain, I);
-end;
-
-procedure THashSet.Rehash;
-var
- NewArray: TListArray;
- OldChain, NewChain: TList;
- Item: ICollectable;
- Total: Integer;
- I, J: Integer;
- Hash: Integer;
-begin
- // Create new chains
- SetLength(NewArray, TableSize);
- for I := Low(NewArray) to High(NewArray) do
- begin
- NewChain := TList.Create;
- NewArray[I] := NewChain;
- end;
- ChangeCapacity(NewArray);
-
- // Transfer from old chains to new and drop old
- for I := Low(FArray) to High(FArray) do
- begin
- OldChain := FArray[I];
- for J := 0 to OldChain.Count - 1 do
- begin
- Item := ICollectable(OldChain[J]);
- Hash := GetHash(Item);
- NewArray[Hash].Add(Pointer(Item));
- end;
- OldChain.Free;
- end;
- FArray := NewArray;
-
- // Find actual, new capacity
- Total := 0;
- for I := Low(FArray) to High(FArray) do
- begin
- NewChain := FArray[I];
- Total := Total + NewChain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
-var
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- HashPosition.Chain.Add(Pointer(Item));
- Inc(FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._AddRef;
-end;
-
-procedure THashSet.TrueClear;
-var
- Item: ICollectable;
- Chain: TList;
- I, J: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- begin
- Chain := FArray[I];
- for J := 0 to Chain.Count - 1 do
- begin
- Item := ICollectable(Chain[J]);
- Chain[J] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
- end;
- Chain.Clear;
- end;
- FSize := 0;
-end;
-
-function THashSet.TrueGet(Position: TCollectionPosition): ICollectable;
-var
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Result := ICollectable(HashPosition.Chain.Items[HashPosition.Index]);
-end;
-
-procedure THashSet.TrueRemove2(Position: TCollectionPosition);
-var
- Item: ICollectable;
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Item := TrueGet(Position);
- HashPosition.Chain.Delete(HashPosition.Index);
- Dec(FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
-end;
-
-class function THashSet.GetAlwaysNaturalItems: Boolean;
-begin
- Result := true;
-end;
-
-function THashSet.GetIterator: IIterator;
-begin
- Result := THashIterator.Create(Self);
-end;
-
-function THashSet.GetNaturalItemIID: TGUID;
-begin
- Result := HashableIID;
-end;
-
-function THashSet.GetCapacity;
-begin
- Result := FCapacity;
-end;
-
-procedure THashSet.SetCapacity(Value: Integer);
-begin
- FCapacity := Value;
- CheckLoadFactor(true);
-end;
-
-function THashSet.GetSize: Integer;
-begin
- Result := FSize;
-end;
-
-{ THashIntegerMap }
-constructor THashIntegerMap.Create;
-begin
- Create(false, DefaultTableSize, DefaultMaxLoadFactor);
-end;
-
-constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean);
-begin
- Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor);
-end;
-
-constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor);
-var
- I: Integer;
-begin
- inherited Create(NaturalItemsOnly);
- SetLength(FArray, TableSize);
- for I := Low(FArray) to High(FArray) do
- FArray[I] := TList.Create;
- FTableSize := TableSize;
- FMaxLoadFactor := MaxLoadFactor;
- FSize := 0;
-end;
-
-destructor THashIntegerMap.Destroy;
-var
- I: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- FArray[I].Free;
- FArray := nil;
- inherited Destroy;
-end;
-
-function THashIntegerMap.GetAssociationIterator: IIntegerMapIterator;
-begin
- Result := THashIntegerIterator.Create(Self);
-end;
-
-procedure THashIntegerMap.SetTableSize(Value: Integer);
-begin
- if (FTableSize <> Value) and (Value >= 1) then
- begin
- FTableSize := Value;
- Rehash;
- end;
-end;
-
-procedure THashIntegerMap.SetMaxLoadFactor(Value: Double);
-begin
- if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
- begin
- FMaxLoadFactor := Value;
- CheckLoadFactor(false);
- end;
-end;
-
-procedure THashIntegerMap.ChangeCapacity;
-var
- Chain: TList;
- I, Total, ChainCapacity: Integer;
-begin
- if FCapacity mod FTableSize = 0 then
- ChainCapacity := Trunc(FCapacity / FTableSize)
- else
- ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
- Total := 0;
- for I := Low(Value) to High(Value) do
- begin
- Chain := Value[I];
- Chain.Capacity := ChainCapacity;
- Total := Total + Chain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashIntegerMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
-var
- LoadFactor: Double;
-begin
- LoadFactor := Capacity / TableSize;
- if LoadFactor > MaxLoadFactor then
- TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
- else if AlwaysChangeCapacity then
- ChangeCapacity(FArray);
-end;
-
-function THashIntegerMap.GetHash(const Key: Integer): Integer;
-begin
- Result := Trunc(Frac(Cardinal(Key) * HashFactor) * TableSize);
-end;
-
-function THashIntegerMap.GetKeyPosition(const Key: Integer): TCollectionPosition;
-var
- Chain: TList;
- I: Integer;
- Success: Boolean;
-begin
- Chain := FArray[GetHash(Key)];
- Success := false;
- for I := 0 to Chain.Count - 1 do
- begin
- Success := (Key = IIntegerAssociation(Chain[I]).GetKey);
- if Success then
- Break;
- end;
- Result := THashPosition.Create(Success, Chain, I);
-end;
-
-procedure THashIntegerMap.Rehash;
-var
- NewArray: TListArray;
- OldChain, NewChain: TList;
- Association: IIntegerAssociation;
- Total: Integer;
- I, J: Integer;
- Hash: Integer;
-begin
- // Create new chains
- SetLength(NewArray, TableSize);
- for I := Low(NewArray) to High(NewArray) do
- begin
- NewChain := TList.Create;
- NewArray[I] := NewChain;
- end;
- ChangeCapacity(NewArray);
-
- // Transfer from old chains to new and drop old
- for I := Low(FArray) to High(FArray) do
- begin
- OldChain := FArray[I];
- for J := 0 to OldChain.Count - 1 do
- begin
- Association := IIntegerAssociation(OldChain[J]);
- Hash := GetHash(Association.GetKey);
- NewArray[Hash].Add(Pointer(Association));
- end;
- OldChain.Free;
- end;
- FArray := NewArray;
-
- // Find actual, new capacity
- Total := 0;
- for I := Low(FArray) to High(FArray) do
- begin
- NewChain := FArray[I];
- Total := Total + NewChain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashIntegerMap.TrueClear;
-var
- Association: IIntegerAssociation;
- Chain: TList;
- I, J: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- begin
- Chain := FArray[I];
- for J := 0 to Chain.Count - 1 do
- begin
- Association := IIntegerAssociation(Chain[J]);
- Chain[J] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
- end;
- Chain.Clear;
- end;
- FSize := 0;
-end;
-
-function THashIntegerMap.TrueGet(Position: TCollectionPosition): IIntegerAssociation;
-var
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Result := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]);
-end;
-
-function THashIntegerMap.TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation;
-var
- HashPosition: THashPosition;
- OldAssociation: IIntegerAssociation;
-begin
- HashPosition := THashPosition(Position);
- if HashPosition.Found then
- begin
- OldAssociation := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]);
- HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
- Result := OldAssociation;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- OldAssociation._Release;
- end
- else
- begin
- HashPosition.Chain.Add(Pointer(Association));
- Inc(FSize);
- Result := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- end;
-end;
-
-function THashIntegerMap.TrueRemove2(Position: TCollectionPosition): IIntegerAssociation;
-var
- Association: IIntegerAssociation;
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Association := IIntegerAssociation(TrueGet(Position));
- HashPosition.Chain.Delete(HashPosition.Index);
- Dec(FSize);
- Result := Association;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-function THashIntegerMap.GetCapacity;
-begin
- Result := FCapacity;
-end;
-
-procedure THashIntegerMap.SetCapacity(Value: Integer);
-begin
- FCapacity := Value;
- CheckLoadFactor(true);
-end;
-
-function THashIntegerMap.GetSize: Integer;
-begin
- Result := FSize;
-end;
-
-{ THashStringMap }
-constructor THashStringMap.Create;
-begin
- Create(false, DefaultTableSize, DefaultMaxLoadFactor);
-end;
-
-constructor THashStringMap.Create(NaturalItemsOnly: Boolean);
-begin
- Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor);
-end;
-
-constructor THashStringMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor);
-var
- I: Integer;
-begin
- inherited Create(NaturalItemsOnly);
- SetLength(FArray, TableSize);
- for I := Low(FArray) to High(FArray) do
- FArray[I] := TList.Create;
- FTableSize := TableSize;
- FMaxLoadFactor := MaxLoadFactor;
- FSize := 0;
-end;
-
-destructor THashStringMap.Destroy;
-var
- I: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- FArray[I].Free;
- FArray := nil;
- inherited Destroy;
-end;
-
-function THashStringMap.GetAssociationIterator: IStringMapIterator;
-begin
- Result := THashStringIterator.Create(Self);
-end;
-
-procedure THashStringMap.SetTableSize(Value: Integer);
-begin
- if (FTableSize <> Value) and (Value >= 1) then
- begin
- FTableSize := Value;
- Rehash;
- end;
-end;
-
-procedure THashStringMap.SetMaxLoadFactor(Value: Double);
-begin
- if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
- begin
- FMaxLoadFactor := Value;
- CheckLoadFactor(false);
- end;
-end;
-
-procedure THashStringMap.ChangeCapacity;
-var
- Chain: TList;
- I, Total, ChainCapacity: Integer;
-begin
- if FCapacity mod FTableSize = 0 then
- ChainCapacity := Trunc(FCapacity / FTableSize)
- else
- ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
- Total := 0;
- for I := Low(Value) to High(Value) do
- begin
- Chain := Value[I];
- Chain.Capacity := ChainCapacity;
- Total := Total + Chain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashStringMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
-var
- LoadFactor: Double;
-begin
- LoadFactor := Capacity / TableSize;
- if LoadFactor > MaxLoadFactor then
- TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
- else if AlwaysChangeCapacity then
- ChangeCapacity(FArray);
-end;
-
-function THashStringMap.GetHash(const Key: String): Integer;
-var
- HashCode: Cardinal;
- I: Integer;
-begin
- HashCode := 0;
- for I := 1 to Length(Key) do
- HashCode := (HashCode shl 1) xor Ord(Key[I]);
- Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
-end;
-
-function THashStringMap.GetKeyPosition(const Key: String): TCollectionPosition;
-var
- Chain: TList;
- I: Integer;
- Success: Boolean;
-begin
- Chain := FArray[GetHash(Key)];
- Success := false;
- for I := 0 to Chain.Count - 1 do
- begin
- Success := (Key = IStringAssociation(Chain[I]).GetKey);
- if Success then
- Break;
- end;
- Result := THashPosition.Create(Success, Chain, I);
-end;
-
-procedure THashStringMap.Rehash;
-var
- NewArray: TListArray;
- OldChain, NewChain: TList;
- Association: IStringAssociation;
- Total: Integer;
- I, J: Integer;
- Hash: Integer;
-begin
- // Create new chains
- SetLength(NewArray, TableSize);
- for I := Low(NewArray) to High(NewArray) do
- begin
- NewChain := TList.Create;
- NewArray[I] := NewChain;
- end;
- ChangeCapacity(NewArray);
-
- // Transfer from old chains to new and drop old
- for I := Low(FArray) to High(FArray) do
- begin
- OldChain := FArray[I];
- for J := 0 to OldChain.Count - 1 do
- begin
- Association := IStringAssociation(OldChain[J]);
- Hash := GetHash(Association.GetKey);
- NewArray[Hash].Add(Pointer(Association));
- end;
- OldChain.Free;
- end;
- FArray := NewArray;
-
- // Find actual, new capacity
- Total := 0;
- for I := Low(FArray) to High(FArray) do
- begin
- NewChain := FArray[I];
- Total := Total + NewChain.Capacity;
- end;
- FCapacity := Total;
-end;
-
-procedure THashStringMap.TrueClear;
-var
- Association: IStringAssociation;
- Chain: TList;
- I, J: Integer;
-begin
- for I := Low(FArray) to High(FArray) do
- begin
- Chain := FArray[I];
- for J := 0 to Chain.Count - 1 do
- begin
- Association := IStringAssociation(Chain[J]);
- Chain[J] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
- end;
- Chain.Clear;
- end;
- FSize := 0;
-end;
-
-function THashStringMap.TrueGet(Position: TCollectionPosition): IStringAssociation;
-var
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Result := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]);
-end;
-
-function THashStringMap.TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation;
-var
- HashPosition: THashPosition;
- OldAssociation: IStringAssociation;
-begin
- HashPosition := THashPosition(Position);
- if HashPosition.Found then
- begin
- OldAssociation := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]);
- HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
- Result := OldAssociation;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- OldAssociation._Release;
- end
- else
- begin
- HashPosition.Chain.Add(Pointer(Association));
- Inc(FSize);
- Result := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- end;
-end;
-
-function THashStringMap.TrueRemove2(Position: TCollectionPosition): IStringAssociation;
-var
- Association: IStringAssociation;
- HashPosition: THashPosition;
-begin
- HashPosition := THashPosition(Position);
- Association := IStringAssociation(TrueGet(Position));
- HashPosition.Chain.Delete(HashPosition.Index);
- Dec(FSize);
- Result := Association;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-function THashStringMap.GetCapacity;
-begin
- Result := FCapacity;
-end;
-
-procedure THashStringMap.SetCapacity(Value: Integer);
-begin
- FCapacity := Value;
- CheckLoadFactor(true);
-end;
-
-function THashStringMap.GetSize: Integer;
-begin
- Result := FSize;
-end;
-
-{ THashPosition }
-constructor THashPosition.Create(Found: Boolean; Chain: TList; Index: Integer);
-begin
- inherited Create(Found);
- FChain := Chain;
- FIndex := Index;
-end;
-
-{ THashIterator }
-constructor THashIterator.Create(HashSet: THashSet);
-begin
- inherited Create(true);
- FHashSet := HashSet;
- First;
-end;
-
-function THashIterator.TrueFirst: ICollectable;
-var
- Chain: TList;
- Success: Boolean;
-begin
- FHash := 0;
- FChainIndex := 0;
- Success := false;
- while FHash < FHashSet.TableSize do
- begin
- Chain := FHashSet.FArray[FHash];
- Success := Chain.Count > 0;
- if Success then
- Break;
- Inc(FHash);
- end;
- if Success then
- Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-function THashIterator.TrueNext: ICollectable;
-var
- Chain: TList;
- Success: Boolean;
-begin
- Success := false;
- Chain := FHashSet.FArray[FHash];
- repeat
- Inc(FChainIndex);
- if FChainIndex >= Chain.Count then
- begin
- Inc(FHash);
- FChainIndex := -1;
- if FHash < FHashSet.TableSize then
- Chain := FHashSet.FArray[FHash];
- end
- else
- Success := true;
- until Success or (FHash >= FHashSet.TableSize);
- if Success then
- Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-procedure THashIterator.TrueRemove;
-var
- Item: ICollectable;
-begin
- Item := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex]);
- FHashSet.FArray[FHash].Delete(FChainIndex);
- Dec(FChainIndex);
- Dec(FHashSet.FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
-end;
-
-
-{ THashAssociationIterator }
-constructor THashAssociationIterator.Create(HashMap: THashMap);
-begin
- inherited Create(true);
- FHashMap := HashMap;
- First;
-end;
-
-function THashAssociationIterator.TrueFirst: IAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- FHash := 0;
- FChainIndex := 0;
- Success := false;
- while FHash < FHashMap.TableSize do
- begin
- Chain := FHashMap.FArray[FHash];
- Success := Chain.Count > 0;
- if Success then
- Break;
- Inc(FHash);
- end;
- if Success then
- Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-function THashAssociationIterator.TrueNext: IAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- Success := false;
- Chain := FHashMap.FArray[FHash];
- repeat
- Inc(FChainIndex);
- if FChainIndex >= Chain.Count then
- begin
- Inc(FHash);
- FChainIndex := -1;
- if FHash < FHashMap.TableSize then
- Chain := FHashMap.FArray[FHash];
- end
- else
- Success := true;
- until Success or (FHash >= FHashMap.TableSize);
- if Success then
- Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-procedure THashAssociationIterator.TrueRemove;
-var
- Association: IAssociation;
-begin
- Association := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex]);
- FHashMap.FArray[FHash].Delete(FChainIndex);
- Dec(FChainIndex);
- Dec(FHashMap.FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-
-{ THashIntegerIterator }
-constructor THashIntegerIterator.Create(HashIntegerMap: THashIntegerMap);
-begin
- inherited Create(true);
- FHashIntegerMap := HashIntegerMap;
- First;
-end;
-
-function THashIntegerIterator.TrueFirst: IIntegerAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- FHash := 0;
- FChainIndex := 0;
- Success := false;
- while FHash < FHashIntegerMap.TableSize do
- begin
- Chain := FHashIntegerMap.FArray[FHash];
- Success := Chain.Count > 0;
- if Success then
- Break;
- Inc(FHash);
- end;
- if Success then
- Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-function THashIntegerIterator.TrueNext: IIntegerAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- Success := false;
- Chain := FHashIntegerMap.FArray[FHash];
- repeat
- Inc(FChainIndex);
- if FChainIndex >= Chain.Count then
- begin
- Inc(FHash);
- FChainIndex := -1;
- if FHash < FHashIntegerMap.TableSize then
- Chain := FHashIntegerMap.FArray[FHash];
- end
- else
- Success := true;
- until Success or (FHash >= FHashIntegerMap.TableSize);
- if Success then
- Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-procedure THashIntegerIterator.TrueRemove;
-var
- Association: IIntegerAssociation;
-begin
- Association := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex]);
- FHashIntegerMap.FArray[FHash].Delete(FChainIndex);
- Dec(FChainIndex);
- Dec(FHashIntegerMap.FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-{ THashStringIterator }
-constructor THashStringIterator.Create(HashStringMap: THashStringMap);
-begin
- inherited Create(true);
- FHashStringMap := HashStringMap;
- First;
-end;
-
-function THashStringIterator.TrueFirst: IStringAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- FHash := 0;
- FChainIndex := 0;
- Success := false;
- while FHash < FHashStringMap.TableSize do
- begin
- Chain := FHashStringMap.FArray[FHash];
- Success := Chain.Count > 0;
- if Success then
- Break;
- Inc(FHash);
- end;
- if Success then
- Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-function THashStringIterator.TrueNext: IStringAssociation;
-var
- Chain: TList;
- Success: Boolean;
-begin
- Success := false;
- Chain := FHashStringMap.FArray[FHash];
- repeat
- Inc(FChainIndex);
- if FChainIndex >= Chain.Count then
- begin
- Inc(FHash);
- FChainIndex := -1;
- if FHash < FHashStringMap.TableSize then
- Chain := FHashStringMap.FArray[FHash];
- end
- else
- Success := true;
- until Success or (FHash >= FHashStringMap.TableSize);
- if Success then
- Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex])
- else
- Result := nil;
-end;
-
-procedure THashStringIterator.TrueRemove;
-var
- Association: IStringAssociation;
-begin
- Association := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex]);
- FHashStringMap.FArray[FHash].Delete(FChainIndex);
- Dec(FChainIndex);
- Dec(FHashStringMap.FSize);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-
-end.
diff --git a/src/lib/collections/CollLibrary.pas b/src/lib/collections/CollLibrary.pas
deleted file mode 100644
index b7e3d268..00000000
--- a/src/lib/collections/CollLibrary.pas
+++ /dev/null
@@ -1,131 +0,0 @@
-unit CollLibrary;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * This library is free software; you can redistribute it and/or modify it
- * under the terms of the GNU Lesser General Public License as published by the
- * Free Software Foundation; either version 2.1 of the License, or (at your
- * option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but WITHOUT
- * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
- * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
- * details. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.0.1.1 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollLibrary.qbt $
- *
- * Initial version.
- *
- * Revision 1.0.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
- * v1.0 branch.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 06/04/03 10:40:32
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- Collections, CollArray, CollHash, CollList, CollPArray, CollWrappers;
-
-type
- TMiscCollectionLibrary = class
- public
- class function ClassNameToClassType(ClassName: String): TAbstractCollectionClass;
- class function EqualIID(const IID1, IID2: TGUID): Boolean;
- class function HashCode(Value: String): Integer;
- class procedure ShuffleArray(var ItemArray: array of ICollectable);
- class procedure ShuffleList(const List: IList);
- end;
-
-implementation
-
-{ TMiscCollectionLibrary }
-class function TMiscCollectionLibrary.ClassNameToClassType(ClassName: String): TAbstractCollectionClass;
-begin
- if ClassName = 'TArray' then
- Result := TArray
- else if ClassName = 'THashSet' then
- Result := THashSet
- else if ClassName = 'THashMap' then
- Result := THashMap
- else if ClassName = 'THashIntegerMap' then
- Result := THashIntegerMap
- else if ClassName = 'THashStringMap' then
- Result := THashStringMap
- else if ClassName = 'TListSet' then
- Result := TListSet
- else if ClassName = 'TListMap' then
- Result := TListMap
- else if ClassName = 'TPArrayBag' then
- Result := TPArrayBag
- else if ClassName = 'TPArraySet' then
- Result := TPArraySet
- else if ClassName = 'TPArrayList' then
- Result := TPArrayList
- else if ClassName = 'TPArrayMap' then
- Result := TPArrayMap
- else
- Result := nil;
-end;
-
-class function TMiscCollectionLibrary.EqualIID(const IID1, IID2: TGUID): Boolean;
-begin
- Result := (IID1.D1 = IID2.D1) and (IID1.D2 = IID2.D2) and (IID1.D3 = IID2.D3) and
- (IID1.D4[0] = IID2.D4[0]) and (IID1.D4[1] = IID2.D4[1]) and
- (IID1.D4[2] = IID2.D4[2]) and (IID1.D4[3] = IID2.D4[3]) and
- (IID1.D4[4] = IID2.D4[4]) and (IID1.D4[5] = IID2.D4[5]) and
- (IID1.D4[6] = IID2.D4[6]) and (IID1.D4[7] = IID2.D4[7]);
-end;
-
-class function TMiscCollectionLibrary.HashCode(Value: String): Integer;
-var
- I: Integer;
-begin
- Result := 0;
- for I := 1 to Length(Value) do
- Result := (Result shl 1) xor Ord(Value[I]);
-end;
-
-class procedure TMiscCollectionLibrary.ShuffleArray(var ItemArray: array of ICollectable);
-var
- Item: ICollectable;
- ArraySize, I, Index: Integer;
-begin
- Randomize;
- ArraySize := Length(ItemArray);
- for I := 0 to ArraySize - 1 do
- begin
- Index := (I + Random(ArraySize - 1) + 1) mod ArraySize;
- Item := ItemArray[I];
- ItemArray[I] := ItemArray[Index];
- ItemArray[Index] := Item;
- end;
-end;
-
-class procedure TMiscCollectionLibrary.ShuffleList(const List: IList);
-var
- ListSize, I: Integer;
-begin
- Randomize;
- ListSize := List.GetSize;
- for I := 0 to ListSize - 1 do
- begin
- List.Exchange(I, (I + Random(ListSize - 1) + 1) mod ListSize);
- end;
-end;
-
-
-end.
diff --git a/src/lib/collections/CollList.pas b/src/lib/collections/CollList.pas
deleted file mode 100644
index 68aa0d66..00000000
--- a/src/lib/collections/CollList.pas
+++ /dev/null
@@ -1,270 +0,0 @@
-unit CollList;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * This library is free software; you can redistribute it and/or modify it
- * under the terms of the GNU Lesser General Public License as published by the
- * Free Software Foundation; either version 2.1 of the License, or (at your
- * option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but WITHOUT
- * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
- * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
- * details. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.1.1.2 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollList.qbt $
- *
- * Collection implementations based on sorted TPArrayList instances.
- *
- * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:05:54
- * Capacity property.
- *
- * Revision 1.1.1.1 by: Matthew Greet Rev date: 14/02/04 17:45:38
- * v1.0 branch.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:41:52
- * Uses TExposedPArrayList to improve performance.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-uses
- Collections, CollPArray;
-
-type
- TListSet = class(TAbstractSet)
- private
- FList: TExposedPArrayList;
- protected
- function GetPosition(const Item: ICollectable): TCollectionPosition; override;
- procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): ICollectable; override;
- procedure TrueRemove2(Position: TCollectionPosition); override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetIterator: IIterator; override;
- function GetNaturalItemIID: TGUID; override;
- function GetSize: Integer; override;
- end;
-
- TListMap = class(TAbstractMap)
- private
- FList: TExposedPArrayList;
- protected
- function GetAssociationIterator: IMapIterator; override;
- function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): IAssociation; override;
- function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
- function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
- public
- constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- procedure SetKeyComparator(const Value: IComparator); override;
- function GetNaturalKeyIID: TGUID; override;
- function GetSize: Integer; override;
- end;
-
-implementation
-
-type
- TListPosition = class(TCollectionPosition)
- private
- FSearchResult: TSearchResult;
- public
- constructor Create(Found: Boolean; SearchResult: TSearchResult);
- property SearchResult: TSearchResult read FSearchResult;
- end;
-
-constructor TListSet.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FList := TExposedPArrayList.Create(NaturalItemsOnly);
- FList.Comparator := Comparator;
- FList.Sort;
-end;
-
-destructor TListSet.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TListSet.GetPosition(const Item: ICollectable): TCollectionPosition;
-var
- SearchResult: TSearchResult;
-begin
- SearchResult := FList.Search(Item);
- Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult);
-end;
-
-procedure TListSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
-var
- SearchResult: TSearchResult;
- Index: Integer;
-begin
- SearchResult := TListPosition(Position).SearchResult;
- Index := SearchResult.Index;
- if SearchResult.ResultType = srBeforeIndex then
- FList.TrueInsert(Index, Item)
- else
- FList.TrueAppend(Item);
-end;
-
-procedure TListSet.TrueClear;
-begin
- FList.Clear;
-end;
-
-function TListSet.TrueGet(Position: TCollectionPosition): ICollectable;
-begin
- Result := FList.Items[TListPosition(Position).SearchResult.Index];
-end;
-
-procedure TListSet.TrueRemove2(Position: TCollectionPosition);
-begin
- FList.Delete(TListPosition(Position).SearchResult.Index);
-end;
-
-function TListSet.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TListSet.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TListSet.GetIterator: IIterator;
-begin
- Result := FList.GetIterator;
-end;
-
-function TListSet.GetNaturalItemIID: TGUID;
-begin
- Result := ComparableIID;
-end;
-
-function TListSet.GetSize: Integer;
-begin
- Result := FList.Size;
-end;
-
-constructor TListMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly, NaturalKeysOnly);
- FList := TExposedPArrayList.Create(false);
- FList.Comparator := AssociationComparator;
- FList.Sort;
-end;
-
-destructor TListMap.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TListMap.GetAssociationIterator: IMapIterator;
-begin
- Result := TAssociationIterator.Create(FList.GetIterator);
-end;
-
-function TListMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
-var
- Association: IAssociation;
- SearchResult: TSearchResult;
-begin
- Association := TAssociation.Create(Key, nil);
- SearchResult := FList.Search(Association);
- Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult);
-end;
-
-procedure TListMap.TrueClear;
-begin
- FList.Clear;
-end;
-
-function TListMap.TrueGet(Position: TCollectionPosition): IAssociation;
-begin
- Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation;
-end;
-
-function TListMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
-var
- SearchResult: TSearchResult;
- Index: Integer;
-begin
- SearchResult := TListPosition(Position).SearchResult;
- Index := SearchResult.Index;
- if SearchResult.ResultType = srFoundAtIndex then
- begin
- Result := (FList.Items[Index]) as IAssociation;
- FList.Items[Index] := Association;
- end
- else if SearchResult.ResultType = srBeforeIndex then
- FList.TrueInsert(Index, Association)
- else
- FList.TrueAppend(Association);
-end;
-
-function TListMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
-begin
- Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation;
- FList.Delete(TListPosition(Position).SearchResult.Index);
-end;
-
-procedure TListMap.SetKeyComparator(const Value: IComparator);
-begin
- inherited SetKeyComparator(Value);
- FList.Sort;
-end;
-
-function TListMap.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TListMap.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TListMap.GetNaturalKeyIID: TGUID;
-begin
- Result := ComparableIID;
-end;
-
-function TListMap.GetSize: Integer;
-begin
- Result := FList.Size;
-end;
-
-constructor TListPosition.Create(Found: Boolean; SearchResult: TSearchResult);
-begin
- inherited Create(Found);
- FSearchResult := SearchResult;
-end;
-
-end.
diff --git a/src/lib/collections/CollPArray.pas b/src/lib/collections/CollPArray.pas
deleted file mode 100644
index 5ebd534b..00000000
--- a/src/lib/collections/CollPArray.pas
+++ /dev/null
@@ -1,689 +0,0 @@
-unit CollPArray;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * This library is free software; you can redistribute it and/or modify it
- * under the terms of the GNU Lesser General Public License as published by the
- * Free Software Foundation; either version 2.1 of the License, or (at your
- * option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but WITHOUT
- * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
- * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
- * details. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.2.1.2 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollPArray.qbt $
- *
- * Collection implementations based on TList.
- *
- * Revision 1.2.1.2 by: Matthew Greet Rev date: 12/06/04 20:08:30
- * Capacity property.
- *
- * Revision 1.2.1.1 by: Matthew Greet Rev date: 14/02/04 17:46:10
- * v1.0 branch.
- *
- * Revision 1.2 by: Matthew Greet Rev date: 28/04/03 15:07:14
- * Correctly handles nil items.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:43:16
- * Added TPArrayMap and TExposedPArrayList.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- Classes,
- Collections;
-
-type
- TPArrayBag = class(TAbstractBag)
- private
- FList: TList;
- protected
- function TrueAdd(const Item: ICollectable): Boolean; override;
- procedure TrueClear; override;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetIterator: IIterator; override;
- function GetSize: Integer; override;
- function TrueContains(const Item: ICollectable): Boolean; override;
- end;
-
- TPArraySet = class(TAbstractSet)
- private
- FList: TList;
- protected
- function GetPosition(const Item: ICollectable): TCollectionPosition; override;
- procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): ICollectable; override;
- procedure TrueRemove2(Position: TCollectionPosition); override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetIterator: IIterator; override;
- function GetSize: Integer; override;
- end;
-
- TPArrayList = class(TAbstractList)
- private
- FList: TList;
- protected
- function TrueGetItem(Index: Integer): ICollectable; override;
- procedure TrueSetItem(Index: Integer; const Item: ICollectable); override;
- procedure TrueAppend(const Item: ICollectable); override;
- procedure TrueClear; override;
- function TrueDelete(Index: Integer): ICollectable; override;
- procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetIterator: IIterator; override;
- function GetSize: Integer; override;
- end;
-
- TPArrayMap = class(TAbstractMap)
- private
- FList: TList;
- protected
- function GetAssociationIterator: IMapIterator; override;
- function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
- procedure TrueClear; override;
- function TrueGet(Position: TCollectionPosition): IAssociation; override;
- function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
- function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
- public
- constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
- destructor Destroy; override;
- function GetCapacity: Integer; override;
- procedure SetCapacity(Value: Integer); override;
- function GetSize: Integer; override;
- end;
-
- // Same as TPArrayList but raises method visibilities so items can be manually
- // appended or inserted without resetting sort flag.
- TExposedPArrayList = class(TPArrayList)
- public
- procedure TrueAppend(const Item: ICollectable); override;
- procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
- end;
-
-
-implementation
-
-type
- TPArrayIterator = class(TAbstractIterator)
- private
- FList: TList;
- FIndex: Integer;
- protected
- constructor Create(List: TList; AllowRemove: Boolean);
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- end;
-
- TPArrayAssociationIterator = class(TAbstractAssociationIterator)
- private
- FList: TList;
- FIndex: Integer;
- protected
- constructor Create(List: TList; AllowRemove: Boolean);
- function TrueFirst: IAssociation; override;
- function TrueNext: IAssociation; override;
- procedure TrueRemove; override;
- end;
-
- TPArrayPosition = class(TCollectionPosition)
- private
- FIndex: Integer;
- public
- constructor Create(Found: Boolean; Index: Integer);
- property Index: Integer read FIndex;
- end;
-
-constructor TPArrayBag.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FList := TList.Create;
-end;
-
-destructor TPArrayBag.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TPArrayBag.TrueAdd(const Item: ICollectable): Boolean;
-begin
- FList.Add(Pointer(Item));
- Result := true;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._AddRef;
-end;
-
-procedure TPArrayBag.TrueClear;
-var
- Item: ICollectable;
- I: Integer;
-begin
- // Delete all interface references
- for I := 0 to FList.Count - 1 do
- begin
- Item := ICollectable(FList[I]);
- FList[I] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._Release;
- end;
- FList.Clear;
-end;
-
-function TPArrayBag.TrueContains(const Item: ICollectable): Boolean;
-var
- I: Integer;
- Success: Boolean;
-begin
- // Sequential search
- I := 0;
- Success := false;
- while (I < FList.Count) and not Success do
- begin
- Success := Comparator.Equals(Item, ICollectable(FList[I]));
- Inc(I);
- end;
- Result := Success;
-end;
-
-function TPArrayBag.TrueRemove(const Item: ICollectable): ICollectable;
-var
- Item2: ICollectable;
- I: Integer;
- Found: Boolean;
-begin
- // Sequential search
- I := 0;
- Found := false;
- Result := nil;
- while (I < FList.Count) and not Found do
- begin
- Item2 := ICollectable(FList[I]);
- if Comparator.Equals(Item, Item2) then
- begin
- Found := true;
- Result := Item2;
- FList.Delete(I);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item2 <> nil then
- Item2._Release;
- end
- else
- Inc(I);
- end;
-end;
-
-function TPArrayBag.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: TPArrayBag;
- Item2: ICollectable;
- I: Integer;
-begin
- // Sequential search
- I := 0;
- ResultCollection := TPArrayBag.Create;
- while I < FList.Count do
- begin
- Item2 := ICollectable(FList[I]);
- if Comparator.Equals(Item, Item2) then
- begin
- ResultCollection.Add(Item2);
- FList.Delete(I);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._Release;
- end
- else
- Inc(I);
- end;
- Result := ResultCollection;
-end;
-
-function TPArrayBag.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TPArrayBag.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TPArrayBag.GetIterator: IIterator;
-begin
- Result := TPArrayIterator.Create(FList, true);
-end;
-
-function TPArrayBag.GetSize: Integer;
-begin
- Result := FList.Count;
-end;
-
-constructor TPArraySet.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FList := TList.Create;
-end;
-
-destructor TPArraySet.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TPArraySet.GetPosition(const Item: ICollectable): TCollectionPosition;
-var
- I: Integer;
- Success: Boolean;
-begin
- // Sequential search
- I := 0;
- Success := false;
- while (I < FList.Count) do
- begin
- Success := Comparator.Equals(Item, ICollectable(FList[I]));
- if Success then
- break;
- Inc(I);
- end;
- Result := TPArrayPosition.Create(Success, I);
-end;
-
-procedure TPArraySet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
-begin
- FList.Add(Pointer(Item));
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._AddRef;
-end;
-
-procedure TPArraySet.TrueClear;
-var
- Item: ICollectable;
- I: Integer;
-begin
- // Delete all interface references
- for I := 0 to FList.Count - 1 do
- begin
- Item := ICollectable(FList[I]);
- FList[I] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
- end;
- FList.Clear;
-end;
-
-function TPArraySet.TrueGet(Position: TCollectionPosition): ICollectable;
-begin
- Result := ICollectable(FList.Items[TPArrayPosition(Position).Index]);
-end;
-
-procedure TPArraySet.TrueRemove2(Position: TCollectionPosition);
-var
- Item: ICollectable;
-begin
- Item := ICollectable(FList[TPArrayPosition(Position).Index]);
- FList.Delete(TPArrayPosition(Position).Index);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
-end;
-
-function TPArraySet.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TPArraySet.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TPArraySet.GetIterator: IIterator;
-begin
- Result := TPArrayIterator.Create(FList, true);
-end;
-
-function TPArraySet.GetSize: Integer;
-begin
- Result := FList.Count;
-end;
-
-constructor TPArrayList.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FList := TList.Create;
-end;
-
-destructor TPArrayList.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TPArrayList.TrueGetItem(Index: Integer): ICollectable;
-begin
- Result := ICollectable(FList.Items[Index]);
-end;
-
-procedure TPArrayList.TrueSetItem(Index: Integer; const Item: ICollectable);
-var
- OldItem: ICollectable;
-begin
- OldItem := ICollectable(FList[Index]);
- FList[Index] := Pointer(Item);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._AddRef;
- if OldItem <> nil then
- OldItem._Release;
-end;
-
-procedure TPArrayList.TrueAppend(const Item: ICollectable);
-begin
- FList.Add(Pointer(Item));
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._AddRef;
-end;
-
-procedure TPArrayList.TrueClear;
-var
- Item: ICollectable;
- I: Integer;
-begin
- // Delete all interface references
- for I := 0 to FList.Count - 1 do
- begin
- Item := ICollectable(FList[I]);
- FList[I] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._Release;
- end;
- FList.Clear;
-end;
-
-function TPArrayList.TrueDelete(Index: Integer): ICollectable;
-begin
- Result := ICollectable(FList[Index]);
- FList.Delete(Index);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Result <> nil then
- Result._Release;
-end;
-
-procedure TPArrayList.TrueInsert(Index: Integer; const Item: ICollectable);
-begin
- FList.Insert(Index, Pointer(Item));
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- if Item <> nil then
- Item._AddRef;
-end;
-
-function TPArrayList.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TPArrayList.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TPArrayList.GetIterator: IIterator;
-begin
- Result := TPArrayIterator.Create(FList, true);
-end;
-
-function TPArrayList.GetSize: Integer;
-begin
- Result := FList.Count;
-end;
-
-constructor TPArrayMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly, NaturalKeysOnly);
- FList := TList.Create;
-end;
-
-destructor TPArrayMap.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-
-function TPArrayMap.GetAssociationIterator: IMapIterator;
-begin
- Result := TPArrayAssociationIterator.Create(FList, true);
-end;
-
-function TPArrayMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
-var
- I: Integer;
- Success: Boolean;
-begin
- // Sequential search
- I := 0;
- Success := false;
- while (I < FList.Count) do
- begin
- Success := KeyComparator.Equals(Key, IAssociation(FList[I]).GetKey);
- if Success then
- break;
- Inc(I);
- end;
- Result := TPArrayPosition.Create(Success, I);
-end;
-
-procedure TPArrayMap.TrueClear;
-var
- Association: IAssociation;
- I: Integer;
-begin
- // Delete all interface references
- for I := 0 to FList.Count - 1 do
- begin
- Association := IAssociation(FList[I]);
- FList[I] := nil;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
- end;
- FList.Clear;
-end;
-
-function TPArrayMap.TrueGet(Position: TCollectionPosition): IAssociation;
-begin
- Result := IAssociation(FList.Items[TPArrayPosition(Position).Index]);
-end;
-
-function TPArrayMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
-var
- OldAssociation: IAssociation;
- Index: Integer;
-begin
- if Position.Found then
- begin
- Index := (Position as TPArrayPosition).Index;
- OldAssociation := IAssociation(FList[Index]);
- FList[Index] := Pointer(Association);
- end
- else
- begin
- OldAssociation := nil;
- FList.Add(Pointer(Association));
- end;
- Result := OldAssociation;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._AddRef;
- if OldAssociation <> nil then
- OldAssociation._Release;
-end;
-
-function TPArrayMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
-var
- OldAssociation: IAssociation;
-begin
- OldAssociation := IAssociation(FList[TPArrayPosition(Position).Index]);
- FList.Delete(TPArrayPosition(Position).Index);
- Result := OldAssociation;
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- OldAssociation._Release;
-end;
-
-function TPArrayMap.GetCapacity: Integer;
-begin
- Result := FList.Capacity;
-end;
-
-procedure TPArrayMap.SetCapacity(Value: Integer);
-begin
- FList.Capacity := Value;
-end;
-
-function TPArrayMap.GetSize: Integer;
-begin
- Result := FList.Count;
-end;
-
-procedure TExposedPArrayList.TrueAppend(const Item: ICollectable);
-begin
- inherited TrueAppend(Item);
-end;
-
-procedure TExposedPArrayList.TrueInsert(Index: Integer; const Item: ICollectable);
-begin
- inherited TrueInsert(Index, Item);
-end;
-
-{ TPArrayIterator }
-constructor TPArrayIterator.Create(List: TList; AllowRemove: Boolean);
-begin
- inherited Create(AllowRemove);
- FList := List;
- FIndex := -1;
-end;
-
-function TPArrayIterator.TrueFirst: ICollectable;
-begin
- FIndex := 0;
- if FIndex < FList.Count then
- Result := ICollectable(FList[FIndex])
- else
- Result := nil;
-end;
-
-function TPArrayIterator.TrueNext: ICollectable;
-begin
- Inc(FIndex);
- if FIndex < FList.Count then
- Result := ICollectable(FList[FIndex])
- else
- Result := nil;
-end;
-
-procedure TPArrayIterator.TrueRemove;
-var
- Item: ICollectable;
-begin
- Item := ICollectable(FList[FIndex]);
- FList.Delete(FIndex);
- Dec(FIndex);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Item._Release;
-end;
-
-{ TPArrayAssociationIterator }
-constructor TPArrayAssociationIterator.Create(List: TList; AllowRemove: Boolean);
-begin
- inherited Create(AllowRemove);
- FList := List;
- FIndex := -1;
-end;
-
-function TPArrayAssociationIterator.TrueFirst: IAssociation;
-begin
- FIndex := 0;
- if FIndex < FList.Count then
- Result := IAssociation(FList[FIndex])
- else
- Result := nil;
-end;
-
-function TPArrayAssociationIterator.TrueNext: IAssociation;
-begin
- Inc(FIndex);
- if FIndex < FList.Count then
- Result := IAssociation(FList[FIndex])
- else
- Result := nil;
-end;
-
-procedure TPArrayAssociationIterator.TrueRemove;
-var
- Association: IAssociation;
-begin
- Association := IAssociation(FList[FIndex]);
- FList.Delete(FIndex);
- Dec(FIndex);
- // Storing interface reference as a pointer does not update reference
- // count automatically, so this must be done manually
- Association._Release;
-end;
-
-{ TPArrayPosition }
-constructor TPArrayPosition.Create(Found: Boolean; Index: Integer);
-begin
- inherited Create(Found);
- FIndex := Index;
-end;
-
-end.
diff --git a/src/lib/collections/CollWrappers.pas b/src/lib/collections/CollWrappers.pas
deleted file mode 100644
index 513103a2..00000000
--- a/src/lib/collections/CollWrappers.pas
+++ /dev/null
@@ -1,876 +0,0 @@
-unit CollWrappers;
-
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * This library is free software; you can redistribute it and/or modify it
- * under the terms of the GNU Lesser General Public License as published by the
- * Free Software Foundation; either version 2.1 of the License, or (at your
- * option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but WITHOUT
- * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
- * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
- * details. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0.3 $
- * $Revision: 1.1.1.1 $
- * $Log: D:\QVCS Repositories\Delphi Collections\CollWrappers.qbt $
- *
- * Various primitive type wrappers, adapters and abstract base classes for
- * natural items.
- *
- * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
- * v1.0 branch.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:51:04
- * Primitive type wrapper interfaces added.
- * Abstract, template classes added.
- * All classes implement reference counting by descending from
- * TInterfacedObject.
- *
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- SysUtils,
- Collections;
-
-type
- IAssociationWrapper = interface
- ['{54DF42E0-64F2-11D7-8120-0002E3165EF8}']
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: ICollectable;
- function GetValue: TObject;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: ICollectable read GetKey;
- property Value: TObject read GetValue;
- end;
-
- IBoolean = interface
- ['{62D1D160-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: Boolean;
- property Value: Boolean read GetValue;
- end;
-
- ICardinal = interface
- ['{6AF7B1C0-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: Cardinal;
- property Value: Cardinal read GetValue;
- end;
-
- IChar = interface
- ['{73AD00E0-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: Char;
- property Value: Char read GetValue;
- end;
-
- IClass = interface
- ['{7A84B660-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: TClass;
- property Value: TClass read GetValue;
- end;
-
- IDouble = interface
- ['{815C6BE0-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: Double;
- property Value: Double read GetValue;
- end;
-
- IInteger = interface
- ['{88ECC300-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: Integer;
- property Value: Integer read GetValue;
- end;
-
- IIntegerAssociationWrapper = interface
- ['{8F582220-64F2-11D7-8120-0002E3165EF8}']
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: Integer;
- function GetValue: TObject;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: Integer read GetKey;
- property Value: TObject read GetValue;
- end;
-
- IInterfaceWrapper = interface
- ['{962E5100-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: IUnknown;
- property Value: IUnknown read GetValue;
- end;
-
- IObject = interface
- ['{9C675580-64F2-11D7-8120-0002E3165EF8}']
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetValue: TObject;
- property Value: TObject read GetValue;
- end;
-
- IString = interface
- ['{A420DF80-64F2-11D7-8120-0002E3165EF8}']
- function GetValue: String;
- property Value: String read GetValue;
- end;
-
- IStringAssociationWrapper = interface
- ['{AB98CCA0-64F2-11D7-8120-0002E3165EF8}']
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: String;
- function GetValue: TObject;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: String read GetKey;
- property Value: TObject read GetValue;
- end;
-
- TAbstractItem = class(TInterfacedObject, ICollectable)
- public
- function GetInstance: TObject; virtual;
- end;
-
- TAbstractIntegerMappable = class(TAbstractItem, IEquatable, IIntegerMappable)
- private
- FKey: Integer;
- protected
- function MakeKey: Integer; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function Equals(const Item: ICollectable): Boolean; virtual;
- function GetKey: Integer; virtual;
- end;
-
- TAbstractMappable = class(TAbstractItem, IEquatable, IMappable)
- private
- FKey: ICollectable;
- protected
- function MakeKey: ICollectable; virtual; abstract;
- public
- destructor Destroy; override;
- procedure AfterConstruction; override;
- function Equals(const Item: ICollectable): Boolean; virtual;
- function GetKey: ICollectable; virtual;
- end;
-
- TAbstractStringMappable = class(TAbstractItem, IEquatable, IStringMappable)
- private
- FKey: String;
- protected
- function MakeKey: String; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function Equals(const Item: ICollectable): Boolean; virtual;
- function GetKey: String; virtual;
- end;
-
- TAssociationWrapper = class(TAbstractItem, IEquatable, IMappable, IAssociationWrapper)
- private
- FAutoDestroy: Boolean;
- FKey: ICollectable;
- FValue: TObject;
- public
- constructor Create(const Key: ICollectable; Value: TObject); overload;
- constructor Create(Key: Integer; Value: TObject); overload;
- constructor Create(Key: String; Value: TObject); overload;
- constructor Create(Key, Value: TObject; AutoDestroyKey: Boolean = true); overload;
- destructor Destroy; override;
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: ICollectable;
- function GetValue: TObject;
- function Equals(const Item: ICollectable): Boolean;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: ICollectable read GetKey;
- property Value: TObject read GetValue;
- end;
-
- TBooleanWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IBoolean)
- private
- FValue: Boolean;
- public
- constructor Create(Value: Boolean);
- function GetValue: Boolean;
- function CompareTo(const Item: ICollectable): Integer;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- property Value: Boolean read GetValue;
- end;
-
- TCardinalWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, ICardinal)
- private
- FValue: Cardinal;
- public
- constructor Create(Value: Cardinal);
- function GetValue: Cardinal;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- function CompareTo(const Item: ICollectable): Integer;
- property Value: Cardinal read GetValue;
- end;
-
- TCharWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IChar)
- private
- FValue: Char;
- public
- constructor Create(Value: Char);
- function GetValue: Char;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- function CompareTo(const Item: ICollectable): Integer;
- property Value: Char read GetValue;
- end;
-
- TClassWrapper = class(TAbstractItem, IEquatable, IHashable, IClass)
- private
- FValue: TClass;
- public
- constructor Create(Value: TClass);
- function GetValue: TClass;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- property Value: TClass read GetValue;
- end;
-
- TDoubleWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IDouble)
- private
- FValue: Double;
- public
- constructor Create(Value: Double);
- function GetValue: Double;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- function CompareTo(const Item: ICollectable): Integer;
- property Value: Double read GetValue;
- end;
-
- TIntegerWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IInteger)
- private
- FValue: Integer;
- public
- constructor Create(Value: Integer);
- function GetValue: Integer;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- function CompareTo(const Item: ICollectable): Integer;
- property Value: Integer read GetValue;
- end;
-
- TIntegerAssociationWrapper = class(TAbstractItem, IEquatable, IIntegerMappable, IIntegerAssociationWrapper)
- private
- FAutoDestroy: Boolean;
- FKey: Integer;
- FValue: TObject;
- public
- constructor Create(const Key: Integer; Value: TObject); overload;
- destructor Destroy; override;
- function Equals(const Item: ICollectable): Boolean;
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: Integer;
- function GetValue: TObject;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: Integer read GetKey;
- property Value: TObject read GetValue;
- end;
-
- TInterfaceWrapper = class(TAbstractItem, IHashable, IEquatable, IInterfaceWrapper)
- private
- FValue: IUnknown;
- public
- constructor Create(const Value: IUnknown);
- destructor Destroy; override;
- function GetValue: IUnknown;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- property Value: IUnknown read GetValue;
- end;
-
- TObjectWrapper = class(TAbstractItem, IEquatable, IComparable, IHashable, IObject)
- private
- FAutoDestroy: Boolean;
- FValue: TObject;
- public
- constructor Create(Value: TObject); overload;
- destructor Destroy; override;
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetValue: TObject;
- function CompareTo(const Item: ICollectable): Integer;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- property AutoDestroy: Boolean read FAutoDestroy write FAutoDestroy;
- property Value: TObject read GetValue;
- end;
-
- TStringWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IString)
- private
- FValue: String;
- public
- constructor Create(Value: String);
- function GetValue: String;
- function Equals(const Item: ICollectable): Boolean;
- function HashCode: Integer;
- function CompareTo(const Item: ICollectable): Integer;
- property Value: String read FValue;
- end;
-
- TStringAssociationWrapper = class(TAbstractItem, IEquatable, IStringMappable, IStringAssociationWrapper)
- private
- FAutoDestroy: Boolean;
- FKey: String;
- FValue: TObject;
- public
- constructor Create(const Key: String; Value: TObject); overload;
- destructor Destroy; override;
- function GetAutoDestroy: Boolean;
- procedure SetAutoDestroy(Value: Boolean);
- function GetKey: String;
- function GetValue: TObject;
- function Equals(const Item: ICollectable): Boolean;
- property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
- property Key: String read GetKey;
- property Value: TObject read GetValue;
- end;
-
-implementation
-
-{ TAbstractItem }
-function TAbstractItem.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-
-{ TAbstractIntegerMappable }
-procedure TAbstractIntegerMappable.AfterConstruction;
-begin
- inherited AfterConstruction;
- FKey := MakeKey;
-end;
-
-function TAbstractIntegerMappable.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self = Item.GetInstance);
-end;
-
-function TAbstractIntegerMappable.GetKey: Integer;
-begin
- Result := FKey;
-end;
-
-{ TAbstractMappable }
-destructor TAbstractMappable.Destroy;
-begin
- FKey := nil;
- inherited Destroy;
-end;
-
-procedure TAbstractMappable.AfterConstruction;
-begin
- inherited AfterConstruction;
- FKey := MakeKey;
-end;
-
-function TAbstractMappable.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self = Item.GetInstance);
-end;
-
-function TAbstractMappable.GetKey: ICollectable;
-begin
- Result := FKey;
-end;
-
-{ TAbstractStringMappable }
-procedure TAbstractStringMappable.AfterConstruction;
-begin
- inherited AfterConstruction;
- FKey := MakeKey;
-end;
-
-function TAbstractStringMappable.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self = Item.GetInstance);
-end;
-
-function TAbstractStringMappable.GetKey: String;
-begin
- Result := FKey;
-end;
-
-{ TAssociationWrapper }
-constructor TAssociationWrapper.Create(const Key: ICollectable; Value: TObject);
-begin
- inherited Create;
- FAutoDestroy := true;
- FKey := Key;
- FValue := Value;
-end;
-
-constructor TAssociationWrapper.Create(Key: Integer; Value: TObject);
-begin
- Create(TIntegerWrapper.Create(Key) as ICollectable, Value);
-end;
-
-constructor TAssociationWrapper.Create(Key: String; Value: TObject);
-begin
- Create(TStringWrapper.Create(Key) as ICollectable, Value);
-end;
-
-constructor TAssociationWrapper.Create(Key, Value: TObject; AutoDestroyKey: Boolean);
-var
- KeyWrapper: TObjectWrapper;
-begin
- KeyWrapper := TObjectWrapper.Create(Key);
- KeyWrapper.AutoDestroy := AutoDestroyKey;
- Create(KeyWrapper as ICollectable, Value);
-end;
-
-destructor TAssociationWrapper.Destroy;
-begin
- if FAutoDestroy then
- FValue.Free;
- FKey := nil;
- inherited Destroy;
-end;
-
-function TAssociationWrapper.GetAutoDestroy: Boolean;
-begin
- Result := FAutoDestroy;
-end;
-
-procedure TAssociationWrapper.SetAutoDestroy(Value: Boolean);
-begin
- FAutoDestroy := Value;
-end;
-
-function TAssociationWrapper.GetKey: ICollectable;
-begin
- Result := FKey;
-end;
-
-function TAssociationWrapper.GetValue: TObject;
-begin
- Result := FValue;
-end;
-
-function TAssociationWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TAssociationWrapper).Value)
-end;
-
-{ TCardinalWrapper }
-constructor TCardinalWrapper.Create(Value: Cardinal);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TCardinalWrapper.GetValue: Cardinal;
-begin
- Result := FValue;
-end;
-
-function TCardinalWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TCardinalWrapper).Value)
-end;
-
-function TCardinalWrapper.HashCode: Integer;
-begin
- Result := FValue;
-end;
-
-function TCardinalWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value2: Cardinal;
-begin
- Value2 := (Item.GetInstance as TCardinalWrapper).Value;
- if Value < Value2 then
- Result := -1
- else if Value > Value2 then
- Result := 1
- else
- Result := 0;
-end;
-
-{ TBooleanWrapper }
-constructor TBooleanWrapper.Create(Value: Boolean);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TBooleanWrapper.GetValue: Boolean;
-begin
- Result := FValue;
-end;
-
-function TBooleanWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TBooleanWrapper).Value)
-end;
-
-function TBooleanWrapper.HashCode: Integer;
-begin
- Result := Ord(FValue);
-end;
-
-function TBooleanWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value2: Boolean;
-begin
- Value2 := (Item.GetInstance as TBooleanWrapper).Value;
- if not Value and Value2 then
- Result := -1
- else if Value and not Value2 then
- Result := 1
- else
- Result := 0;
-end;
-
-{ TCharWrapper }
-constructor TCharWrapper.Create(Value: Char);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TCharWrapper.GetValue: Char;
-begin
- Result := FValue;
-end;
-
-function TCharWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TCharWrapper).Value)
-end;
-
-function TCharWrapper.HashCode: Integer;
-begin
- Result := Integer(FValue);
-end;
-
-function TCharWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value2: Char;
-begin
- Value2 := (Item.GetInstance as TCharWrapper).Value;
- if Value < Value2 then
- Result := -1
- else if Value > Value2 then
- Result := 1
- else
- Result := 0;
-end;
-
-{ TClassWrapper }
-constructor TClassWrapper.Create(Value: TClass);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TClassWrapper.GetValue: TClass;
-begin
- Result := FValue;
-end;
-
-function TClassWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TClassWrapper).Value)
-end;
-
-function TClassWrapper.HashCode: Integer;
-begin
- Result := Integer(FValue.ClassInfo);
-end;
-
-{ TDoubleWrapper }
-constructor TDoubleWrapper.Create(Value: Double);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TDoubleWrapper.GetValue: Double;
-begin
- Result := FValue;
-end;
-
-function TDoubleWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TDoubleWrapper).Value)
-end;
-
-function TDoubleWrapper.HashCode: Integer;
-var
- DblAsInt: array[0..1] of Integer;
-begin
- Double(DblAsInt) := Value;
- Result := DblAsInt[0] xor DblAsInt[1];
-end;
-
-function TDoubleWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value2: Double;
-begin
- Value2 := (Item.GetInstance as TDoubleWrapper).Value;
- if Value < Value2 then
- Result := -1
- else if Value > Value2 then
- Result := 1
- else
- Result := 0;
-end;
-
-{ TIntegerWrapper }
-constructor TIntegerWrapper.Create(Value: Integer);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TIntegerWrapper.GetValue: Integer;
-begin
- Result := FValue;
-end;
-
-function TIntegerWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TIntegerWrapper).Value)
-end;
-
-function TIntegerWrapper.HashCode: Integer;
-begin
- Result := FValue;
-end;
-
-function TIntegerWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value2: Integer;
-begin
- Value2 := (Item.GetInstance as TIntegerWrapper).Value;
- if Value < Value2 then
- Result := -1
- else if Value > Value2 then
- Result := 1
- else
- Result := 0;
-end;
-
-{ TIntegerAssociationWrapper }
-constructor TIntegerAssociationWrapper.Create(const Key: Integer; Value: TObject);
-begin
- inherited Create;
- FAutoDestroy := true;
- FKey := Key;
- FValue := Value;
-end;
-
-destructor TIntegerAssociationWrapper.Destroy;
-begin
- if FAutoDestroy then
- FValue.Free;
- inherited Destroy;
-end;
-
-function TIntegerAssociationWrapper.GetAutoDestroy: Boolean;
-begin
- Result := FAutoDestroy;
-end;
-
-procedure TIntegerAssociationWrapper.SetAutoDestroy(Value: Boolean);
-begin
- FAutoDestroy := Value;
-end;
-
-function TIntegerAssociationWrapper.GetValue: TObject;
-begin
- Result := FValue;
-end;
-
-function TIntegerAssociationWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TIntegerAssociationWrapper).Value)
-end;
-
-function TIntegerAssociationWrapper.GetKey: Integer;
-begin
- Result := FKey;
-end;
-
-{ TStringAssociationWrapper }
-constructor TStringAssociationWrapper.Create(const Key: String; Value: TObject);
-begin
- inherited Create;
- FAutoDestroy := true;
- FKey := Key;
- FValue := Value;
-end;
-
-destructor TStringAssociationWrapper.Destroy;
-begin
- if FAutoDestroy then
- FValue.Free;
- inherited Destroy;
-end;
-
-function TStringAssociationWrapper.GetAutoDestroy: Boolean;
-begin
- Result := FAutoDestroy;
-end;
-
-procedure TStringAssociationWrapper.SetAutoDestroy(Value: Boolean);
-begin
- FAutoDestroy := Value;
-end;
-
-function TStringAssociationWrapper.GetValue: TObject;
-begin
- Result := FValue;
-end;
-
-function TStringAssociationWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TStringAssociationWrapper).Value)
-end;
-
-function TStringAssociationWrapper.GetKey: String;
-begin
- Result := FKey;
-end;
-
-{ TInterfaceWrapper }
-constructor TInterfaceWrapper.Create(const Value: IUnknown);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-destructor TInterfaceWrapper.Destroy;
-begin
- FValue := nil;
- inherited Destroy;
-end;
-
-function TInterfaceWrapper.GetValue: IUnknown;
-begin
- Result := FValue;
-end;
-
-function TInterfaceWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TInterfaceWrapper).Value)
-end;
-
-function TInterfaceWrapper.HashCode: Integer;
-begin
- Result := Integer(Pointer(FValue));
-end;
-
-{ TObjectWrapper }
-constructor TObjectWrapper.Create(Value: TObject);
-begin
- inherited Create;
- FAutoDestroy := true;
- FValue := Value;
-end;
-
-destructor TObjectWrapper.Destroy;
-begin
- if FAutoDestroy then
- FValue.Free;
- inherited Destroy;
-end;
-
-function TObjectWrapper.GetAutoDestroy: Boolean;
-begin
- Result := FAutoDestroy;
-end;
-
-procedure TObjectWrapper.SetAutoDestroy(Value: Boolean);
-begin
- FAutoDestroy := Value;
-end;
-
-function TObjectWrapper.GetValue: TObject;
-begin
- Result := FValue;
-end;
-
-function TObjectWrapper.CompareTo(const Item: ICollectable): Integer;
-var
- Value1, Value2: Integer;
-begin
- Value1 := Integer(Pointer(Self));
- if Item <> nil then
- Value2 := Integer(Pointer(Item))
- else
- Value2 := Low(Integer);
- if (Value1 < Value2) then
- Result := -1
- else if (Value1 > Value2) then
- Result := 1
- else
- Result := 0;
-end;
-
-function TObjectWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TObjectWrapper).Value)
-end;
-
-function TObjectWrapper.HashCode: Integer;
-begin
- Result := Integer(Pointer(FValue));
-end;
-
-{ TStringWrapper }
-constructor TStringWrapper.Create(Value: String);
-begin
- inherited Create;
- FValue := Value;
-end;
-
-function TStringWrapper.GetValue: String;
-begin
- Result := FValue;
-end;
-
-function TStringWrapper.Equals(const Item: ICollectable): Boolean;
-begin
- Result := (Self.Value = (Item.GetInstance as TStringWrapper).Value)
-end;
-
-function TStringWrapper.HashCode: Integer;
-var
- I: Integer;
-begin
- Result := 0;
- for I := 1 to Length(FValue) do
- Result := (Result shl 1) xor Ord(FValue[I]);
-end;
-
-function TStringWrapper.CompareTo(const Item: ICollectable): Integer;
-begin
- Result := CompareStr(Self.Value, (Item.GetInstance as TStringWrapper).Value)
-end;
-
-
-end.
diff --git a/src/lib/collections/Collections.pas b/src/lib/collections/Collections.pas
deleted file mode 100644
index 0c94173d..00000000
--- a/src/lib/collections/Collections.pas
+++ /dev/null
@@ -1,5318 +0,0 @@
-unit Collections;
-(*****************************************************************************
- * Copyright 2003 by Matthew Greet
- * This library is free software; you can redistribute it and/or modify it
- * under the terms of the GNU Lesser General Public License as published by the
- * Free Software Foundation; either version 2.1 of the License, or (at your
- * option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but WITHOUT
- * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
- * FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
- * details. (http://opensource.org/licenses/lgpl-license.php)
- *
- * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
- *
- * $Version: v1.0 $
- * $Revision: 1.1.1.4 $
- * $Log: D:\QVCS Repositories\Delphi Collections\Collections.qbt $
- *
- * Main unit containing all interface and abstract class definitions.
- *
- * Revision 1.1.1.4 by: Matthew Greet Rev date: 14/03/05 23:26:32
- * Fixed RemoveAll for TAbstractList for sorted lists.
- *
- * Revision 1.1.1.3 by: Matthew Greet Rev date: 14/10/04 16:31:18
- * Fixed memory lean in ContainsKey of TAbstractStringMap and
- * TAbstractIntegerMap.
- *
- * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:03:26
- * Capacity property.
- * Memory leak fixed.
- *
- * Revision 1.1.1.1 by: Matthew Greet Rev date: 13/02/04 16:12:10
- * v1.0 branch.
- *
- * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:36:30
- * Added integer map and string map collection types with supporting
- * classes.
- * Add clone and filter functions with supporting classes.
- * Added nil not allowed collection error.
- * Properties appear in collection interfaces as well as abstract
- * classes.
- *
- * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
- * Initial revision.
- *
- * FPC compatibility fixes by: UltraStar Deluxe Team
- *
- * $Endlog$
- *****************************************************************************)
-
-{$IFDEF FPC}
- {$MODE Delphi}{$H+}
-{$ENDIF}
-
-interface
-
-uses
- Classes, SysUtils;
-
-const
- EquatableIID: TGUID = '{EAC823A7-0B90-11D7-8120-0002E3165EF8}';
- HashableIID: TGUID = '{98998440-4C3E-11D7-8120-0002E3165EF8}';
- ComparableIID: TGUID = '{9F4C96C0-0CF0-11D7-8120-0002E3165EF8}';
- MappableIID: TGUID = '{DAEC8CA0-0DBB-11D7-8120-0002E3165EF8}';
- StringMappableIID: TGUID = '{3CC61F40-5F92-11D7-8120-0002E3165EF8}';
- IntegerMappableIID: TGUID = '{774FC760-5F92-11D7-8120-0002E3165EF8}';
-
-type
- TDefaultComparator = class;
- TNaturalComparator = class;
- ICollectable = interface;
-
- TCollectableArray = array of ICollectable;
- TIntegerArray = array of Integer;
- TStringArray = array of String;
- TListArray = array of TList;
-
- TCollectionError = (ceOK, ceDuplicate, ceDuplicateKey, ceFixedSize, ceNilNotAllowed, ceNotNaturalItem, ceOutOfRange);
- TCollectionErrors = set of TCollectionError;
-
- TSearchResultType = (srNotFound, srFoundAtIndex, srBeforeIndex, srAfterEnd);
-
- TCollectionType = (ctBag, ctSet, ctList, ctMap, ctIntegerMap, ctStringMap);
-
- TCollectionFilterFunc = function (const Item: ICollectable): Boolean of object;
- TCollectionCompareFunc = function (const Item1, Item2: ICollectable): Integer of object;
-
- TSearchResult = record
- ResultType: TSearchResultType;
- Index: Integer;
- end;
-
- ICollectable = interface
- ['{98998441-4C3E-11D7-8120-0002E3165EF8}']
- function GetInstance: TObject;
- end;
-
- IEquatable = interface
- ['{EAC823A7-0B90-11D7-8120-0002E3165EF8}']
- function GetInstance: TObject;
- function Equals(const Item: ICollectable): Boolean;
- end;
-
- IHashable = interface(IEquatable)
- ['{98998440-4C3E-11D7-8120-0002E3165EF8}']
- function HashCode: Integer;
- end;
-
- IComparable = interface(IEquatable)
- ['{9F4C96C0-0CF0-11D7-8120-0002E3165EF8}']
- function CompareTo(const Item: ICollectable): Integer;
- end;
-
- IMappable = interface(IEquatable)
- ['{DAEC8CA0-0DBB-11D7-8120-0002E3165EF8}']
- function GetKey: ICollectable;
- end;
-
- IStringMappable = interface(IEquatable)
- ['{3CC61F40-5F92-11D7-8120-0002E3165EF8}']
- function GetKey: String;
- end;
-
- IIntegerMappable = interface(IEquatable)
- ['{774FC760-5F92-11D7-8120-0002E3165EF8}']
- function GetKey: Integer;
- end;
-
- IComparator = interface
- ['{1F20CD60-10FE-11D7-8120-0002E3165EF8}']
- function GetInstance: TObject;
- function Compare(const Item1, Item2: ICollectable): Integer;
- function Equals(const Item1, Item2: ICollectable): Boolean; overload;
- function Equals(const Comparator: IComparator): Boolean; overload;
- end;
-
- IFilter = interface
- ['{27FE44C0-638E-11D7-8120-0002E3165EF8}']
- function Accept(const Item: ICollectable): Boolean;
- end;
-
- IIterator = interface
- ['{F6930500-1113-11D7-8120-0002E3165EF8}']
- function GetAllowRemoval: Boolean;
- function CurrentItem: ICollectable;
- function EOF: Boolean;
- function First: ICollectable;
- function Next: ICollectable;
- function Remove: Boolean;
- end;
-
- IMapIterator = interface(IIterator)
- ['{848CC0E0-2A31-11D7-8120-0002E3165EF8}']
- function CurrentKey: ICollectable;
- end;
-
- IIntegerMapIterator = interface(IIterator)
- ['{C7169780-606C-11D7-8120-0002E3165EF8}']
- function CurrentKey: Integer;
- end;
-
- IStringMapIterator = interface(IIterator)
- ['{1345ED20-5F93-11D7-8120-0002E3165EF8}']
- function CurrentKey: String;
- end;
-
- IAssociation = interface(ICollectable)
- ['{556CD700-4DB3-11D7-8120-0002E3165EF8}']
- function GetKey: ICollectable;
- function GetValue: ICollectable;
- end;
-
- IIntegerAssociation = interface(ICollectable)
- ['{ED954420-5F94-11D7-8120-0002E3165EF8}']
- function GetKey: Integer;
- function GetValue: ICollectable;
- end;
-
- IStringAssociation = interface(ICollectable)
- ['{FB87D2A0-5F94-11D7-8120-0002E3165EF8}']
- function GetKey: String;
- function GetValue: ICollectable;
- end;
-
- IAssociationComparator = interface(IComparator)
- ['{EA9BE6E0-A852-11D8-B93A-0002E3165EF8}']
- function GetKeyComparator: IComparator;
- procedure SetKeyComparator(Value: IComparator);
- property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
- end;
-
- IIntegerAssociationComparator = interface(IComparator)
- ['{EA9BE6E1-A852-11D8-B93A-0002E3165EF8}']
- end;
-
- IStringAssociationComparator = interface(IComparator)
- ['{EA9BE6E2-A852-11D8-B93A-0002E3165EF8}']
- end;
-
- ICollection = interface
- ['{EAC823AC-0B90-11D7-8120-0002E3165EF8}']
- function GetAsArray: TCollectableArray;
- function GetCapacity: Integer;
- procedure SetCapacity(Value: Integer);
- function GetComparator: IComparator;
- procedure SetComparator(const Value: IComparator);
- function GetDuplicates: Boolean;
- function GetFixedSize: Boolean;
- function GetIgnoreErrors: TCollectionErrors;
- procedure SetIgnoreErrors(Value: TCollectionErrors);
- function GetInstance: TObject;
- function GetIterator: IIterator; overload;
- function GetIterator(const Filter: IFilter): IIterator; overload;
- function GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; overload;
- function GetNaturalItemIID: TGUID;
- function GetNaturalItemsOnly: Boolean;
- function GetSize: Integer;
- function GetType: TCollectionType;
- function Add(const Item: ICollectable): Boolean; overload;
- function Add(const ItemArray: array of ICollectable): Integer; overload;
- function Add(const Collection: ICollection): Integer; overload;
- function Clear: Integer;
- function Clone: ICollection;
- function Contains(const Item: ICollectable): Boolean; overload;
- function Contains(const ItemArray: array of ICollectable): Boolean; overload;
- function Contains(const Collection: ICollection): Boolean; overload;
- function Equals(const Collection: ICollection): Boolean;
- function Find(const Filter: IFilter): ICollectable; overload;
- function Find(FilterFunc: TCollectionFilterFunc): ICollectable; overload;
- function FindAll(const Filter: IFilter = nil): ICollection; overload;
- function FindAll(FilterFunc: TCollectionFilterFunc): ICollection; overload;
- function IsEmpty: Boolean;
- function IsNaturalItem(const Item: ICollectable): Boolean;
- function IsNilAllowed: Boolean;
- function ItemAllowed(const Item: ICollectable): TCollectionError;
- function ItemCount(const Item: ICollectable): Integer; overload;
- function ItemCount(const ItemArray: array of ICollectable): Integer; overload;
- function ItemCount(const Collection: ICollection): Integer; overload;
- function Matching(const ItemArray: array of ICollectable): ICollection; overload;
- function Matching(const Collection: ICollection): ICollection; overload;
- function Remove(const Item: ICollectable): ICollectable; overload;
- function Remove(const ItemArray: array of ICollectable): ICollection; overload;
- function Remove(const Collection: ICollection): ICollection; overload;
- function RemoveAll(const Item: ICollectable): ICollection; overload;
- function RemoveAll(const ItemArray: array of ICollectable): ICollection; overload;
- function RemoveAll(const Collection: ICollection): ICollection; overload;
- function Retain(const ItemArray: array of ICollectable): ICollection; overload;
- function Retain(const Collection: ICollection): ICollection; overload;
- property AsArray: TCollectableArray read GetAsArray;
- property Capacity: Integer read GetCapacity write SetCapacity;
- property Comparator: IComparator read GetComparator write SetComparator;
- property FixedSize: Boolean read GetFixedSize;
- property IgnoreErrors: TCollectionErrors read GetIgnoreErrors write SetIgnoreErrors;
- property NaturalItemIID: TGUID read GetNaturalItemIID;
- property NaturalItemsOnly: Boolean read GetNaturalItemsOnly;
- property Size: Integer read GetSize;
- end;
-
- IBag = interface(ICollection)
- ['{C29C9560-2D59-11D7-8120-0002E3165EF8}']
- function CloneAsBag: IBag;
- end;
-
- ISet = interface(ICollection)
- ['{DD7888E2-0BB1-11D7-8120-0002E3165EF8}']
- function CloneAsSet: ISet;
- function Complement(const Universe: ISet): ISet;
- function Intersect(const Set2: ISet): ISet;
- function Union(const Set2: ISet): ISet;
- end;
-
- IList = interface(ICollection)
- ['{EE81AB60-0B9F-11D7-8120-0002E3165EF8}']
- function GetDuplicates: Boolean;
- procedure SetDuplicates(Value: Boolean);
- function GetItem(Index: Integer): ICollectable;
- procedure SetItem(Index: Integer; const Item: ICollectable);
- function GetSorted: Boolean;
- procedure SetSorted(Value: Boolean);
- function CloneAsList: IList;
- function Delete(Index: Integer): ICollectable;
- procedure Exchange(Index1, Index2: Integer);
- function First: ICollectable;
- function IndexOf(const Item: ICollectable): Integer;
- function Insert(Index: Integer; const Item: ICollectable): Boolean; overload;
- function Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; overload;
- function Insert(Index: Integer; const Collection: ICollection): Integer; overload;
- function Last: ICollectable;
- procedure Sort(const Comparator: IComparator); overload;
- procedure Sort(CompareFunc: TCollectionCompareFunc); overload;
- property Duplicates: Boolean read GetDuplicates write SetDuplicates;
- property Items[Index: Integer]: ICollectable read GetItem write SetItem; default;
- property Sorted: Boolean read GetSorted write SetSorted;
- end;
-
- IMap = interface(ICollection)
- ['{AD458280-2A6B-11D7-8120-0002E3165EF8}']
- function GetItem(const Key: ICollectable): ICollectable;
- procedure SetItem(const Key, Item: ICollectable);
- function GetKeyComparator: IComparator;
- procedure SetKeyComparator(const Value: IComparator);
- function GetKeyIterator: IIterator;
- function GetKeys: ISet;
- function GetMapIterator: IMapIterator;
- function GetMapIteratorByKey(const Filter: IFilter): IMapIterator; overload;
- function GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; overload;
- function GetNaturalKeyIID: TGUID;
- function GetNaturalKeysOnly: Boolean;
- function GetValues: ICollection;
- function CloneAsMap: IMap;
- function ContainsKey(const Key: ICollectable): Boolean; overload;
- function ContainsKey(const KeyArray: array of ICollectable): Boolean; overload;
- function ContainsKey(const Collection: ICollection): Boolean; overload;
- function Get(const Key: ICollectable): ICollectable;
- function IsNaturalKey(const Key: ICollectable): Boolean;
- function KeyAllowed(const Key: ICollectable): TCollectionError;
- function MatchingKey(const KeyArray: array of ICollectable): ICollection; overload;
- function MatchingKey(const Collection: ICollection): ICollection; overload;
- function Put(const Item: ICollectable): ICollectable; overload;
- function Put(const Key, Item: ICollectable): ICollectable; overload;
- function Put(const ItemArray: array of ICollectable): ICollection; overload;
- function Put(const Collection: ICollection): ICollection; overload;
- function Put(const Map: IMap): ICollection; overload;
- function RemoveKey(const Key: ICollectable): ICollectable; overload;
- function RemoveKey(const KeyArray: array of ICollectable): ICollection; overload;
- function RemoveKey(const Collection: ICollection): ICollection; overload;
- function RetainKey(const KeyArray: array of ICollectable): ICollection; overload;
- function RetainKey(const Collection: ICollection): ICollection; overload;
- property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
- property Items[const Key: ICollectable]: ICollectable read GetItem write SetItem; default;
- property NaturalKeyIID: TGUID read GetNaturalKeyIID;
- property NaturalKeysOnly: Boolean read GetNaturalKeysOnly;
- end;
-
- IIntegerMap = interface(ICollection)
- ['{93DBA9A0-606C-11D7-8120-0002E3165EF8}']
- function GetItem(const Key: Integer): ICollectable;
- procedure SetItem(const Key: Integer; const Item: ICollectable);
- function GetKeys: ISet;
- function GetMapIterator: IIntegerMapIterator;
- function GetValues: ICollection;
- function CloneAsIntegerMap: IIntegerMap;
- function ContainsKey(const Key: Integer): Boolean; overload;
- function ContainsKey(const KeyArray: array of Integer): Boolean; overload;
- function Get(const Key: Integer): ICollectable;
- function Put(const Item: ICollectable): ICollectable; overload;
- function Put(const Key: Integer; const Item: ICollectable): ICollectable; overload;
- function Put(const ItemArray: array of ICollectable): ICollection; overload;
- function Put(const Collection: ICollection): ICollection; overload;
- function Put(const Map: IIntegerMap): ICollection; overload;
- function RemoveKey(const Key: Integer): ICollectable; overload;
- function RemoveKey(const KeyArray: array of Integer): ICollection; overload;
- function RetainKey(const KeyArray: array of Integer): ICollection; overload;
- property Items[const Key: Integer]: ICollectable read GetItem write SetItem; default;
- end;
-
- IStringMap = interface(ICollection)
- ['{20531A20-5F92-11D7-8120-0002E3165EF8}']
- function GetItem(const Key: String): ICollectable;
- procedure SetItem(const Key: String; const Item: ICollectable);
- function GetKeys: ISet;
- function GetMapIterator: IStringMapIterator;
- function GetValues: ICollection;
- function CloneAsStringMap: IStringMap;
- function ContainsKey(const Key: String): Boolean; overload;
- function ContainsKey(const KeyArray: array of String): Boolean; overload;
- function Get(const Key: String): ICollectable;
- function Put(const Item: ICollectable): ICollectable; overload;
- function Put(const Key: String; const Item: ICollectable): ICollectable; overload;
- function Put(const ItemArray: array of ICollectable): ICollection; overload;
- function Put(const Collection: ICollection): ICollection; overload;
- function Put(const Map: IStringMap): ICollection; overload;
- function RemoveKey(const Key: String): ICollectable; overload;
- function RemoveKey(const KeyArray: array of String): ICollection; overload;
- function RetainKey(const KeyArray: array of String): ICollection; overload;
- property Items[const Key: String]: ICollectable read GetItem write SetItem; default;
- end;
-
- TCollectionPosition = class
- private
- FFound: Boolean;
- public
- constructor Create(Found: Boolean);
- property Found: Boolean read FFound;
- end;
-
- TAbstractComparator = class(TInterfacedObject, IComparator)
- public
- class function GetDefaultComparator: IComparator;
- class function GetNaturalComparator: IComparator;
- class function GetReverseNaturalComparator: IComparator;
- function GetInstance: TObject;
- function Compare(const Item1, Item2: ICollectable): Integer; virtual; abstract;
- function Equals(const Item1, Item2: ICollectable): Boolean; overload; virtual; abstract;
- function Equals(const Comparator: IComparator): Boolean; overload; virtual;
- end;
-
- TDefaultComparator = class(TAbstractComparator)
- protected
- constructor Create;
- public
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- end;
-
- TNaturalComparator = class(TAbstractComparator)
- protected
- constructor Create;
- public
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- end;
-
- TReverseNaturalComparator = class(TAbstractComparator)
- protected
- constructor Create;
- public
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- end;
-
- TAssociation = class(TInterfacedObject, ICollectable, IAssociation)
- private
- FKey: ICollectable;
- FValue: ICollectable;
- public
- constructor Create(const Key, Value: ICollectable); virtual;
- destructor Destroy; override;
- function GetInstance: TObject; virtual;
- function GetKey: ICollectable;
- function GetValue: ICollectable;
- end;
-
- TIntegerAssociation = class(TInterfacedObject, ICollectable, IIntegerAssociation)
- private
- FKey: Integer;
- FValue: ICollectable;
- public
- constructor Create(const Key: Integer; const Value: ICollectable); virtual;
- destructor Destroy; override;
- function GetInstance: TObject; virtual;
- function GetKey: Integer;
- function GetValue: ICollectable;
- end;
-
- TStringAssociation = class(TInterfacedObject, ICollectable, IStringAssociation)
- private
- FKey: String;
- FValue: ICollectable;
- public
- constructor Create(const Key: String; const Value: ICollectable); virtual;
- destructor Destroy; override;
- function GetInstance: TObject; virtual;
- function GetKey: String;
- function GetValue: ICollectable;
- end;
-
- TAssociationComparator = class(TAbstractComparator, IAssociationComparator)
- private
- FKeyComparator: IComparator;
- public
- constructor Create(NaturalKeys: Boolean = false);
- destructor Destroy; override;
- function GetKeyComparator: IComparator;
- procedure SetKeyComparator(Value: IComparator);
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
- end;
-
- TIntegerAssociationComparator = class(TAbstractComparator, IIntegerAssociationComparator)
- public
- constructor Create;
- destructor Destroy; override;
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- end;
-
- TStringAssociationComparator = class(TAbstractComparator, IStringAssociationComparator)
- public
- constructor Create;
- destructor Destroy; override;
- function Compare(const Item1, Item2: ICollectable): Integer; override;
- function Equals(const Item1, Item2: ICollectable): Boolean; override;
- end;
-
-
-
- TAbstractCollection = class(TInterfacedObject, ICollection)
- private
- FCreated: Boolean; // Required to avoid passing destroyed object reference to exception
- FComparator: IComparator;
- FIgnoreErrors: TCollectionErrors;
- FNaturalItemsOnly: Boolean;
- protected
- procedure CollectionError(ErrorType: TCollectionError);
- procedure InitFrom(const Collection: ICollection); overload; virtual;
- function TrueAdd(const Item: ICollectable): Boolean; virtual; abstract;
- procedure TrueClear; virtual; abstract;
- function TrueContains(const Item: ICollectable): Boolean; virtual; abstract;
- function TrueItemCount(const Item: ICollectable): Integer; virtual;
- function TrueRemove(const Item: ICollectable): ICollectable; virtual; abstract;
- function TrueRemoveAll(const Item: ICollectable): ICollection; virtual; abstract;
- public
- constructor Create; overload; virtual;
- constructor Create(NaturalItemsOnly: Boolean); overload; virtual;
- constructor Create(const ItemArray: array of ICollectable); overload; virtual;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
- constructor Create(const Collection: ICollection); overload; virtual;
- destructor Destroy; override;
- class function GetAlwaysNaturalItems: Boolean; virtual;
- function GetAsArray: TCollectableArray; virtual;
- function GetCapacity: Integer; virtual; abstract;
- procedure SetCapacity(Value: Integer); virtual; abstract;
- function GetComparator: IComparator; virtual;
- procedure SetComparator(const Value: IComparator); virtual;
- function GetDuplicates: Boolean; virtual;
- function GetFixedSize: Boolean; virtual;
- function GetIgnoreErrors: TCollectionErrors;
- procedure SetIgnoreErrors(Value: TCollectionErrors);
- function GetInstance: TObject;
- function GetIterator: IIterator; overload; virtual; abstract;
- function GetIterator(const Filter: IFilter): IIterator; overload; virtual;
- function GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; overload; virtual;
- function GetNaturalItemIID: TGUID; virtual; abstract;
- function GetNaturalItemsOnly: Boolean; virtual;
- function GetSize: Integer; virtual; abstract;
- function GetType: TCollectionType; virtual; abstract;
- function Add(const Item: ICollectable): Boolean; overload; virtual;
- function Add(const ItemArray: array of ICollectable): Integer; overload; virtual;
- function Add(const Collection: ICollection): Integer; overload; virtual;
- procedure AfterConstruction; override;
- procedure BeforeDestruction; override;
- function Clear: Integer; virtual;
- function Clone: ICollection; virtual;
- function Contains(const Item: ICollectable): Boolean; overload; virtual;
- function Contains(const ItemArray: array of ICollectable): Boolean; overload; virtual;
- function Contains(const Collection: ICollection): Boolean; overload; virtual;
- function Equals(const Collection: ICollection): Boolean; virtual;
- function Find(const Filter: IFilter): ICollectable; overload; virtual;
- function Find(FilterFunc: TCollectionFilterFunc): ICollectable; overload; virtual;
- function FindAll(const Filter: IFilter): ICollection; overload; virtual;
- function FindAll(FilterFunc: TCollectionFilterFunc): ICollection; overload; virtual;
- function IsEmpty: Boolean; virtual;
- function IsNaturalItem(const Item: ICollectable): Boolean; virtual;
- function IsNilAllowed: Boolean; virtual; abstract;
- function ItemAllowed(const Item: ICollectable): TCollectionError; virtual;
- function ItemCount(const Item: ICollectable): Integer; overload; virtual;
- function ItemCount(const ItemArray: array of ICollectable): Integer; overload; virtual;
- function ItemCount(const Collection: ICollection): Integer; overload; virtual;
- function Matching(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Matching(const Collection: ICollection): ICollection; overload; virtual;
- function Remove(const Item: ICollectable): ICollectable; overload; virtual;
- function Remove(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Remove(const Collection: ICollection): ICollection; overload; virtual;
- function RemoveAll(const Item: ICollectable): ICollection; overload; virtual;
- function RemoveAll(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function RemoveAll(const Collection: ICollection): ICollection; overload; virtual;
- function Retain(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Retain(const Collection: ICollection): ICollection; overload; virtual;
- property AsArray: TCollectableArray read GetAsArray;
- property Capacity: Integer read GetCapacity write SetCapacity;
- property Comparator: IComparator read GetComparator write SetComparator;
- property FixedSize: Boolean read GetFixedSize;
- property IgnoreErrors: TCollectionErrors read GetIgnoreErrors write SetIgnoreErrors;
- property NaturalItemIID: TGUID read GetNaturalItemIID;
- property NaturalItemsOnly: Boolean read GetNaturalItemsOnly;
- property Size: Integer read GetSize;
- end;
-
- TAbstractBag = class(TAbstractCollection, IBag)
- public
- function CloneAsBag: IBag; virtual;
- function GetNaturalItemIID: TGUID; override;
- function GetType: TCollectionType; override;
- function IsNilAllowed: Boolean; override;
- end;
-
- TAbstractSet = class (TAbstractCollection, ISet)
- protected
- function GetPosition(const Item: ICollectable): TCollectionPosition; virtual; abstract;
- function TrueAdd(const Item: ICollectable): Boolean; override;
- procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); virtual; abstract;
- function TrueContains(const Item: ICollectable): Boolean; override;
- function TrueGet(Position: TCollectionPosition): ICollectable; virtual; abstract;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- procedure TrueRemove2(Position: TCollectionPosition); virtual; abstract;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- public
- function GetDuplicates: Boolean; override;
- function GetNaturalItemIID: TGUID; override;
- function GetType: TCollectionType; override;
- function CloneAsSet: ISet; virtual;
- function Complement(const Universe: ISet): ISet; overload; virtual;
- function Intersect(const Set2: ISet): ISet; overload; virtual;
- function IsNilAllowed: Boolean; override;
- function Union(const Set2: ISet): ISet; overload; virtual;
- end;
-
- TAbstractList = class(TAbstractCollection, IList)
- private
- FDuplicates: Boolean;
- FSorted: Boolean;
- protected
- function BinarySearch(const Item: ICollectable): TSearchResult; virtual;
- procedure InitFrom(const Collection: ICollection); override;
- procedure QuickSort(Lo, Hi: Integer; const Comparator: IComparator); overload; virtual;
- procedure QuickSort(Lo, Hi: Integer; CompareFunc: TCollectionCompareFunc); overload; virtual;
- function SequentialSearch(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; virtual;
- function TrueContains(const Item: ICollectable): Boolean; override;
- function TrueGetItem(Index: Integer): ICollectable; virtual; abstract;
- procedure TrueSetItem(Index: Integer; const Item: ICollectable); virtual; abstract;
- function TrueAdd(const Item: ICollectable): Boolean; override;
- procedure TrueAppend(const Item: ICollectable); virtual; abstract;
- function TrueDelete(Index: Integer): ICollectable; virtual; abstract;
- procedure TrueInsert(Index: Integer; const Item: ICollectable); virtual; abstract;
- function TrueItemCount(const Item: ICollectable): Integer; override;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- function GetDuplicates: Boolean; override;
- procedure SetDuplicates(Value: Boolean); virtual;
- function GetItem(Index: Integer): ICollectable; virtual;
- procedure SetItem(Index: Integer; const Item: ICollectable); virtual;
- function GetIterator: IIterator; override;
- function GetNaturalItemIID: TGUID; override;
- function GetSorted: Boolean; virtual;
- procedure SetSorted(Value: Boolean); virtual;
- function GetType: TCollectionType; override;
- function CloneAsList: IList; virtual;
- function Delete(Index: Integer): ICollectable; virtual;
- procedure Exchange(Index1, Index2: Integer); virtual;
- function First: ICollectable; virtual;
- function IndexOf(const Item: ICollectable): Integer; virtual;
- function Insert(Index: Integer; const Item: ICollectable): Boolean; overload; virtual;
- function Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; overload; virtual;
- function Insert(Index: Integer; const Collection: ICollection): Integer; overload; virtual;
- function IsNilAllowed: Boolean; override;
- function Last: ICollectable; virtual;
- function Search(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; virtual;
- procedure Sort(const SortComparator: IComparator = nil); overload; virtual;
- procedure Sort(CompareFunc: TCollectionCompareFunc); overload; virtual;
- property Duplicates: Boolean read GetDuplicates write SetDuplicates;
- property Items[Index: Integer]: ICollectable read GetItem write SetItem; default;
- property Sorted: Boolean read GetSorted write SetSorted;
- end;
-
- TAbstractMap = class(TAbstractCollection, IMap)
- private
- FAssociationComparator: IAssociationComparator;
- FKeyComparator: IComparator;
- FNaturalKeysOnly: Boolean;
- protected
- function GetAssociationIterator: IMapIterator; virtual; abstract;
- function GetKeyPosition(const Key: ICollectable): TCollectionPosition; virtual; abstract;
- procedure InitFrom(const Collection: ICollection); override;
- function TrueAdd(const Item: ICollectable): Boolean; override;
- function TrueContains(const Item: ICollectable): Boolean; override;
- function TrueGet(Position: TCollectionPosition): IAssociation; virtual; abstract;
- function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; virtual; abstract;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- function TrueRemove2(Position: TCollectionPosition): IAssociation; virtual; abstract;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- property AssociationComparator: IAssociationComparator read FAssociationComparator;
- public
- constructor Create; override;
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
- constructor Create(const ItemArray: array of ICollectable); overload; override;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
- constructor Create(const KeyArray, ItemArray: array of ICollectable); overload; virtual;
- constructor Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
- constructor Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
-// Don't use this parameter signature as it hits a compiler bug in D5.
-// constructor Create(const KeyArray, ItemArray: TCollectableArray; NaturalItemsOnly: Boolean = false; NaturalKeysOnly: Boolean = true); overload; virtual;
- constructor Create(const Map: IMap); overload; virtual;
- destructor Destroy; override;
- class function GetAlwaysNaturalKeys: Boolean; virtual;
- function GetItem(const Key: ICollectable): ICollectable; virtual;
- procedure SetItem(const Key, Item: ICollectable); virtual;
- function GetIterator: IIterator; override;
- function GetKeyComparator: IComparator; virtual;
- procedure SetKeyComparator(const Value: IComparator); virtual;
- function GetKeyIterator: IIterator; virtual;
- function GetKeys: ISet; virtual;
- function GetMapIterator: IMapIterator; virtual;
- function GetMapIteratorByKey(const Filter: IFilter): IMapIterator; overload; virtual;
- function GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; overload; virtual;
- function GetNaturalItemIID: TGUID; override;
- function GetNaturalKeyIID: TGUID; virtual;
- function GetNaturalKeysOnly: Boolean; virtual;
- function GetType: TCollectionType; override;
- function GetValues: ICollection; virtual;
- function Clone: ICollection; override;
- function CloneAsMap: IMap; virtual;
- function ContainsKey(const Key: ICollectable): Boolean; overload; virtual;
- function ContainsKey(const KeyArray: array of ICollectable): Boolean; overload; virtual;
- function ContainsKey(const Collection: ICollection): Boolean; overload; virtual;
- function Get(const Key: ICollectable): ICollectable; virtual;
- function KeyAllowed(const Key: ICollectable): TCollectionError; virtual;
- function IsNaturalKey(const Key: ICollectable): Boolean; virtual;
- function IsNilAllowed: Boolean; override;
- function MatchingKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
- function MatchingKey(const Collection: ICollection): ICollection; overload; virtual;
- function Put(const Item: ICollectable): ICollectable; overload; virtual;
- function Put(const Key, Item: ICollectable): ICollectable; overload; virtual;
- function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Put(const Collection: ICollection): ICollection; overload; virtual;
- function Put(const Map: IMap): ICollection; overload; virtual;
- function RemoveKey(const Key: ICollectable): ICollectable; overload; virtual;
- function RemoveKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
- function RemoveKey(const Collection: ICollection): ICollection; overload; virtual;
- function RetainKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
- function RetainKey(const Collection: ICollection): ICollection; overload; virtual;
- property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
- property Items[const Key: ICollectable]: ICollectable read GetItem write SetItem; default;
- property NaturalKeyIID: TGUID read GetNaturalKeyIID;
- property NaturalKeysOnly: Boolean read GetNaturalKeysOnly;
- end;
-
- TAbstractIntegerMap = class(TAbstractCollection, IIntegerMap)
- private
- FAssociationComparator: IIntegerAssociationComparator;
- protected
- function GetAssociationIterator: IIntegerMapIterator; virtual; abstract;
- function GetKeyPosition(const Key: Integer): TCollectionPosition; virtual; abstract;
- function TrueAdd(const Item: ICollectable): Boolean; override;
- function TrueContains(const Item: ICollectable): Boolean; override;
- function TrueGet(Position: TCollectionPosition): IIntegerAssociation; virtual; abstract;
- function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; virtual; abstract;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; virtual; abstract;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- property AssociationComparator: IIntegerAssociationComparator read FAssociationComparator;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(const ItemArray: array of ICollectable); overload; override;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
- constructor Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable); overload; virtual;
- constructor Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
- constructor Create(const Map: IIntegerMap); overload; virtual;
- destructor Destroy; override;
- function GetItem(const Key: Integer): ICollectable; virtual;
- procedure SetItem(const Key: Integer; const Item: ICollectable); virtual;
- function GetIterator: IIterator; override;
- function GetKeys: ISet; virtual;
- function GetMapIterator: IIntegerMapIterator; virtual;
- function GetNaturalItemIID: TGUID; override;
- function GetType: TCollectionType; override;
- function GetValues: ICollection; virtual;
- function Clone: ICollection; override;
- function CloneAsIntegerMap: IIntegerMap; virtual;
- function ContainsKey(const Key: Integer): Boolean; overload; virtual;
- function ContainsKey(const KeyArray: array of Integer): Boolean; overload; virtual;
- function Get(const Key: Integer): ICollectable; virtual;
- function IsNilAllowed: Boolean; override;
- function Put(const Item: ICollectable): ICollectable; overload; virtual;
- function Put(const Key: Integer; const Item: ICollectable): ICollectable; overload; virtual;
- function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Put(const Collection: ICollection): ICollection; overload; virtual;
- function Put(const Map: IIntegerMap): ICollection; overload; virtual;
- function RemoveKey(const Key: Integer): ICollectable; overload; virtual;
- function RemoveKey(const KeyArray: array of Integer): ICollection; overload; virtual;
- function RetainKey(const KeyArray: array of Integer): ICollection; overload; virtual;
- property Items[const Key: Integer]: ICollectable read GetItem write SetItem; default;
- end;
-
- TAbstractStringMap = class(TAbstractCollection, IStringMap)
- private
- FAssociationComparator: IStringAssociationComparator;
- protected
- function GetAssociationIterator: IStringMapIterator; virtual; abstract;
- function GetKeyPosition(const Key: String): TCollectionPosition; virtual; abstract;
- function TrueAdd(const Item: ICollectable): Boolean; override;
- function TrueContains(const Item: ICollectable): Boolean; override;
- function TrueGet(Position: TCollectionPosition): IStringAssociation; virtual; abstract;
- function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; virtual; abstract;
- function TrueRemove(const Item: ICollectable): ICollectable; override;
- function TrueRemove2(Position: TCollectionPosition): IStringAssociation; virtual; abstract;
- function TrueRemoveAll(const Item: ICollectable): ICollection; override;
- property AssociationComparator: IStringAssociationComparator read FAssociationComparator;
- public
- constructor Create(NaturalItemsOnly: Boolean); override;
- constructor Create(const ItemArray: array of ICollectable); overload; override;
- constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
- constructor Create(const KeyArray: array of String; const ItemArray: array of ICollectable); overload; virtual;
- constructor Create(const KeyArray: array of String; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
- constructor Create(const Map: IStringMap); overload; virtual;
- destructor Destroy; override;
- function GetItem(const Key: String): ICollectable; virtual;
- procedure SetItem(const Key: String; const Item: ICollectable); virtual;
- function GetIterator: IIterator; override;
- function GetKeys: ISet; virtual;
- function GetMapIterator: IStringMapIterator; virtual;
- function GetNaturalItemIID: TGUID; override;
- function GetType: TCollectionType; override;
- function GetValues: ICollection; virtual;
- function Clone: ICollection; override;
- function CloneAsStringMap: IStringMap; virtual;
- function ContainsKey(const Key: String): Boolean; overload; virtual;
- function ContainsKey(const KeyArray: array of String): Boolean; overload; virtual;
- function Get(const Key: String): ICollectable; virtual;
- function IsNilAllowed: Boolean; override;
- function Put(const Item: ICollectable): ICollectable; overload; virtual;
- function Put(const Key: String; const Item: ICollectable): ICollectable; overload; virtual;
- function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
- function Put(const Collection: ICollection): ICollection; overload; virtual;
- function Put(const Map: IStringMap): ICollection; overload; virtual;
- function RemoveKey(const Key: String): ICollectable; overload; virtual;
- function RemoveKey(const KeyArray: array of String): ICollection; overload; virtual;
- function RetainKey(const KeyArray: array of String): ICollection; overload; virtual;
- property Items[const Key: String]: ICollectable read GetItem write SetItem; default;
- end;
-
- TAbstractCollectionClass = class of TAbstractCollection;
- TAbstractBagClass = class of TAbstractBag;
- TAbstractSetClass = class of TAbstractSet;
- TAbstractListClass = class of TAbstractList;
- TAbstractMapClass = class of TAbstractMap;
- TAbstractIntegerMapClass = class of TAbstractIntegerMap;
- TAbstractStringMapClass = class of TAbstractStringMap;
-
- TAbstractIterator = class(TInterfacedObject, IIterator)
- private
- FAllowRemoval: Boolean;
- FEOF: Boolean;
- FItem: ICollectable;
- protected
- constructor Create(AllowRemoval: Boolean = true);
- function TrueFirst: ICollectable; virtual; abstract;
- function TrueNext: ICollectable; virtual; abstract;
- procedure TrueRemove; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function GetAllowRemoval: Boolean; virtual;
- function CurrentItem: ICollectable; virtual;
- function EOF: Boolean; virtual;
- function First: ICollectable; virtual;
- function Next: ICollectable; virtual;
- function Remove: Boolean; virtual;
- property AllowRemoval: Boolean read GetAllowRemoval;
- end;
-
- TAbstractListIterator = class(TAbstractIterator)
- private
- FCollection: TAbstractList;
- FIndex: Integer;
- protected
- constructor Create(Collection: TAbstractList);
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- end;
-
- TAbstractMapIterator = class(TAbstractIterator, IMapIterator)
- public
- function CurrentKey: ICollectable; virtual; abstract;
- end;
-
- TAbstractAssociationIterator = class(TInterfacedObject, IIterator, IMapIterator)
- private
- FAllowRemoval: Boolean;
- FEOF: Boolean;
- FAssociation: IAssociation;
- protected
- constructor Create(AllowRemoval: Boolean = true);
- function TrueFirst: IAssociation; virtual; abstract;
- function TrueNext: IAssociation; virtual; abstract;
- procedure TrueRemove; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function GetAllowRemoval: Boolean; virtual;
- function CurrentKey: ICollectable; virtual;
- function CurrentItem: ICollectable; virtual;
- function EOF: Boolean; virtual;
- function First: ICollectable; virtual;
- function Next: ICollectable; virtual;
- function Remove: Boolean; virtual;
- property AllowRemoval: Boolean read GetAllowRemoval;
- end;
-
- TAbstractIntegerAssociationIterator = class(TInterfacedObject, IIterator, IIntegerMapIterator)
- private
- FAllowRemoval: Boolean;
- FEOF: Boolean;
- FAssociation: IIntegerAssociation;
- protected
- constructor Create(AllowRemoval: Boolean = true);
- function TrueFirst: IIntegerAssociation; virtual; abstract;
- function TrueNext: IIntegerAssociation; virtual; abstract;
- procedure TrueRemove; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function GetAllowRemoval: Boolean; virtual;
- function CurrentKey: Integer; virtual;
- function CurrentItem: ICollectable; virtual;
- function EOF: Boolean; virtual;
- function First: ICollectable; virtual;
- function Next: ICollectable; virtual;
- function Remove: Boolean; virtual;
- property AllowRemoval: Boolean read GetAllowRemoval;
- end;
-
- TAbstractStringAssociationIterator = class(TInterfacedObject, IIterator, IStringMapIterator)
- private
- FAllowRemoval: Boolean;
- FEOF: Boolean;
- FAssociation: IStringAssociation;
- protected
- constructor Create(AllowRemoval: Boolean = true);
- function TrueFirst: IStringAssociation; virtual; abstract;
- function TrueNext: IStringAssociation; virtual; abstract;
- procedure TrueRemove; virtual; abstract;
- public
- procedure AfterConstruction; override;
- function GetAllowRemoval: Boolean; virtual;
- function CurrentKey: String; virtual;
- function CurrentItem: ICollectable; virtual;
- function EOF: Boolean; virtual;
- function First: ICollectable; virtual;
- function Next: ICollectable; virtual;
- function Remove: Boolean; virtual;
- property AllowRemoval: Boolean read GetAllowRemoval;
- end;
-
- TAssociationIterator = class(TAbstractIterator, IMapIterator)
- private
- FIterator: IIterator;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IIterator);
- destructor Destroy; override;
- function CurrentItem: ICollectable; override;
- function CurrentKey: ICollectable; virtual;
- end;
-
- TAssociationKeyIterator = class(TAbstractIterator)
- private
- FIterator: IMapIterator;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IMapIterator);
- destructor Destroy; override;
- end;
-
- TAbstractFilter = class(TInterfacedObject, IFilter)
- public
- function Accept(const Item: ICollectable): Boolean; virtual; abstract;
- end;
-
- TFilterIterator = class(TAbstractIterator)
- private
- FIterator: IIterator;
- FFilter: IFilter;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IIterator; const Filter: IFilter; AllowRemoval: Boolean = true); virtual;
- destructor Destroy; override;
- end;
-
- TFilterFuncIterator = class(TAbstractIterator)
- private
- FIterator: IIterator;
- FFilterFunc: TCollectionFilterFunc;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); virtual;
- destructor Destroy; override;
- end;
-
- TKeyFilterMapIterator = class(TAbstractMapIterator)
- private
- FIterator: IMapIterator;
- FFilter: IFilter;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IMapIterator; const Filter: IFilter; AllowRemoval: Boolean = true); virtual;
- destructor Destroy; override;
- function CurrentKey: ICollectable; override;
- end;
-
- TKeyFilterFuncMapIterator = class(TAbstractMapIterator)
- private
- FIterator: IMapIterator;
- FFilterFunc: TCollectionFilterFunc;
- protected
- function TrueFirst: ICollectable; override;
- function TrueNext: ICollectable; override;
- procedure TrueRemove; override;
- public
- constructor Create(const Iterator: IMapIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); virtual;
- destructor Destroy; override;
- function CurrentKey: ICollectable; override;
- end;
-
-
- ECollectionError = class(Exception)
- private
- FCollection: ICollection;
- FErrorType: TCollectionError;
- public
- constructor Create(const Msg: String; const Collection: ICollection; ErrorType: TCollectionError);
- property Collection: ICollection read FCollection;
- property ErrorType: TCollectionError read FErrorType;
- end;
-
-implementation
-
-uses
- Math,
- CollArray, CollHash, CollList, CollPArray, CollWrappers;
-
-var
- FDefaultComparator: IComparator;
- FNaturalComparator: IComparator;
- FReverseNaturalComparator: IComparator;
-
-{ TCollectionPosition }
-constructor TCollectionPosition.Create(Found: Boolean);
-begin
- FFound := Found;
-end;
-
-{ TAbstractComparator }
-class function TAbstractComparator.GetDefaultComparator: IComparator;
-begin
- if FDefaultComparator = nil then
- FDefaultComparator := TDefaultComparator.Create;
- Result := FDefaultComparator;
-end;
-
-class function TAbstractComparator.GetNaturalComparator: IComparator;
-begin
- if FNaturalComparator = nil then
- FNaturalComparator := TNaturalComparator.Create;
- Result := FNaturalComparator;
-end;
-
-class function TAbstractComparator.GetReverseNaturalComparator: IComparator;
-begin
- if FReverseNaturalComparator = nil then
- FReverseNaturalComparator := TReverseNaturalComparator.Create;
- Result := FReverseNaturalComparator;
-end;
-
-function TAbstractComparator.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-function TAbstractComparator.Equals(const Comparator: IComparator): Boolean;
-begin
- Result := (Self = Comparator.GetInstance);
-end;
-
-{ TDefaultComparator }
-constructor TDefaultComparator.Create;
-begin
- // Empty
-end;
-
-function TDefaultComparator.Compare(const Item1, Item2: ICollectable): Integer;
-var
- Value1, Value2: Integer;
-begin
- if Item1 <> nil then
- Value1 := Integer(Pointer(Item1))
- else
- Value1 := Low(Integer);
- if Item2 <> nil then
- Value2 := Integer(Pointer(Item2))
- else
- Value2 := Low(Integer);
- if (Value1 < Value2) then
- Result := -1
- else if (Value1 > Value2) then
- Result := 1
- else
- Result := 0;
-end;
-
-function TDefaultComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- Result := (Item1 = Item2);
-end;
-
-{ TNaturalComparator }
-constructor TNaturalComparator.Create;
-begin
- // Empty
-end;
-
-function TNaturalComparator.Compare(const Item1, Item2: ICollectable): Integer;
-begin
- if (Item1 = nil) and (Item2 <> nil) then
- Result := -1
- else if (Item1 <> nil) and (Item2 = nil) then
- Result := 1
- else if (Item1 = nil) and (Item2 = nil) then
- Result := 0
- else
- Result := (Item1 as IComparable).CompareTo(Item2);
-end;
-
-function TNaturalComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- if (Item1 = nil) or (Item2 = nil) then
- Result := (Item1 = Item2)
- else
- begin
- Result := (Item1 as IEquatable).Equals(Item2);
- end;
-end;
-
-{ TReverseNaturalComparator }
-constructor TReverseNaturalComparator.Create;
-begin
- // Empty
-end;
-
-function TReverseNaturalComparator.Compare(const Item1, Item2: ICollectable): Integer;
-begin
- if (Item1 = nil) and (Item2 <> nil) then
- Result := 1
- else if (Item1 <> nil) and (Item2 = nil) then
- Result := -1
- else if (Item1 = nil) and (Item2 = nil) then
- Result := 0
- else
- Result := -(Item1 as IComparable).CompareTo(Item2);
-end;
-
-function TReverseNaturalComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- if (Item1 = nil) or (Item2 = nil) then
- Result := (Item1 = Item2)
- else
- Result := (Item1 as IEquatable).Equals(Item2);
-end;
-
-{ TAssociation }
-constructor TAssociation.Create(const Key, Value: ICollectable);
-begin
- FKey := Key;
- FValue := Value;
-end;
-
-destructor TAssociation.Destroy;
-begin
- FKey := nil;
- FValue := nil;
- inherited Destroy;
-end;
-
-function TAssociation.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-function TAssociation.GetKey: ICollectable;
-begin
- Result := FKey;
-end;
-
-function TAssociation.GetValue: ICollectable;
-begin
- Result := FValue;
-end;
-
-
-{ TIntegerAssociation }
-constructor TIntegerAssociation.Create(const Key: Integer; const Value: ICollectable);
-begin
- FKey := Key;
- FValue := Value;
-end;
-
-destructor TIntegerAssociation.Destroy;
-begin
- FValue := nil;
- inherited Destroy;
-end;
-
-function TIntegerAssociation.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-function TIntegerAssociation.GetKey: Integer;
-begin
- Result := FKey;
-end;
-
-function TIntegerAssociation.GetValue: ICollectable;
-begin
- Result := FValue;
-end;
-
-
-{ TStringAssociation }
-constructor TStringAssociation.Create(const Key: String; const Value: ICollectable);
-begin
- FKey := Key;
- FValue := Value;
-end;
-
-destructor TStringAssociation.Destroy;
-begin
- FValue := nil;
- inherited Destroy;
-end;
-
-function TStringAssociation.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-function TStringAssociation.GetKey: String;
-begin
- Result := FKey;
-end;
-
-function TStringAssociation.GetValue: ICollectable;
-begin
- Result := FValue;
-end;
-
-
-{ TAbstractIterator }
-constructor TAbstractIterator.Create(AllowRemoval: Boolean);
-begin
- inherited Create;
- FAllowRemoval := AllowRemoval;
- FEOF := true;
- FItem := nil;
-end;
-
-procedure TAbstractIterator.AfterConstruction;
-begin
- inherited AfterConstruction;
- First;
-end;
-
-function TAbstractIterator.GetAllowRemoval: Boolean;
-begin
- Result := FAllowRemoval;
-end;
-
-function TAbstractIterator.CurrentItem: ICollectable;
-begin
- Result := FItem;
-end;
-
-function TAbstractIterator.EOF: Boolean;
-begin
- Result := FEOF;
-end;
-
-function TAbstractIterator.First: ICollectable;
-begin
- FEOF := false;
- FItem := TrueFirst;
- if FItem = nil then
- FEOF := true;
- Result := FItem;
-end;
-
-function TAbstractIterator.Next: ICollectable;
-begin
- if not FEOF then
- begin
- FItem := TrueNext;
- if FItem = nil then
- FEOF := true;
- end;
- Result := FItem;
-end;
-
-function TAbstractIterator.Remove: Boolean;
-begin
- if (FItem <> nil) and FAllowRemoval then
- begin
- TrueRemove;
- FItem := nil;
- Result := true;
- end
- else
- Result := false;
-end;
-
-{ TAbstractAssociationIterator }
-constructor TAbstractAssociationIterator.Create(AllowRemoval: Boolean);
-begin
- inherited Create;
- FAllowRemoval := AllowRemoval;
- FEOF := true;
- FAssociation := nil;
-end;
-
-procedure TAbstractAssociationIterator.AfterConstruction;
-begin
- inherited AfterConstruction;
- First;
-end;
-
-function TAbstractAssociationIterator.GetAllowRemoval: Boolean;
-begin
- Result := FAllowRemoval;
-end;
-
-function TAbstractAssociationIterator.CurrentKey: ICollectable;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetKey
- else
- Result := nil;
-end;
-
-function TAbstractAssociationIterator.CurrentItem: ICollectable;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- Result := nil;
-end;
-
-function TAbstractAssociationIterator.EOF: Boolean;
-begin
- Result := FEOF;
-end;
-
-function TAbstractAssociationIterator.First: ICollectable;
-begin
- FAssociation := TrueFirst;
- if FAssociation <> nil then
- begin
- Result := FAssociation.GetValue;
- FEOF := false;
- end
- else
- begin
- Result := nil;
- FEOF := true;
- end;
-end;
-
-function TAbstractAssociationIterator.Next: ICollectable;
-begin
- if not FEOF then
- begin
- FAssociation := TrueNext;
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- begin
- Result := nil;
- FEOF := true;
- end;
- end;
-end;
-
-function TAbstractAssociationIterator.Remove: Boolean;
-begin
- if (FAssociation <> nil) and FAllowRemoval then
- begin
- TrueRemove;
- FAssociation := nil;
- Result := true;
- end
- else
- Result := false;
-end;
-
-{ TAbstractIntegerAssociationIterator }
-constructor TAbstractIntegerAssociationIterator.Create(AllowRemoval: Boolean);
-begin
- inherited Create;
- FAllowRemoval := AllowRemoval;
- FEOF := true;
- FAssociation := nil;
-end;
-
-procedure TAbstractIntegerAssociationIterator.AfterConstruction;
-begin
- inherited AfterConstruction;
- First;
-end;
-
-function TAbstractIntegerAssociationIterator.GetAllowRemoval: Boolean;
-begin
- Result := FAllowRemoval;
-end;
-
-function TAbstractIntegerAssociationIterator.CurrentKey: Integer;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetKey
- else
- Result := 0;
-end;
-
-function TAbstractIntegerAssociationIterator.CurrentItem: ICollectable;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- Result := nil;
-end;
-
-function TAbstractIntegerAssociationIterator.EOF: Boolean;
-begin
- Result := FEOF;
-end;
-
-function TAbstractIntegerAssociationIterator.First: ICollectable;
-begin
- FAssociation := TrueFirst;
- if FAssociation <> nil then
- begin
- Result := FAssociation.GetValue;
- FEOF := false;
- end
- else
- begin
- Result := nil;
- FEOF := true;
- end;
-end;
-
-function TAbstractIntegerAssociationIterator.Next: ICollectable;
-begin
- if not FEOF then
- begin
- FAssociation := TrueNext;
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- begin
- Result := nil;
- FEOF := true;
- end;
- end;
-end;
-
-function TAbstractIntegerAssociationIterator.Remove: Boolean;
-begin
- if (FAssociation <> nil) and FAllowRemoval then
- begin
- TrueRemove;
- FAssociation := nil;
- Result := true;
- end
- else
- Result := false;
-end;
-
-{ TAbstractStringAssociationIterator }
-constructor TAbstractStringAssociationIterator.Create(AllowRemoval: Boolean);
-begin
- inherited Create;
- FAllowRemoval := AllowRemoval;
- FEOF := true;
- FAssociation := nil;
-end;
-
-procedure TAbstractStringAssociationIterator.AfterConstruction;
-begin
- inherited AfterConstruction;
- First;
-end;
-
-function TAbstractStringAssociationIterator.GetAllowRemoval: Boolean;
-begin
- Result := FAllowRemoval;
-end;
-
-function TAbstractStringAssociationIterator.CurrentKey: String;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetKey
- else
- Result := '';
-end;
-
-function TAbstractStringAssociationIterator.CurrentItem: ICollectable;
-begin
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- Result := nil;
-end;
-
-function TAbstractStringAssociationIterator.EOF: Boolean;
-begin
- Result := FEOF;
-end;
-
-function TAbstractStringAssociationIterator.First: ICollectable;
-begin
- FAssociation := TrueFirst;
- if FAssociation <> nil then
- begin
- Result := FAssociation.GetValue;
- FEOF := false;
- end
- else
- begin
- Result := nil;
- FEOF := true;
- end;
-end;
-
-function TAbstractStringAssociationIterator.Next: ICollectable;
-begin
- if not FEOF then
- begin
- FAssociation := TrueNext;
- if FAssociation <> nil then
- Result := FAssociation.GetValue
- else
- begin
- Result := nil;
- FEOF := true;
- end;
- end;
-end;
-
-function TAbstractStringAssociationIterator.Remove: Boolean;
-begin
- if (FAssociation <> nil) and FAllowRemoval then
- begin
- TrueRemove;
- FAssociation := nil;
- Result := true;
- end
- else
- Result := false;
-end;
-
-{ TAssociationIterator }
-constructor TAssociationIterator.Create(const Iterator: IIterator);
-begin
- inherited Create(Iterator.GetAllowRemoval);
- FIterator := Iterator;
-end;
-
-destructor TAssociationIterator.Destroy;
-begin
- FIterator := nil;
- inherited Destroy;
-end;
-
-function TAssociationIterator.TrueFirst: ICollectable;
-var
- Association: IAssociation;
-begin
- Association := FIterator.First as IAssociation;
- if Association <> nil then
- Result := Association.GetValue
- else
- Result := nil;
-end;
-
-function TAssociationIterator.TrueNext: ICollectable;
-var
- Association: IAssociation;
-begin
- Association := (FIterator.Next as IAssociation);
- if Association <> nil then
- Result := Association.GetValue
- else
- Result := nil;
-end;
-
-procedure TAssociationIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-function TAssociationIterator.CurrentItem: ICollectable;
-var
- Association: IAssociation;
-begin
- Association := FIterator.CurrentItem as IAssociation;
- if Association <> nil then
- Result := Association.GetValue
- else
- Result := nil;
-end;
-
-function TAssociationIterator.CurrentKey: ICollectable;
-var
- Association: IAssociation;
-begin
- Association := FIterator.CurrentItem as IAssociation;
- if Association <> nil then
- Result := Association.GetKey
- else
- Result := nil;
-end;
-
-{ TAssociationComparator }
-constructor TAssociationComparator.Create(NaturalKeys: Boolean);
-begin
- inherited Create;
- if NaturalKeys then
- FKeyComparator := TAbstractComparator.GetNaturalComparator
- else
- FKeyComparator := TAbstractComparator.GetDefaultComparator;
-end;
-
-destructor TAssociationComparator.Destroy;
-begin
- FKeyComparator := nil;
- inherited Destroy;
-end;
-
-function TAssociationComparator.GetKeyComparator: IComparator;
-begin
- Result := FKeyComparator;
-end;
-
-procedure TAssociationComparator.SetKeyComparator(Value: IComparator);
-begin
- FKeyComparator := Value;
-end;
-
-function TAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
-begin
- Result := KeyComparator.Compare((Item1 as IAssociation).GetKey, (Item2 as IAssociation).GetKey);
-end;
-
-function TAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- Result := KeyComparator.Equals((Item1 as IAssociation).GetKey, (Item2 as IAssociation).GetKey);
-end;
-
-{ TIntegerAssociationComparator }
-constructor TIntegerAssociationComparator.Create;
-begin
- inherited Create;
-end;
-
-destructor TIntegerAssociationComparator.Destroy;
-begin
- inherited Destroy;
-end;
-
-function TIntegerAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
-var
- Key1, Key2: Integer;
-begin
- Key1 := (Item1 as IIntegerAssociation).GetKey;
- Key2 := (Item2 as IIntegerAssociation).GetKey;
- if Key1 < Key2 then
- Result := -1
- else if Key1 > Key2 then
- Result := 1
- else
- Result := 0;
-end;
-
-function TIntegerAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- Result := ((Item1 as IIntegerAssociation).GetKey = (Item2 as IIntegerAssociation).GetKey);
-end;
-
-{ TStringAssociationComparator }
-constructor TStringAssociationComparator.Create;
-begin
- inherited Create;
-end;
-
-destructor TStringAssociationComparator.Destroy;
-begin
- inherited Destroy;
-end;
-
-function TStringAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
-var
- Key1, Key2: String;
-begin
- Key1 := (Item1 as IStringAssociation).GetKey;
- Key2 := (Item2 as IStringAssociation).GetKey;
- if Key1 < Key2 then
- Result := -1
- else if Key1 > Key2 then
- Result := 1
- else
- Result := 0;
-end;
-
-function TStringAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
-begin
- Result := ((Item1 as IStringAssociation).GetKey = (Item2 as IStringAssociation).GetKey);
-end;
-
-{ TAssociationKeyIterator }
-constructor TAssociationKeyIterator.Create(const Iterator: IMapIterator);
-begin
- inherited Create(Iterator.GetAllowRemoval);
- FIterator := Iterator;
-end;
-
-destructor TAssociationKeyIterator.Destroy;
-begin
- FIterator := nil;
- inherited Destroy;
-end;
-
-function TAssociationKeyIterator.TrueFirst: ICollectable;
-begin
- FIterator.First;
- Result := FIterator.CurrentKey;
-end;
-
-function TAssociationKeyIterator.TrueNext: ICollectable;
-begin
- FIterator.Next;
- Result := FIterator.CurrentKey;
-end;
-
-procedure TAssociationKeyIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-{ TFilterIterator }
-constructor TFilterIterator.Create(const Iterator: IIterator; const Filter: IFilter; AllowRemoval: Boolean = true);
-begin
- FIterator := Iterator;
- FFilter := Filter;
-end;
-
-destructor TFilterIterator.Destroy;
-begin
- FIterator := nil;
- FFilter := nil;
-end;
-
-function TFilterIterator.TrueFirst: ICollectable;
-var
- Item: ICollectable;
-begin
- Item := FIterator.First;
- while not FIterator.EOF do
- begin
- if FFilter.Accept(Item) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-function TFilterIterator.TrueNext: ICollectable;
-var
- Item: ICollectable;
-begin
- Item := FIterator.Next;
- while not FIterator.EOF do
- begin
- if FFilter.Accept(Item) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-procedure TFilterIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-{ TFilterFuncIterator }
-constructor TFilterFuncIterator.Create(const Iterator: IIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true);
-begin
- FIterator := Iterator;
- FFilterFunc := FilterFunc;
-end;
-
-destructor TFilterFuncIterator.Destroy;
-begin
- FIterator := nil;
- FFilterFunc := nil;
-end;
-
-function TFilterFuncIterator.TrueFirst: ICollectable;
-var
- Item: ICollectable;
-begin
- Item := FIterator.First;
- while not FIterator.EOF do
- begin
- if FFilterFunc(Item) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-function TFilterFuncIterator.TrueNext: ICollectable;
-var
- Item: ICollectable;
-begin
- Item := FIterator.Next;
- while not FIterator.EOF do
- begin
- if FFilterFunc(Item) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-procedure TFilterFuncIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-{ TKeyFilterMapIterator }
-constructor TKeyFilterMapIterator.Create(const Iterator: IMapIterator; const Filter: IFilter; AllowRemoval: Boolean = true);
-begin
- FIterator := Iterator;
- FFilter := Filter;
-end;
-
-destructor TKeyFilterMapIterator.Destroy;
-begin
- FIterator := nil;
- FFilter := nil;
-end;
-
-function TKeyFilterMapIterator.TrueFirst: ICollectable;
-var
- Key, Item: ICollectable;
-begin
- Item := FIterator.First;
- while not FIterator.EOF do
- begin
- Key := FIterator.CurrentKey;
- if FFilter.Accept(Key) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-function TKeyFilterMapIterator.TrueNext: ICollectable;
-var
- Key, Item: ICollectable;
-begin
- Item := FIterator.Next;
- while not FIterator.EOF do
- begin
- Key := FIterator.CurrentKey;
- if FFilter.Accept(Key) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-procedure TKeyFilterMapIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-function TKeyFilterMapIterator.CurrentKey: ICollectable;
-begin
- Result := FIterator.CurrentKey;
-end;
-
-{ TKeyFilterFuncMapIterator }
-constructor TKeyFilterFuncMapIterator.Create(const Iterator: IMapIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true);
-begin
- FIterator := Iterator;
- FFilterFunc := FilterFunc;
-end;
-
-destructor TKeyFilterFuncMapIterator.Destroy;
-begin
- FIterator := nil;
- FFilterFunc := nil;
-end;
-
-function TKeyFilterFuncMapIterator.TrueFirst: ICollectable;
-var
- Key, Item: ICollectable;
-begin
- Item := FIterator.First;
- while not FIterator.EOF do
- begin
- Key := FIterator.CurrentKey;
- if FFilterFunc(Key) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-function TKeyFilterFuncMapIterator.TrueNext: ICollectable;
-var
- Key, Item: ICollectable;
-begin
- Item := FIterator.Next;
- while not FIterator.EOF do
- begin
- Key := FIterator.CurrentKey;
- if FFilterFunc(Key) then
- break
- else
- Item := FIterator.Next;
- end;
- Result := Item;
-end;
-
-procedure TKeyFilterFuncMapIterator.TrueRemove;
-begin
- FIterator.Remove;
-end;
-
-function TKeyFilterFuncMapIterator.CurrentKey: ICollectable;
-begin
- Result := FIterator.CurrentKey;
-end;
-
-
-{ TAbstractCollection }
-constructor TAbstractCollection.Create;
-begin
- Create(false);
-end;
-
-constructor TAbstractCollection.Create(NaturalItemsOnly: Boolean);
-begin
- FCreated := false;
- inherited Create;
- FNaturalItemsOnly := NaturalItemsOnly or GetAlwaysNaturalItems;
- if FNaturalItemsOnly then
- FComparator := TAbstractComparator.GetNaturalComparator
- else
- FComparator := TAbstractComparator.GetDefaultComparator;
- FIgnoreErrors := [ceDuplicate];
-end;
-
-constructor TAbstractCollection.Create(const ItemArray: array of ICollectable);
-begin
- Create(ItemArray, false);
-end;
-
-// Fixed size collections must override this.
-constructor TAbstractCollection.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-var
- I: Integer;
-begin
- Create(NaturalItemsOnly);
- if not FixedSize then
- begin
- Capacity := Length(ItemArray);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Add(ItemArray[I]);
- end;
- end;
-end;
-
-// Fixed size collections must override this.
-constructor TAbstractCollection.Create(const Collection: ICollection);
-var
- Iterator: IIterator;
-begin
- Create(Collection.GetNaturalItemsOnly);
- InitFrom(Collection);
- if not FixedSize then
- begin
- Capacity := Collection.GetSize;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- end;
-end;
-
-destructor TAbstractCollection.Destroy;
-begin
- FCreated := false;
- FComparator := nil;
- inherited Destroy;
-end;
-
-procedure TAbstractCollection.CollectionError(ErrorType: TCollectionError);
-var
- Msg: String;
-begin
- if not (ErrorType in FIgnoreErrors) then
- begin
- case ErrorType of
- ceDuplicate: Msg := 'Collection does not allow duplicates.';
- ceDuplicateKey: Msg := 'Collection does not allow duplicate keys.';
- ceFixedSize: Msg := 'Collection has fixed size.';
- ceNilNotAllowed: Msg := 'Collection does not allow nil.';
- ceNotNaturalItem: Msg := 'Collection only accepts natural items.';
- ceOutOfRange: Msg := 'Index out of collection range.';
- end;
- // If exception is thrown during construction, collection cannot be
- // passed to it as destructor is automatically called and this leaves an
- // interface reference to a destroyed object and crashes.
- if FCreated then
- raise ECollectionError.Create(Msg, Self, ErrorType)
- else
- raise ECollectionError.Create(Msg, nil, ErrorType);
- end;
-end;
-
-procedure TAbstractCollection.InitFrom(const Collection: ICollection);
-begin
- Comparator := Collection.GetComparator;
- IgnoreErrors := Collection.GetIgnoreErrors;
-end;
-
-// Implementations should override this if possible
-function TAbstractCollection.TrueItemCount(const Item: ICollectable): Integer;
-var
- Iterator: IIterator;
- Total: Integer;
-begin
- Total := 0;
- Iterator := GetIterator;
- while not Iterator.EOF do
- begin
- if FComparator.Equals(Item, Iterator.CurrentItem) then
- Inc(Total);
- Iterator.Next;
- end;
- Result := Total;
-end;
-
-class function TAbstractCollection.GetAlwaysNaturalItems: Boolean;
-begin
- Result := false;
-end;
-
-function TAbstractCollection.GetAsArray: TCollectableArray;
-var
- Iterator: IIterator;
- Working: TCollectableArray;
- I: Integer;
-begin
- SetLength(Working, Size);
- I := 0;
- Iterator := GetIterator;
- while not Iterator.EOF do
- begin
- Working[I] := Iterator.CurrentItem;
- Inc(I);
- Iterator.Next;
- end;
- Result := Working;
-end;
-
-function TAbstractCollection.GetComparator: IComparator;
-begin
- Result := FComparator;
-end;
-
-function TAbstractCollection.GetDuplicates: Boolean;
-begin
- Result := true; // Sets and lists override this.
-end;
-
-procedure TAbstractCollection.SetComparator(const Value: IComparator);
-begin
- if Value = nil then
- begin
- if NaturalItemsOnly then
- FComparator := TAbstractComparator.GetNaturalComparator
- else
- FComparator := TAbstractComparator.GetDefaultComparator;
- end
- else
- FComparator := Value;
-end;
-
-function TAbstractCollection.GetFixedSize: Boolean;
-begin
- Result := false;
-end;
-
-function TAbstractCollection.GetIgnoreErrors: TCollectionErrors;
-begin
- Result := FIgnoreErrors;
-end;
-
-procedure TAbstractCollection.SetIgnoreErrors(Value: TCollectionErrors);
-begin
- FIgnoreErrors := Value;
-end;
-
-function TAbstractCollection.GetInstance: TObject;
-begin
- Result := Self;
-end;
-
-function TAbstractCollection.GetIterator(const Filter: IFilter): IIterator;
-var
- Iterator: IIterator;
-begin
- Iterator := GetIterator;
- Result := TFilterIterator.Create(Iterator, Filter, Iterator.GetAllowRemoval);
-end;
-
-function TAbstractCollection.GetIterator(FilterFunc: TCollectionFilterFunc): IIterator;
-var
- Iterator: IIterator;
-begin
- Iterator := GetIterator;
- Result := TFilterFuncIterator.Create(Iterator, FilterFunc, Iterator.GetAllowRemoval);
-end;
-
-function TAbstractCollection.GetNaturalItemsOnly: Boolean;
-begin
- Result := FNaturalItemsOnly;
-end;
-
-function TAbstractCollection.Add(const Item: ICollectable): Boolean;
-var
- ItemError: TCollectionError;
- Success: Boolean;
-begin
- ItemError := ItemAllowed(Item); // Can be natural items only error or nil not allowed error
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Success := false;
- end
- else if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Success := false;
- end
- else
- begin
- Success := TrueAdd(Item);
- end;
- Result := Success;
-end;
-
-function TAbstractCollection.Add(const ItemArray: array of ICollectable): Integer;
-var
- Item: ICollectable;
- ItemError: TCollectionError;
- I, Count: Integer;
- Success: Boolean;
-begin
- Count := 0;
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else
- begin
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Success := false;
- end
- else
- begin
- Success := TrueAdd(Item);
- end;
- if Success then
- Inc(Count);
- end;
- end;
- Result := Count;
-end;
-
-function TAbstractCollection.Add(const Collection: ICollection): Integer;
-var
- Iterator: IIterator;
- Item: ICollectable;
- ItemError: TCollectionError;
- Count: Integer;
- Success: Boolean;
-begin
- Count := 0;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Success := false;
- end
- else if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Success := false;
- end
- else
- begin
- Success := TrueAdd(Item);
- end;
- if Success then
- Inc(Count);
- Iterator.Next;
- end;
- Result := Count;
-end;
-
-procedure TAbstractCollection.AfterConstruction;
-begin
- inherited AfterConstruction;
- FCreated := true;
-end;
-
-procedure TAbstractCollection.BeforeDestruction;
-begin
- if not FixedSize then
- TrueClear;
- inherited BeforeDestruction;
-end;
-
-function TAbstractCollection.Clear: Integer;
-begin
- if not FixedSize then
- begin
- Result := Size;
- TrueClear;
- end
- else
- begin
- CollectionError(ceFixedSize);
- Result := 0;
- end;
-end;
-
-function TAbstractCollection.Clone: ICollection;
-begin
- Result := (TAbstractCollectionClass(ClassType)).Create(Self);
-end;
-
-function TAbstractCollection.Contains(const Item: ICollectable): Boolean;
-var
- ItemError: TCollectionError;
- Success: Boolean;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Success := false;
- end
- else
- begin
- Success := TrueContains(Item);
- end;
- Result := Success;
-end;
-
-function TAbstractCollection.Contains(const ItemArray: array of ICollectable): Boolean;
-var
- I: Integer;
- Success: Boolean;
-begin
- Success := true;
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Success := Success and Contains(ItemArray[I]);
- if not Success then
- break;
- end;
- Result := Success;
-end;
-
-function TAbstractCollection.Contains(const Collection: ICollection): Boolean;
-var
- Iterator: IIterator;
- Success: Boolean;
-begin
- Success := true;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Success := Success and Contains(Iterator.CurrentItem);
- if not Success then
- break;
- Iterator.Next;
- end;
- Result := Success;
-end;
-
-function TAbstractCollection.Equals(const Collection: ICollection): Boolean;
-var
- Iterator: IIterator;
- Success: Boolean;
-begin
- if Collection.GetType <> GetType then
- Result := false
- else if Collection.Size <> Size then
- Result := false
- else if not Collection.Comparator.Equals(Comparator) then
- Result := false
- else if not Collection.GetDuplicates and not GetDuplicates then
- begin
- // Not equal if any item not found in parameter collection
- Success := true;
- Iterator := GetIterator;
- while not Iterator.EOF and Success do
- begin
- Success := Collection.Contains(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := Success;
- end
- else
- begin
- // Not equal if any item count not equal to item count in parameter collection
- Success := true;
- Iterator := GetIterator;
- while not Iterator.EOF and Success do
- begin
- Success := (ItemCount(Iterator.CurrentItem) = Collection.ItemCount(Iterator.CurrentItem));
- Iterator.Next;
- end;
- Result := Success;
- end;
-end;
-
-function TAbstractCollection.Find(const Filter: IFilter): ICollectable;
-begin
- Result := GetIterator(Filter).First;
-end;
-
-function TAbstractCollection.Find(FilterFunc: TCollectionFilterFunc): ICollectable;
-begin
- Result := GetIterator(FilterFunc).First;
-end;
-
-function TAbstractCollection.FindAll(const Filter: IFilter): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Self.GetIterator(Filter);
- while not Iterator.EOF do
- begin
- ResultCollection.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.FindAll(FilterFunc: TCollectionFilterFunc): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Self.GetIterator(FilterFunc);
- while not Iterator.EOF do
- begin
- ResultCollection.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.IsEmpty: Boolean;
-begin
- Result := (Size = 0);
-end;
-
-function TAbstractCollection.IsNaturalItem(const Item: ICollectable): Boolean;
-var
- Temp: IUnknown;
-begin
- if Item <> nil then
- Result := (Item.QueryInterface(NaturalItemIID, Temp) <> E_NOINTERFACE)
- else
- Result := false;
-end;
-
-function TAbstractCollection.ItemAllowed(const Item: ICollectable): TCollectionError;
-begin
- if NaturalItemsOnly and not IsNaturalItem(Item) then
- Result := ceNotNaturalItem
- else if not IsNilAllowed and (Item = nil) then
- Result := ceNilNotAllowed
- else
- Result := ceOK;
-end;
-
-function TAbstractCollection.ItemCount(const Item: ICollectable): Integer;
-var
- ItemError: TCollectionError;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := 0;
- end
- else if GetDuplicates then
- begin
- Result := TrueItemCount(Item);
- end
- else
- begin
- // Where duplicates are not allowed, TrueContains will be faster than TrueItemCount.
- if TrueContains(Item) then
- Result := 1
- else
- Result := 0;
- end;
-end;
-
-function TAbstractCollection.ItemCount(const ItemArray: array of ICollectable): Integer;
-var
- I: Integer;
- Total: Integer;
-begin
- Total := 0;
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Total := Total + ItemCount(ItemArray[I]);
- end;
- Result := Total;
-end;
-
-function TAbstractCollection.ItemCount(const Collection: ICollection): Integer;
-var
- Iterator: IIterator;
- Total: Integer;
-begin
- Total := 0;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Total := Total + ItemCount(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := Total;
-end;
-
-function TAbstractCollection.Matching(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- if Contains(ItemArray[I]) then
- ResultCollection.Add(ItemArray[I]);
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.Matching(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- if Contains(Iterator.CurrentItem) then
- ResultCollection.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.Remove(const Item: ICollectable): ICollectable;
-var
- ItemError: TCollectionError;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := nil;
- end
- else if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Result := nil;
- end
- else
- begin
- Result := TrueRemove(Item);
- end;
-end;
-
-function TAbstractCollection.Remove(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- ResultCollection.Add(Remove(ItemArray[I]));
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.Remove(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- ResultCollection.Add(Remove(Iterator.CurrentItem));
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.RemoveAll(const Item: ICollectable): ICollection;
-var
- ItemError: TCollectionError;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := nil;
- end
- else if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Result := nil;
- end
- else
- begin
- Result := TrueRemoveAll(Item);
- end;
-end;
-
-function TAbstractCollection.RemoveAll(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- ResultCollection.Add(RemoveAll(ItemArray[I]));
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.RemoveAll(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- ResultCollection.Add(RemoveAll(Iterator.CurrentItem));
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.Retain(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
- Item: ICollectable;
- I: Integer;
- Found, Success: Boolean;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := GetIterator;
- while not Iterator.EOF do
- begin
- // Converting the array to a map would be faster but I don't want to
- // couple base class code to a complex collection.
- Found := false;
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := Iterator.CurrentItem;
- Found := Comparator.Equals(Item, ItemArray[I]);
- if Found then
- break;
- end;
- if not Found then
- begin
- Success := Iterator.Remove;
- if Success then
- ResultCollection.Add(Item);
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractCollection.Retain(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
- Item: ICollectable;
- Success: Boolean;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- if not Collection.Contains(Item) then
- begin
- Success := Iterator.Remove;
- if Success then
- ResultCollection.Add(Item);
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-{ TAbstractBag }
-function TAbstractBag.CloneAsBag: IBag;
-begin
- Result := (TAbstractBagClass(ClassType)).Create(Self);
-end;
-
-function TAbstractBag.GetNaturalItemIID: TGUID;
-begin
- Result := EquatableIID;
-end;
-
-function TAbstractBag.GetType: TCollectionType;
-begin
- Result := ctBag;
-end;
-
-function TAbstractBag.IsNilAllowed: Boolean;
-begin
- Result := true;
-end;
-
-{ TAbstractSet }
-function TAbstractSet.TrueAdd(const Item: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
-begin
- // Adds if not already present otherwise fails
- Position := GetPosition(Item);
- try
- if Position.Found then
- begin
- CollectionError(ceDuplicate);
- Result := false;
- end
- else
- begin
- TrueAdd2(Position, Item);
- Result := true;
- end;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractSet.TrueContains(const Item: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
-begin
- Position := GetPosition(Item);
- try
- Result := Position.Found;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractSet.TrueRemove(const Item: ICollectable): ICollectable;
-var
- Position: TCollectionPosition;
-begin
- Position := GetPosition(Item);
- try
- if Position.Found then
- begin
- Result := TrueGet(Position);
- TrueRemove2(Position);
- end
- else
- Result := nil;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractSet.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- RemovedItem: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create;
- RemovedItem := TrueRemove(Item);
- if RemovedItem <> nil then
- ResultCollection.Add(RemovedItem);
- Result := ResultCollection;
-end;
-
-function TAbstractSet.GetDuplicates: Boolean;
-begin
- Result := false;
-end;
-
-function TAbstractSet.GetNaturalItemIID: TGUID;
-begin
- Result := EquatableIID;
-end;
-
-function TAbstractSet.GetType: TCollectionType;
-begin
- Result := ctSet;
-end;
-
-function TAbstractSet.CloneAsSet: ISet;
-begin
- Result := (TAbstractSetClass(ClassType)).Create(Self);
-end;
-
-function TAbstractSet.Complement(const Universe: ISet): ISet;
-var
- ResultSet: ISet;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- // Return items in universe not found in self.
- ResultSet := TAbstractSetClass(ClassType).Create(NaturalItemsOnly);
- Iterator := Universe.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- if not Contains(Item) then
- ResultSet.Add(Item);
- Iterator.Next;
- end;
- Result := ResultSet;
-end;
-
-function TAbstractSet.Intersect(const Set2: ISet): ISet;
-var
- ResultSet: ISet;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- // Return items found in self and parameter.
- ResultSet := TAbstractSetClass(ClassType).Create(NaturalItemsOnly);
- Iterator := GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- if Contains(Item) and Set2.Contains(Item) then
- ResultSet.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultSet;
-end;
-
-function TAbstractSet.IsNilAllowed: Boolean;
-begin
- Result := false;
-end;
-
-function TAbstractSet.Union(const Set2: ISet): ISet;
-var
- ResultSet: ISet;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- // Return items found in self or parameter.
- ResultSet := CloneAsSet;
- Iterator := Set2.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- if not Contains(Item) and Set2.Contains(Item) then
- ResultSet.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultSet;
-end;
-
-{ TAbstractList }
-constructor TAbstractList.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FDuplicates := true;
- FSorted := false;
-end;
-
-procedure TAbstractList.InitFrom(const Collection: ICollection);
-var
- List: IList;
-begin
- inherited InitFrom(Collection);
- if Collection.QueryInterface(IList, List) = S_OK then
- begin
- FDuplicates := List.GetDuplicates;
- FSorted := List.GetSorted;
- end;
-end;
-
-function TAbstractList.TrueAdd(const Item: ICollectable): Boolean;
-var
- SearchResult: TSearchResult;
-begin
- Result := True;
- if Sorted then
- begin
- // Insert in appropriate place to maintain sort order, unless duplicate
- // not allowed.
- SearchResult := BinarySearch(Item);
- case SearchResult.ResultType of
- srBeforeIndex: TrueInsert(SearchResult.Index, Item);
- srFoundAtIndex: begin
- if Duplicates then
- TrueInsert(SearchResult.Index, Item)
- else
- begin
- CollectionError(ceDuplicate);
- Result := false;
- end;
- end;
- srAfterEnd: TrueAppend(Item);
- end;
- end
- else
- begin
- // Add to end, unless duplicate not allowed.
- if not Duplicates and (SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex) then
- begin
- CollectionError(ceDuplicate);
- Result := false;
- end
- else
- TrueAppend(Item);
- end;
-end;
-
-function TAbstractList.TrueContains(const Item: ICollectable): Boolean;
-begin
- if Sorted then
- Result := BinarySearch(Item).ResultType = srFoundAtIndex
- else
- Result := SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex
-end;
-
-function TAbstractList.TrueItemCount(const Item: ICollectable): Integer;
-var
- SearchResult: TSearchResult;
- Count: Integer;
-begin
- if Sorted then
- begin
- // If sorted, use binary search.
- Count := 0;
- SearchResult := BinarySearch(Item);
- if SearchResult.ResultType = srFoundAtIndex then
- begin
- repeat
- Inc(Count);
- until not Comparator.Equals(Item, Items[SearchResult.Index]);
- end;
- Result := Count;
- end
- else
- // Resort to sequential search for unsorted
- Result := inherited TrueItemCount(Item);
-end;
-
-function TAbstractList.TrueRemove(const Item: ICollectable): ICollectable;
-var
- SearchResult: TSearchResult;
-begin
- Result := nil;
- if Sorted then
- begin
- SearchResult := BinarySearch(Item);
- if SearchResult.ResultType = srFoundAtIndex then
- begin
- Result := TrueDelete(SearchResult.Index);
- end;
- end
- else
- begin
- SearchResult := SequentialSearch(Item);
- if SearchResult.ResultType = srFoundAtIndex then
- Result := TrueDelete(SearchResult.Index);
- end;
-end;
-
-function TAbstractList.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- SearchResult: TSearchResult;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create;
- if Sorted then
- begin
- SearchResult := BinarySearch(Item);
- if SearchResult.ResultType = srFoundAtIndex then
- begin
- repeat
- ResultCollection.Add(TrueDelete(SearchResult.Index));
- until not Comparator.Equals(Item, Items[SearchResult.Index]);
- end;
- end
- else
- begin
- I := 0;
- while I < Size do
- begin
- if Comparator.Equals(Item, Items[I]) then
- begin
- ResultCollection.Add(TrueDelete(I));
- end
- else
- Inc(I);
- end;
- end;
- Result := ResultCollection;
-end;
-
-procedure TAbstractList.QuickSort(Lo, Hi: Integer; const Comparator: IComparator);
-var
- I, J, Mid: Integer;
-begin
- repeat
- I := Lo;
- J := Hi;
- Mid := (Lo + Hi) div 2;
- repeat
- while Comparator.Compare(Items[I], Items[Mid]) < 0 do
- Inc(I);
- while Comparator.Compare(Items[J], Items[Mid]) > 0 do
- Dec(J);
- if I <= J then
- begin
- Exchange(I, J);
- if Mid = I then
- Mid := J
- else if Mid = J then
- Mid := I;
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if Lo < J then
- QuickSort(Lo, J, Comparator);
- Lo := I;
- until I >= Hi;
-end;
-
-procedure TAbstractList.QuickSort(Lo, Hi: Integer; CompareFunc: TCollectionCompareFunc);
-var
- I, J, Mid: Integer;
-begin
- repeat
- I := Lo;
- J := Hi;
- Mid := (Lo + Hi) div 2;
- repeat
- while CompareFunc(Items[I], Items[Mid]) < 0 do
- Inc(I);
- while CompareFunc(Items[J], Items[Mid]) > 0 do
- Dec(J);
- if I <= J then
- begin
- Exchange(I, J);
- if Mid = I then
- Mid := J
- else if Mid = J then
- Mid := I;
- Inc(I);
- Dec(J);
- end;
- until I > J;
- if Lo < J then
- QuickSort(Lo, J, CompareFunc);
- Lo := I;
- until I >= Hi;
-end;
-
-function TAbstractList.GetDuplicates: Boolean;
-begin
- Result := FDuplicates;
-end;
-
-procedure TAbstractList.SetDuplicates(Value: Boolean);
-var
- Iterator: IIterator;
- Failed: Boolean;
-begin
- Failed := false;
- // If trying to set no duplicates, check there are no existing duplicates.
- if not Value then
- begin
- Iterator := GetIterator;
- while not Iterator.EOF and not Failed do
- begin
- Failed := (ItemCount(Iterator.CurrentItem) > 1);
- Iterator.Next;
- end;
- if Failed then
- CollectionError(ceDuplicate);
- end;
- if not Failed then
- FDuplicates := Value;
-end;
-
-function TAbstractList.GetItem(Index: Integer): ICollectable;
-begin
- if (Index < 0) or (Index >= Size) then
- begin
- CollectionError(ceOutOfRange);
- Result := nil;
- end
- else
- Result := TrueGetItem(Index);
-end;
-
-procedure TAbstractList.SetItem(Index: Integer; const Item: ICollectable);
-var
- SearchResult: TSearchResult;
-begin
- if (Index < 0) or (Index >= Size) then
- begin
- CollectionError(ceOutOfRange)
- end
- else if not Duplicates then
- begin
- // Find any duplicates
- if Sorted then
- begin
- SearchResult := BinarySearch(Item);
- case SearchResult.ResultType of
- srBeforeIndex, srAfterEnd: begin // If item is not present
- FSorted := false;
- TrueSetItem(Index, Item);
- end;
- srFoundAtIndex: begin // If item is already present
- CollectionError(ceDuplicate);
- end;
- end;
- end
- else
- begin
- // If item is already present
- if SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex then
- begin
- CollectionError(ceDuplicate);
- end
- else
- begin
- TrueSetItem(Index, Item);
- end;
- end;
- end
- else
- begin
- FSorted := false;
- TrueSetItem(Index, Item);
- end;
-end;
-
-function TAbstractList.GetIterator: IIterator;
-begin
- Result := TAbstractListIterator.Create(Self);
-end;
-
-function TAbstractList.GetNaturalItemIID: TGUID;
-begin
- Result := ComparableIID;
-end;
-
-function TAbstractList.GetSorted: Boolean;
-begin
- Result := FSorted;
-end;
-
-procedure TAbstractList.SetSorted(Value: Boolean);
-begin
- if Value then
- Sort;
-end;
-
-function TAbstractList.GetType: TCollectionType;
-begin
- Result := ctList;
-end;
-
-function TAbstractList.BinarySearch(const Item: ICollectable): TSearchResult;
-var
- Lo, Hi, Mid: Integer;
- CompareResult: Integer;
- Success: Boolean;
-begin
- if Size = 0 then
- begin
- Result.ResultType := srAfterEnd;
- Exit;
- end;
- Lo := 0;
- Hi := Size - 1;
- Success := false;
- repeat
- Mid := (Lo + Hi) div 2;
- CompareResult := Comparator.Compare(Item, Items[Mid]);
- if CompareResult = 0 then
- Success := true
- else if CompareResult > 0 then
- Lo := Mid + 1
- else
- Hi := Mid - 1;
- until (Lo > Hi) or Success;
- if Success then
- begin
- // Move index back if in cluster of duplicates
- while (Mid > 0) and Comparator.Equals(Item, Items[Mid - 1]) do
- Dec(Mid);
- Result.ResultType := srFoundAtIndex;
- Result.Index := Mid;
- end
- else if CompareResult < 0 then
- begin
- Result.ResultType := srBeforeIndex;
- Result.Index := Mid;
- end
- else if Hi < Size - 1 then
- begin
- Result.ResultType := srBeforeIndex;
- Result.Index := Mid + 1;
- end
- else
- Result.ResultType := srAfterEnd;
-end;
-
-function TAbstractList.CloneAsList: IList;
-begin
- Result := (TAbstractListClass(ClassType)).Create(Self);
-end;
-
-function TAbstractList.Delete(Index: Integer): ICollectable;
-begin
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Result := nil;
- end
- else if (Index < 0) or (Index >= Size) then
- begin
- CollectionError(ceOutOfRange);
- Result := nil;
- end
- else
- begin
- Result := TrueDelete(Index);
- end;
-end;
-
-procedure TAbstractList.Exchange(Index1, Index2: Integer);
-var
- Item: ICollectable;
-begin
- if (Index1 < 0) or (Index1 >= Size) then
- CollectionError(ceOutOfRange);
- if (Index2 < 0) or (Index2 >= Size) then
- CollectionError(ceOutOfRange);
- FSorted := false;
- Item := ICollectable(Items[Index1]);
- Items[Index1] := Items[Index2];
- Items[Index2] := Item;
-end;
-
-function TAbstractList.First: ICollectable;
-begin
- if Size > 0 then
- Result := Items[0]
- else
- Result := nil;
-end;
-
-function TAbstractList.IndexOf(const Item: ICollectable): Integer;
-var
- SearchResult: TSearchResult;
-begin
- if Sorted then
- SearchResult := BinarySearch(Item)
- else
- SearchResult := SequentialSearch(Item, Comparator);
- if SearchResult.ResultType = srFoundAtIndex then
- Result := SearchResult.Index
- else
- Result := -1;
-end;
-
-function TAbstractList.Insert(Index: Integer; const Item: ICollectable): Boolean;
-var
- ItemError: TCollectionError;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := false;
- end
- else if FixedSize then
- begin
- CollectionError(ceFixedSize);
- Result := false;
- end
- else if (Index < 0) or (Index > Size) then
- begin
- CollectionError(ceOutOfRange);
- Result := false;
- end
- else
- begin
- FSorted := false;
- if Index = Size then
- TrueAdd(Item)
- else
- TrueInsert(Index, Item);
- Result := true;
- end;
-end;
-
-function TAbstractList.Insert(Index: Integer; const ItemArray: array of ICollectable): Integer;
-var
- Item: ICollectable;
- ItemError: TCollectionError;
- I, NewIndex, Count: Integer;
- Success: Boolean;
-begin
- Count := 0;
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else if (Index < 0) or (Index > Size) then
- begin
- CollectionError(ceOutOfRange);
- end
- else
- begin
- // Insert entire array in place in correct order
- NewIndex := Index;
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else
- begin
- Success := Insert(NewIndex, Item);
- if Success then
- begin
- Inc(NewIndex);
- Inc(Count);
- end;
- end;
- end;
- end;
- Result := Count;
-end;
-
-function TAbstractList.Insert(Index: Integer; const Collection: ICollection): Integer;
-var
- Iterator: IIterator;
- Item: ICollectable;
- ItemError: TCollectionError;
- NewIndex, Count: Integer;
- Success: Boolean;
-begin
- Count := 0;
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else if (Index < 0) or (Index > Size) then
- begin
- CollectionError(ceOutOfRange);
- end
- else
- begin
- // Insert entire collection in place in correct order
- NewIndex := Index;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else
- begin
- Success := Insert(NewIndex, Item);
- if Success then
- begin
- Inc(NewIndex);
- Inc(Count);
- end;
- end;
- Iterator.Next;
- end;
- end;
- Result := Count;
-end;
-
-function TAbstractList.IsNilAllowed: Boolean;
-begin
- Result := true;
-end;
-
-function TAbstractList.Last: ICollectable;
-begin
- if Size > 0 then
- Result := Items[Size - 1]
- else
- Result := nil;
-end;
-
-function TAbstractList.Search(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult;
-begin
- if Sorted and (SearchComparator = nil) then
- Result := BinarySearch(Item)
- else
- Result := SequentialSearch(Item, SearchComparator);
-end;
-
-function TAbstractList.SequentialSearch(const Item: ICollectable; const SearchComparator: IComparator): TSearchResult;
-var
- WorkingComparator: IComparator;
- I: Integer;
- Success: Boolean;
-begin
- if SearchComparator = nil then
- WorkingComparator := Comparator
- else
- WorkingComparator := SearchComparator;
- Result.ResultType := srNotFound;
- I := 0;
- Success := false;
- while (I < Size) and not Success do
- begin
- if WorkingComparator.Equals(Item, Items[I]) then
- begin
- Result.ResultType := srFoundAtIndex;
- Result.Index := I;
- Success := true;
- end
- else
- Inc(I);
- end;
-end;
-
-procedure TAbstractList.Sort(const SortComparator: IComparator);
-begin
- if SortComparator = nil then
- begin
- if Size > 0 then
- QuickSort(0, Size - 1, Comparator);
- FSorted := true;
- end
- else
- begin
- if Size > 0 then
- QuickSort(0, Size - 1, SortComparator);
- FSorted := false;
- end;
-end;
-
-procedure TAbstractList.Sort(CompareFunc: TCollectionCompareFunc);
-begin
- if Size > 0 then
- QuickSort(0, Size - 1, CompareFunc);
- FSorted := false;
-end;
-
-{ TAbstractMap }
-constructor TAbstractMap.Create;
-begin
- Create(false, true);
-end;
-
-constructor TAbstractMap.Create(NaturalItemsOnly: Boolean);
-begin
- Create(NaturalItemsOnly, true);
-end;
-
-constructor TAbstractMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FNaturalKeysOnly := NaturalKeysOnly or GetAlwaysNaturalKeys;
- FAssociationComparator := TAssociationComparator.Create(FNaturalKeysOnly);
- if FNaturalKeysOnly then
- FKeyComparator := TAbstractComparator.GetNaturalComparator
- else
- FKeyComparator := TAbstractComparator.GetDefaultComparator;
-end;
-
-constructor TAbstractMap.Create(const ItemArray: array of ICollectable);
-begin
- Create(ItemArray, true, true);
-end;
-
-constructor TAbstractMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-begin
- Create(ItemArray, true, true);
-end;
-
-constructor TAbstractMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-var
- I: Integer;
-begin
- Create(true, NaturalKeysOnly);
- if not FixedSize then
- begin
- Capacity := Length(ItemArray);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Add(ItemArray[I]);
- end;
- end;
-end;
-
-constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable);
-begin
- Create(KeyArray, ItemArray, false, true);
-end;
-
-constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-begin
- Create(KeyArray, ItemArray, NaturalItemsOnly, true);
-end;
-
-constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
-var
- I, Lo, Hi: Integer;
-begin
- Create(NaturalItemsOnly, NaturalKeysOnly);
- if not FixedSize then
- begin
- Capacity := Min(Length(KeyArray), Length(ItemArray));
- Lo := Max(Low(KeyArray), Low(ItemArray));
- Hi := Min(High(KeyArray), High(ItemArray));
- for I := Lo to Hi do
- begin
- Put(KeyArray[I], ItemArray[I]);
- end;
- end;
-end;
-
-constructor TAbstractMap.Create(const Map: IMap);
-var
- MapIterator: IMapIterator;
-begin
- Create(Map.GetNaturalItemsOnly, Map.GetNaturalKeysOnly);
- InitFrom(Map);
- if not FixedSize then
- begin
- Capacity := Map.GetSize;
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
- MapIterator.Next;
- end;
- end;
-end;
-
-destructor TAbstractMap.Destroy;
-begin
- FKeyComparator := nil;
- FAssociationComparator := nil;
- inherited Destroy;
-end;
-
-procedure TAbstractMap.InitFrom(const Collection: ICollection);
-var
- Map: IMap;
-begin
- inherited InitFrom(Collection);
- if Collection.QueryInterface(IMap, Map) = S_OK then
- begin
- FNaturalKeysOnly := Map.GetNaturalKeysOnly or GetAlwaysNaturalKeys;
- KeyComparator := Map.GetKeyComparator;
- end;
-end;
-
-function TAbstractMap.TrueAdd(const Item: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
- Mappable: IMappable;
-begin
- if IsNaturalItem(Item) then
- begin
- Mappable := Item as IMappable;
- Position := GetKeyPosition(Mappable.GetKey);
- try
- if Position.Found then
- begin
- CollectionError(ceDuplicateKey);
- Result := false;
- end
- else
- begin
- TruePut(Position, TAssociation.Create(Mappable.GetKey, Item));
- Result := true;
- end;
- finally
- Position.Free;
- end;
- end
- else
- begin
- CollectionError(ceNotNaturalItem);
- Result := false;
- end;
-end;
-
-function TAbstractMap.TrueContains(const Item: ICollectable): Boolean;
-var
- Item2: ICollectable;
- Success: Boolean;
- Iterator: IIterator;
-begin
- Iterator := GetIterator;
- Success := false;
- while not Iterator.EOF and not Success do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- Success := true;
- Iterator.Next;
- end;
- Result := Success;
-end;
-
-function TAbstractMap.TrueRemove(const Item: ICollectable): ICollectable;
-var
- Item2: ICollectable;
- Iterator: IMapIterator;
- Found: Boolean;
-begin
- // Sequential search
- Found := false;
- Result := nil;
- Iterator := GetAssociationIterator;
- while not Iterator.EOF and not Found do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- Result := Item2;
- Iterator.Remove;
- Found := true;
- end;
- Iterator.Next;
- end;
-end;
-
-function TAbstractMap.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Item2: ICollectable;
- Iterator: IMapIterator;
-begin
- // Sequential search
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := GetAssociationIterator;
- while not Iterator.EOF do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- ResultCollection.Add(Item2);
- Iterator.Remove;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-class function TAbstractMap.GetAlwaysNaturalKeys: Boolean;
-begin
- Result := false;
-end;
-
-function TAbstractMap.GetItem(const Key: ICollectable): ICollectable;
-begin
- Result := Get(Key);
-end;
-
-procedure TAbstractMap.SetItem(const Key, Item: ICollectable);
-begin
- Put(Key, Item);
-end;
-
-function TAbstractMap.GetIterator: IIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractMap.GetKeyComparator: IComparator;
-begin
- Result := FKeyComparator;
-end;
-
-procedure TAbstractMap.SetKeyComparator(const Value: IComparator);
-begin
- FKeyComparator := Value;
- FAssociationComparator.KeyComparator := Value;
-end;
-
-function TAbstractMap.GetKeyIterator: IIterator;
-begin
- Result := TAssociationKeyIterator.Create(GetAssociationIterator);
-end;
-
-function TAbstractMap.GetKeys: ISet;
-var
- ResultCollection: TPArraySet;
- KeyIterator: IIterator;
-begin
- ResultCollection := TPArraySet.Create(NaturalKeysOnly);
- ResultCollection.SetComparator(GetKeyComparator);
- KeyIterator := GetKeyIterator;
- while not KeyIterator.EOF do
- begin
- ResultCollection.Add(KeyIterator.CurrentItem);
- KeyIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.GetMapIterator: IMapIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractMap.GetMapIteratorByKey(const Filter: IFilter): IMapIterator;
-var
- Iterator: IMapIterator;
-begin
- Iterator := GetMapIterator;
- Result := TKeyFilterMapIterator.Create(Iterator, Filter, Iterator.GetAllowRemoval);
-end;
-
-function TAbstractMap.GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator;
-var
- Iterator: IMapIterator;
-begin
- Iterator := GetMapIterator;
- Result := TKeyFilterFuncMapIterator.Create(Iterator, FilterFunc, Iterator.GetAllowRemoval);
-end;
-
-function TAbstractMap.GetNaturalItemIID: TGUID;
-begin
- Result := MappableIID;
-end;
-
-function TAbstractMap.GetNaturalKeyIID: TGUID;
-begin
- Result := EquatableIID;
-end;
-
-function TAbstractMap.GetNaturalKeysOnly: Boolean;
-begin
- Result := FNaturalKeysOnly;
-end;
-
-function TAbstractMap.GetType: TCollectionType;
-begin
- Result := ctMap;
-end;
-
-function TAbstractMap.GetValues: ICollection;
-var
- ResultCollection: ICollection;
- ValueIterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- ValueIterator := GetIterator;
- while not ValueIterator.EOF do
- begin
- ResultCollection.Add(ValueIterator.CurrentItem);
- ValueIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-// Overrides TAbstractCollection function, otherwise Create(ICollection) is
-// called, which cannot access keys.
-function TAbstractMap.Clone: ICollection;
-begin
- Result := (TAbstractMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractMap.CloneAsMap: IMap;
-begin
- Result := (TAbstractMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractMap.ContainsKey(const Key: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
-begin
- Position := GetKeyPosition(Key);
- try
- Result := Position.Found;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractMap.ContainsKey(const KeyArray: array of ICollectable): Boolean;
-var
- I: Integer;
- Success: Boolean;
-begin
- Success := true;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Success := Success and ContainsKey(KeyArray[I]);
- if not Success then
- break;
- end;
- Result := Success;
-end;
-
-function TAbstractMap.ContainsKey(const Collection: ICollection): Boolean;
-var
- Iterator: IIterator;
- Success: Boolean;
-begin
- Success := true;
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Success := Success and ContainsKey(Iterator.CurrentItem);
- if not Success then
- break;
- Iterator.Next;
- end;
- Result := Success;
-end;
-
-function TAbstractMap.Get(const Key: ICollectable): ICollectable;
-var
- KeyError: TCollectionError;
- Position: TCollectionPosition;
-begin
- KeyError := KeyAllowed(Key);
- if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- Result := nil;
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- Result := TrueGet(Position).GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractMap.KeyAllowed(const Key: ICollectable): TCollectionError;
-begin
- if NaturalKeysOnly and not IsNaturalKey(Key) then
- Result := ceNotNaturalItem
- else if Key = nil then
- Result := ceNilNotAllowed
- else
- Result := ceOK;
-end;
-
-function TAbstractMap.IsNaturalKey(const Key: ICollectable): Boolean;
-var
- Temp: IUnknown;
-begin
- if Key.QueryInterface(NaturalKeyIID, Temp) <> E_NOINTERFACE then
- Result := true
- else
- Result := false;
-end;
-
-function TAbstractMap.IsNilAllowed: Boolean;
-begin
- Result := true;
-end;
-
-function TAbstractMap.MatchingKey(const KeyArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- if ContainsKey(KeyArray[I]) then
- ResultCollection.Add(KeyArray[I]);
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.MatchingKey(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- if ContainsKey(Iterator.CurrentItem) then
- ResultCollection.Add(Iterator.CurrentItem);
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.Put(const Item: ICollectable): ICollectable;
-var
- Mappable: IMappable;
- OldAssociation, NewAssociation: IAssociation;
- Position: TCollectionPosition;
-begin
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- Result := nil;
- end
- else
- begin
- Item.QueryInterface(IMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractMap.Put(const Key, Item: ICollectable): ICollectable;
-var
- OldAssociation, NewAssociation: IAssociation;
- ItemError, KeyError: TCollectionError;
- Position: TCollectionPosition;
-begin
- ItemError := ItemAllowed(Item);
- KeyError := KeyAllowed(Key);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := nil;
- end
- else if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- Result := nil;
- end
- else
- begin
- // Find appropriate place, then place key-item association there
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractMap.Put(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IMappable;
- OldAssociation, NewAssociation: IAssociation;
- Position: TCollectionPosition;
- Item: ICollectable;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- // Find appropriate place, then place key-item association there
- Item.QueryInterface(IMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.Put(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IMappable;
- OldAssociation, NewAssociation: IAssociation;
- Position: TCollectionPosition;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;;
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- // Find appropriate place, then place key-item association there
- Item.QueryInterface(IMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.Put(const Map: IMap): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation, NewAssociation: IAssociation;
- ItemError, KeyError: TCollectionError;
- Position: TCollectionPosition;
- MapIterator: IMapIterator;
- Key, Item: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Key := MapIterator.CurrentKey;
- Item := MapIterator.CurrentItem;
-
- ItemError := ItemAllowed(Item);
- KeyError := KeyAllowed(Key);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- end
- else
- begin
- // Find appropriate place, then place key-item association there
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.RemoveKey(const Key: ICollectable): ICollectable;
-var
- KeyError: TCollectionError;
- Position: TCollectionPosition;
- OldAssociation: IAssociation;
-begin
- KeyError := KeyAllowed(Key);
- if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- Result := nil;
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- Result := OldAssociation.GetValue
- end
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractMap.RemoveKey(const KeyArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation: IAssociation;
- KeyError: TCollectionError;
- Position: TCollectionPosition;
- Key: ICollectable;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Key := KeyArray[I];
- KeyError := KeyAllowed(Key);
- if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- ResultCollection.Add(OldAssociation.GetValue);
- end;
- finally
- Position.Free;
- end;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.RemoveKey(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation: IAssociation;
- KeyError: TCollectionError;
- Position: TCollectionPosition;
- Key: ICollectable;
- Iterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Key := Iterator.CurrentItem;
- KeyError := KeyAllowed(Key);
- if KeyError <> ceOK then
- begin
- CollectionError(KeyError);
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- ResultCollection.Add(OldAssociation.GetValue);
- end;
- finally
- Position.Free;
- end;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractMap.RetainKey(const KeyArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- MapIterator: IMapIterator;
- I: Integer;
- Found: Boolean;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else
- begin
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- // Converting the array to a map would be faster but I don't want to
- // couple base class code to a complex collection.
- Found := false;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Found := KeyComparator.Equals(MapIterator.CurrentKey, KeyArray[I]);
- if Found then
- break;
- end;
- if not Found then
- begin
- ResultCollection.Add(MapIterator.CurrentItem);
- MapIterator.Remove;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
- end;
-end;
-
-function TAbstractMap.RetainKey(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- MapIterator: IMapIterator;
- Key: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else
- begin
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- Key := MapIterator.CurrentKey;
- if not Collection.Contains(Key) then
- begin
- ResultCollection.Add(MapIterator.CurrentItem);
- MapIterator.Remove;
- end;
- MapIterator.Next;
- end;
- end;
- Result := ResultCollection;
-end;
-
-
-{ TAbstractIntegerMap }
-constructor TAbstractIntegerMap.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FAssociationComparator := TIntegerAssociationComparator.Create;
-end;
-
-constructor TAbstractIntegerMap.Create(const ItemArray: array of ICollectable);
-begin
- Create(ItemArray, true);
-end;
-
-constructor TAbstractIntegerMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-begin
- inherited Create(ItemArray, true);
-end;
-
-constructor TAbstractIntegerMap.Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable);
-begin
- Create(KeyArray, ItemArray, false);
-end;
-
-constructor TAbstractIntegerMap.Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-var
- I, Lo, Hi: Integer;
-begin
- Create(NaturalItemsOnly);
- Capacity := Min(Length(KeyArray), Length(ItemArray));
- if not FixedSize then
- begin
- Lo := Max(Low(KeyArray), Low(ItemArray));
- Hi := Min(High(KeyArray), High(ItemArray));
- for I := Lo to Hi do
- begin
- Put(KeyArray[I], ItemArray[I]);
- end;
- end;
-end;
-
-constructor TAbstractIntegerMap.Create(const Map: IIntegerMap);
-var
- MapIterator: IIntegerMapIterator;
-begin
- Create(Map.GetNaturalItemsOnly);
- InitFrom(Map);
- Capacity := Map.GetSize;
- if not FixedSize then
- begin
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
- MapIterator.Next;
- end;
- end;
-end;
-
-destructor TAbstractIntegerMap.Destroy;
-begin
- FAssociationComparator := nil;
- inherited Destroy;
-end;
-
-function TAbstractIntegerMap.TrueAdd(const Item: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
- Mappable: IIntegerMappable;
-begin
- if IsNaturalItem(Item) then
- begin
- Mappable := Item as IIntegerMappable;
- Position := GetKeyPosition(Mappable.GetKey);
- try
- if Position.Found then
- begin
- CollectionError(ceDuplicateKey);
- Result := false;
- end
- else
- begin
- TruePut(Position, TIntegerAssociation.Create(Mappable.GetKey, Item));
- Result := true;
- end;
- finally
- Position.Free;
- end;
- end
- else
- begin
- CollectionError(ceNotNaturalItem);
- Result := false;
- end;
-end;
-
-function TAbstractIntegerMap.TrueContains(const Item: ICollectable): Boolean;
-var
- Item2: ICollectable;
- Success: Boolean;
- Iterator: IIterator;
-begin
- Iterator := GetIterator;
- Success := false;
- while not Iterator.EOF and not Success do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- Success := true;
- Iterator.Next;
- end;
- Result := Success;
-end;
-
-function TAbstractIntegerMap.TrueRemove(const Item: ICollectable): ICollectable;
-var
- Item2: ICollectable;
- Iterator: IIntegerMapIterator;
- Found: Boolean;
-begin
- // Sequential search
- Found := false;
- Result := nil;
- Iterator := GetAssociationIterator;
- while not Iterator.EOF and not Found do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- Result := Item2;
- Iterator.Remove;
- Found := true;
- end;
- Iterator.Next;
- end;
-end;
-
-function TAbstractIntegerMap.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Item2: ICollectable;
- Iterator: IIntegerMapIterator;
-begin
- // Sequential search
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := GetAssociationIterator;
- while not Iterator.EOF do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- ResultCollection.Add(Item2);
- Iterator.Remove;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.GetItem(const Key: Integer): ICollectable;
-begin
- Result := Get(Key);
-end;
-
-procedure TAbstractIntegerMap.SetItem(const Key: Integer; const Item: ICollectable);
-begin
- Put(Key, Item);
-end;
-
-function TAbstractIntegerMap.GetIterator: IIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractIntegerMap.GetKeys: ISet;
-var
- ResultCollection: TPArraySet;
- MapIterator: IIntegerMapIterator;
-begin
- ResultCollection := TPArraySet.Create(true);
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- ResultCollection.Add(TIntegerWrapper.Create(MapIterator.CurrentKey) as ICollectable);
- MapIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.GetMapIterator: IIntegerMapIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractIntegerMap.GetNaturalItemIID: TGUID;
-begin
- Result := IntegerMappableIID;
-end;
-
-function TAbstractIntegerMap.GetType: TCollectionType;
-begin
- Result := ctIntegerMap;
-end;
-
-function TAbstractIntegerMap.GetValues: ICollection;
-var
- ResultCollection: ICollection;
- ValueIterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- ValueIterator := GetIterator;
- while not ValueIterator.EOF do
- begin
- ResultCollection.Add(ValueIterator.CurrentItem);
- ValueIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-// Overrides TAbstractCollection function, otherwise Create(ICollection) is
-// called, which cannot access keys.
-function TAbstractIntegerMap.Clone: ICollection;
-begin
- Result := (TAbstractIntegerMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractIntegerMap.CloneAsIntegerMap: IIntegerMap;
-begin
- Result := (TAbstractIntegerMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractIntegerMap.ContainsKey(const Key: Integer): Boolean;
-var
- Position: TCollectionPosition;
-begin
- Position := GetKeyPosition(Key);
- try
- Result := Position.Found;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractIntegerMap.ContainsKey(const KeyArray: array of Integer): Boolean;
-var
- I: Integer;
- Success: Boolean;
-begin
- Success := true;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Success := Success and ContainsKey(KeyArray[I]);
- if not Success then
- break;
- end;
- Result := Success;
-end;
-
-function TAbstractIntegerMap.Get(const Key: Integer): ICollectable;
-var
- Position: TCollectionPosition;
-begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- Result := TrueGet(Position).GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractIntegerMap.IsNilAllowed: Boolean;
-begin
- Result := true;
-end;
-
-function TAbstractIntegerMap.Put(const Item: ICollectable): ICollectable;
-var
- Mappable: IIntegerMappable;
- OldAssociation, NewAssociation: IIntegerAssociation;
- Position: TCollectionPosition;
-begin
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- Result := nil;
- end
- else
- begin
- Item.QueryInterface(IIntegerMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractIntegerMap.Put(const Key: Integer; const Item: ICollectable): ICollectable;
-var
- OldAssociation, NewAssociation: IIntegerAssociation;
- ItemError: TCollectionError;
- Position: TCollectionPosition;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := nil;
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TIntegerAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractIntegerMap.Put(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IIntegerMappable;
- OldAssociation, NewAssociation: IIntegerAssociation;
- Position: TCollectionPosition;
- Item: ICollectable;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- Item.QueryInterface(IIntegerMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.Put(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IIntegerMappable;
- OldAssociation, NewAssociation: IIntegerAssociation;
- Position: TCollectionPosition;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;;
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- Item.QueryInterface(IIntegerMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.Put(const Map: IIntegerMap): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation, NewAssociation: IIntegerAssociation;
- ItemError: TCollectionError;
- Position: TCollectionPosition;
- MapIterator: IIntegerMapIterator;
- Item: ICollectable;
- Key: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Key := MapIterator.CurrentKey;
- Item := MapIterator.CurrentItem;
-
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TIntegerAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.RemoveKey(const Key: Integer): ICollectable;
-var
- Position: TCollectionPosition;
- OldAssociation: IIntegerAssociation;
-begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- Result := OldAssociation.GetValue
- end
- else
- Result := nil;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractIntegerMap.RemoveKey(const KeyArray: array of Integer): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation: IIntegerAssociation;
- Position: TCollectionPosition;
- Key: Integer;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Key := KeyArray[I];
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- ResultCollection.Add(OldAssociation.GetValue);
- end;
- finally
- Position.Free;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractIntegerMap.RetainKey(const KeyArray: array of Integer): ICollection;
-var
- ResultCollection: ICollection;
- MapIterator: IIntegerMapIterator;
- I: Integer;
- Found: Boolean;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else
- begin
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- // Converting the array to a map would be faster but I don't want to
- // couple base class code to a complex collection.
- Found := false;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Found := (MapIterator.CurrentKey = KeyArray[I]);
- if Found then
- break;
- end;
- if not Found then
- begin
- ResultCollection.Add(MapIterator.CurrentItem);
- MapIterator.Remove;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
- end;
-end;
-
-
-{ TAbstractStringMap }
-constructor TAbstractStringMap.Create(NaturalItemsOnly: Boolean);
-begin
- inherited Create(NaturalItemsOnly);
- FAssociationComparator := TStringAssociationComparator.Create;
-end;
-
-constructor TAbstractStringMap.Create(const ItemArray: array of ICollectable);
-begin
- Create(ItemArray, true);
-end;
-
-constructor TAbstractStringMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-begin
- inherited Create(ItemArray, true);
-end;
-
-constructor TAbstractStringMap.Create(const KeyArray: array of String; const ItemArray: array of ICollectable);
-begin
- Create(KeyArray, ItemArray, false);
-end;
-
-constructor TAbstractStringMap.Create(const KeyArray: array of String; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
-var
- I, Lo, Hi: Integer;
-begin
- Create(NaturalItemsOnly);
- Capacity := Min(Length(KeyArray), Length(ItemArray));
- if not FixedSize then
- begin
- Lo := Max(Low(KeyArray), Low(ItemArray));
- Hi := Min(High(KeyArray), High(ItemArray));
- for I := Lo to Hi do
- begin
- Put(KeyArray[I], ItemArray[I]);
- end;
- end;
-end;
-
-constructor TAbstractStringMap.Create(const Map: IStringMap);
-var
- MapIterator: IStringMapIterator;
-begin
- Create(Map.GetNaturalItemsOnly);
- InitFrom(Map);
- Capacity := Map.GetSize;
- if not FixedSize then
- begin
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
- MapIterator.Next;
- end;
- end;
-end;
-
-destructor TAbstractStringMap.Destroy;
-begin
- FAssociationComparator := nil;
- inherited Destroy;
-end;
-
-function TAbstractStringMap.TrueAdd(const Item: ICollectable): Boolean;
-var
- Position: TCollectionPosition;
- Mappable: IStringMappable;
-begin
- if IsNaturalItem(Item) then
- begin
- Mappable := Item as IStringMappable;
- Position := GetKeyPosition(Mappable.GetKey);
- try
- if Position.Found then
- begin
- CollectionError(ceDuplicateKey);
- Result := false;
- end
- else
- begin
- TruePut(Position, TStringAssociation.Create(Mappable.GetKey, Item));
- Result := true;
- end;
- finally
- Position.Free;
- end;
- end
- else
- begin
- CollectionError(ceNotNaturalItem);
- Result := false;
- end;
-end;
-
-function TAbstractStringMap.TrueContains(const Item: ICollectable): Boolean;
-var
- Item2: ICollectable;
- Success: Boolean;
- Iterator: IIterator;
-begin
- Iterator := GetIterator;
- Success := false;
- while not Iterator.EOF and not Success do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- Success := true;
- Iterator.Next;
- end;
- Result := Success;
-end;
-
-function TAbstractStringMap.TrueRemove(const Item: ICollectable): ICollectable;
-var
- Item2: ICollectable;
- Iterator: IStringMapIterator;
- Found: Boolean;
-begin
- // Sequential search
- Found := false;
- Result := nil;
- Iterator := GetAssociationIterator;
- while not Iterator.EOF and not Found do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- Result := Item2;
- Iterator.Remove;
- Found := true;
- end;
- Iterator.Next;
- end;
-end;
-
-function TAbstractStringMap.TrueRemoveAll(const Item: ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Item2: ICollectable;
- Iterator: IIterator;
-begin
- // Sequential search
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := GetAssociationIterator;
- while not Iterator.EOF do
- begin
- Item2 := Iterator.CurrentItem;
- if Comparator.Equals(Item, Item2) then
- begin
- ResultCollection.Add(Item2);
- Iterator.Remove;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.GetItem(const Key: String): ICollectable;
-begin
- Result := Get(Key);
-end;
-
-procedure TAbstractStringMap.SetItem(const Key: String; const Item: ICollectable);
-begin
- Put(Key, Item);
-end;
-
-function TAbstractStringMap.GetIterator: IIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractStringMap.GetKeys: ISet;
-var
- ResultCollection: TPArraySet;
- MapIterator: IStringMapIterator;
-begin
- ResultCollection := TPArraySet.Create(true);
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- ResultCollection.Add(TStringWrapper.Create(MapIterator.CurrentKey) as ICollectable);
- MapIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.GetMapIterator: IStringMapIterator;
-begin
- Result := GetAssociationIterator;
-end;
-
-function TAbstractStringMap.GetNaturalItemIID: TGUID;
-begin
- Result := StringMappableIID;
-end;
-
-function TAbstractStringMap.GetType: TCollectionType;
-begin
- Result := ctStringMap;
-end;
-
-function TAbstractStringMap.GetValues: ICollection;
-var
- ResultCollection: ICollection;
- ValueIterator: IIterator;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- ValueIterator := GetIterator;
- while not ValueIterator.EOF do
- begin
- ResultCollection.Add(ValueIterator.CurrentItem);
- ValueIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-// Overrides TAbstractCollection function, otherwise Create(ICollection) is
-// called, which cannot access keys.
-function TAbstractStringMap.Clone: ICollection;
-begin
- Result := (TAbstractStringMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractStringMap.CloneAsStringMap: IStringMap;
-begin
- Result := (TAbstractStringMapClass(ClassType)).Create(Self);
-end;
-
-function TAbstractStringMap.ContainsKey(const Key: String): Boolean;
-var
- Position: TCollectionPosition;
-begin
- Position := GetKeyPosition(Key);
- try
- Result := Position.Found;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractStringMap.ContainsKey(const KeyArray: array of String): Boolean;
-var
- I: Integer;
- Success: Boolean;
-begin
- Success := true;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Success := Success and ContainsKey(KeyArray[I]);
- if not Success then
- break;
- end;
- Result := Success;
-end;
-
-function TAbstractStringMap.Get(const Key: String): ICollectable;
-var
- Position: TCollectionPosition;
-begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- Result := TrueGet(Position).GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractStringMap.IsNilAllowed: Boolean;
-begin
- Result := true;
-end;
-
-function TAbstractStringMap.Put(const Item: ICollectable): ICollectable;
-var
- Mappable: IStringMappable;
- OldAssociation, NewAssociation: IStringAssociation;
- Position: TCollectionPosition;
-begin
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- Result := nil;
- end
- else
- begin
- Item.QueryInterface(IStringMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractStringMap.Put(const Key: String; const Item: ICollectable): ICollectable;
-var
- OldAssociation, NewAssociation: IStringAssociation;
- ItemError: TCollectionError;
- Position: TCollectionPosition;
-begin
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- Result := nil;
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TStringAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- Result := OldAssociation.GetValue
- else
- Result := nil;
- finally
- Position.Free;
- end;
- end;
-end;
-
-function TAbstractStringMap.Put(const ItemArray: array of ICollectable): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IStringMappable;
- OldAssociation, NewAssociation: IStringAssociation;
- Position: TCollectionPosition;
- Item: ICollectable;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(ItemArray) to High(ItemArray) do
- begin
- Item := ItemArray[I];
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- Item.QueryInterface(IStringMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.Put(const Collection: ICollection): ICollection;
-var
- ResultCollection: ICollection;
- Mappable: IStringMappable;
- OldAssociation, NewAssociation: IStringAssociation;
- Position: TCollectionPosition;
- Iterator: IIterator;
- Item: ICollectable;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- Iterator := Collection.GetIterator;
- while not Iterator.EOF do
- begin
- Item := Iterator.CurrentItem;;
- if not IsNaturalItem(Item) then
- begin
- CollectionError(ceNotNaturalItem);
- end
- else
- begin
- Item.QueryInterface(IStringMappable, Mappable);
- Position := GetKeyPosition(Mappable.GetKey);
- try
- NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- Iterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.Put(const Map: IStringMap): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation, NewAssociation: IStringAssociation;
- ItemError: TCollectionError;
- Position: TCollectionPosition;
- MapIterator: IStringMapIterator;
- Item: ICollectable;
- Key: String;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- MapIterator := Map.GetMapIterator;
- while not MapIterator.EOF do
- begin
- Key := MapIterator.CurrentKey;
- Item := MapIterator.CurrentItem;
-
- ItemError := ItemAllowed(Item);
- if ItemError <> ceOK then
- begin
- CollectionError(ItemError);
- end
- else
- begin
- Position := GetKeyPosition(Key);
- try
- NewAssociation := TStringAssociation.Create(Key, Item);
- OldAssociation := TruePut(Position, NewAssociation);
- if OldAssociation <> nil then
- ResultCollection.Add(OldAssociation.GetValue);
- finally
- Position.Free;
- end;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.RemoveKey(const Key: String): ICollectable;
-var
- Position: TCollectionPosition;
- OldAssociation: IStringAssociation;
-begin
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- Result := OldAssociation.GetValue
- end
- else
- Result := nil;
- finally
- Position.Free;
- end;
-end;
-
-function TAbstractStringMap.RemoveKey(const KeyArray: array of String): ICollection;
-var
- ResultCollection: ICollection;
- OldAssociation: IStringAssociation;
- Position: TCollectionPosition;
- Key: String;
- I: Integer;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Key := KeyArray[I];
- Position := GetKeyPosition(Key);
- try
- if Position.Found then
- begin
- OldAssociation := TrueRemove2(Position);
- ResultCollection.Add(OldAssociation.GetValue);
- end;
- finally
- Position.Free;
- end;
- end;
- Result := ResultCollection;
-end;
-
-function TAbstractStringMap.RetainKey(const KeyArray: array of String): ICollection;
-var
- ResultCollection: ICollection;
- MapIterator: IStringMapIterator;
- I: Integer;
- Found: Boolean;
-begin
- ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
- if FixedSize then
- begin
- CollectionError(ceFixedSize);
- end
- else
- begin
- MapIterator := GetMapIterator;
- while not MapIterator.EOF do
- begin
- // Converting the array to a map would be faster but I don't want to
- // couple base class code to a complex collection.
- Found := false;
- for I := Low(KeyArray) to High(KeyArray) do
- begin
- Found := (MapIterator.CurrentKey = KeyArray[I]);
- if Found then
- break;
- end;
- if not Found then
- begin
- ResultCollection.Add(MapIterator.CurrentItem);
- MapIterator.Remove;
- end;
- MapIterator.Next;
- end;
- Result := ResultCollection;
- end;
-end;
-
-
-{ ECollectionError }
-constructor ECollectionError.Create(const Msg: String; const Collection: ICollection; ErrorType: TCollectionError);
-begin
- inherited Create(Msg);
- FCollection := Collection;
- FErrorType := ErrorType;
-end;
-
-{ TAbstractListIterator }
-constructor TAbstractListIterator.Create(Collection: TAbstractList);
-begin
- inherited Create(true);
- FCollection := Collection;
- First;
-end;
-
-function TAbstractListIterator.TrueFirst: ICollectable;
-begin
- FIndex := 0;
- if FIndex < FCollection.GetSize then
- Result := FCollection.GetItem(FIndex)
- else
- Result := nil;
-end;
-
-function TAbstractListIterator.TrueNext: ICollectable;
-begin
- Inc(FIndex);
- if FIndex < FCollection.GetSize then
- Result := FCollection.GetItem(FIndex)
- else
- Result := nil;
-end;
-
-procedure TAbstractListIterator.TrueRemove;
-begin
- FCollection.Delete(FIndex);
- Dec(FIndex);
-end;
-
-end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-10 18:26:35 +0000