37841 lines
1.1 MiB
37841 lines
1.1 MiB
{******************************************************************************}
|
|
{ }
|
|
{ Library: Fundamentals 5.00 }
|
|
{ File name: flcDataStructs.pas }
|
|
{ File version: 5.44 }
|
|
{ Description: Data structures }
|
|
{ }
|
|
{ Copyright: Copyright (c) 1999-2020, David J Butler }
|
|
{ All rights reserved. }
|
|
{ Redistribution and use in source and binary forms, with }
|
|
{ or without modification, are permitted provided that }
|
|
{ the following conditions are met: }
|
|
{ Redistributions of source code must retain the above }
|
|
{ copyright notice, this list of conditions and the }
|
|
{ following disclaimer. }
|
|
{ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
|
|
{ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
|
|
{ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
|
|
{ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
|
|
{ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
|
|
{ THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
|
|
{ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
|
|
{ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
|
|
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
|
|
{ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
|
|
{ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
|
|
{ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
|
|
{ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
|
|
{ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
|
|
{ POSSIBILITY OF SUCH DAMAGE. }
|
|
{ }
|
|
{ Github: https://github.com/fundamentalslib }
|
|
{ E-mail: fundamentals.library at gmail.com }
|
|
{ }
|
|
{ Description: }
|
|
{ }
|
|
{ This unit implements classes for the following commonly used data }
|
|
{ structures: }
|
|
{ + Arrays }
|
|
{ + Dictionaries }
|
|
{ + Sparse Arrays }
|
|
{ + Linked Lists }
|
|
{ }
|
|
{ ARRAYS }
|
|
{ }
|
|
{ Arrays are ordered collections where items are indexed by consecutive }
|
|
{ integer values. }
|
|
{ }
|
|
{ This unit implements array classes for each of the following types: }
|
|
{ + Int32 }
|
|
{ + LongInt }
|
|
{ + Word32 }
|
|
{ + LongWord }
|
|
{ + Int64 }
|
|
{ + Single }
|
|
{ + Double }
|
|
{ + Extended }
|
|
{ + Pointer }
|
|
{ + AnsiString }
|
|
{ + RawByteString }
|
|
{ + String }
|
|
{ + Object }
|
|
{ }
|
|
{ DICTIONARIES }
|
|
{ }
|
|
{ Dictionaries are associative arrays where the key value is a string. }
|
|
{ }
|
|
{ Associative arrays, also referred to as mappings, are unordered }
|
|
{ collections where an arbitrary key can be used to index a value. }
|
|
{ }
|
|
{ This unit implements dictionary classes for each of the following types: }
|
|
{ + Integer }
|
|
{ + Cardinal }
|
|
{ + Int64 }
|
|
{ + Single }
|
|
{ + Double }
|
|
{ + Extended }
|
|
{ + Pointer }
|
|
{ + AnsiString }
|
|
{ + RawByteString }
|
|
{ + String }
|
|
{ + TObject }
|
|
{ + IInterface }
|
|
{ }
|
|
{ For example, the class TIntegerDictionary is used where the key is an }
|
|
{ arbitrary string and the value an integer. }
|
|
{ }
|
|
{ Ages := TIntegerDictionary.Create; }
|
|
{ Ages['John'] := 29; }
|
|
{ Ages['Tori'] := 35; }
|
|
{ if Ages.HasKey['John'] then }
|
|
{ Ages.Delete('John'); }
|
|
{ Ages.Free; }
|
|
{ }
|
|
{ SPARSE ARRAYS }
|
|
{ }
|
|
{ Sparse arrays are associative arrays where the index value is an }
|
|
{ arbitrary integer. }
|
|
{ }
|
|
{ Associative arrays, also referred to as mappings, are unordered }
|
|
{ collections where an arbitrary key can be used to index a value. }
|
|
{ }
|
|
{ This unit implements sparse arrays that can hold the following values: }
|
|
{ + String }
|
|
{ + Int64 }
|
|
{ + Extended }
|
|
{ + TObject }
|
|
{ }
|
|
{ For example, the class TSparseStringArray is used where the key is an }
|
|
{ arbitrary integer and the value a string. }
|
|
{ }
|
|
{ Names := TSparseStringArray.Create; }
|
|
{ Names[123] := 'John'; }
|
|
{ Names[999] := 'Tori'; }
|
|
{ if Names.HasItem(123) then }
|
|
{ Names.Delete(123); }
|
|
{ Names.Free; }
|
|
{ }
|
|
{ Revision history: }
|
|
{ }
|
|
{ 1999/11/12 0.01 Split cTypes from cDataStruct and cHolder. }
|
|
{ 1999/11/14 0.02 Added AListType. }
|
|
{ 2000/02/08 1.03 Initial version. AArray, TArray and TStreamArray. }
|
|
{ 2000/06/07 1.04 Base classes (AIntegerArray, ASet). }
|
|
{ 2000/06/08 1.05 Added AObjectArray. }
|
|
{ 2000/06/03 1.06 Added AArray, AIntegerArray, AExtendedArray, }
|
|
{ AStringArray and ABitArray (formerly ASet) with some }
|
|
{ implementations. }
|
|
{ 2000/06/06 1.07 TFlatBitArray implementation. }
|
|
{ Added AInt64Array. }
|
|
{ 2000/06/08 1.08 Added TObjectArray. }
|
|
{ 2000/06/10 1.09 Added linked lists. }
|
|
{ 2000/06/14 1.10 Converted cDataStructs to template. }
|
|
{ 2000/06/16 1.11 Added ADictionary. }
|
|
{ 2000/07/07 1.12 Added ATypeDictionary. }
|
|
{ 2001/01/19 1.13 Added THashedStringDictionary. }
|
|
{ 2001/04/13 1.14 Added TObjectDictionary. }
|
|
{ 2001/07/15 1.15 Changed memory arrays to pre-allocate when growing. }
|
|
{ 2001/08/20 2.16 Merged cTypes and cDataStructs to allow object }
|
|
{ interface implementation in base classes. }
|
|
{ 2002/05/15 3.17 Created cArrays unit from cDataStructs. }
|
|
{ Refactored for Fundamentals 3. }
|
|
{ 2002/09/30 3.18 Moved stream array classes to unit cStreamArrays. }
|
|
{ 2002/12/17 3.19 Added THashedStringArray. }
|
|
{ 2003/03/08 3.20 Renamed Add methods to Append. }
|
|
{ 2003/05/26 3.21 Added Remove methods to object array. }
|
|
{ 2003/07/27 3.22 Initial version (sparse object array). }
|
|
{ 2003/09/11 3.23 Added TInterfaceArray. }
|
|
{ 2004/01/02 3.24 Bug fixed in TStringArray.SetAsString by Eb. }
|
|
{ 2004/01/18 3.25 Added TWideStringArray. }
|
|
{ 2004/03/31 3.26 Added sparse String, WideString and Int64 arrays. }
|
|
{ 2004/07/24 3.27 Fixed bug in Sort with duplicate values. Thanks to Eb }
|
|
{ and others for reporting it. }
|
|
{ 2004/08/01 3.28 Added AArray.RemoveDuplicates. }
|
|
{ 2005/01/27 3.29 Added sparse Extended array. }
|
|
{ 2006/05/10 3.30 Fixed bug in TDoublyLinkedList.DeleteList as reported }
|
|
{ by Malinovsky Vladimir. }
|
|
{ 2007/09/27 4.31 Merged into single unit for Fundamentals 4. }
|
|
{ 2009/09/23 4.32 Fixed bug in TDoublyLinkedList.InsertBefore/InsertAfter }
|
|
{ reported by Steffen Thorkildsen. }
|
|
{ 2011/08/27 4.33 Fixed bugs in THashedAnsiStringArray reported by }
|
|
{ H Visli. }
|
|
{ 2012/04/11 4.34 Unicode string changes. }
|
|
{ 2012/09/01 4.35 Unicode string changes. }
|
|
{ 2015/03/13 4.36 RawByteString support. }
|
|
{ 2016/01/16 5.37 Revised for Fundamentals 5. }
|
|
{ 2018/07/17 5.38 Int32/Word32 arrays. }
|
|
{ 2018/08/12 5.39 String type changes. }
|
|
{ 2019/04/02 5.40 Integer/Cardinal array changes. }
|
|
{ 2020/03/22 5.41 Rename parameters to avoid conflict with properties. }
|
|
{ 2020/03/22 5.42 Remove dependency on flcBits32. }
|
|
{ 2020/03/31 5.43 LongWord changes in bit array. Integer array changes. }
|
|
{ 2020/06/02 5.44 UInt64 changes. }
|
|
{ }
|
|
{ Supported compilers: }
|
|
{ }
|
|
{ Delphi 2010-10.4 Win32/Win64 5.44 2020/06/02 }
|
|
{ Delphi 10.2-10.4 Linux64 5.44 2020/06/02 }
|
|
{ FreePascal 3.0.4 Win64 5.44 2020/06/02 }
|
|
{ }
|
|
{******************************************************************************}
|
|
|
|
{$INCLUDE ..\flcInclude.inc}
|
|
|
|
{$IFDEF FREEPASCAL}
|
|
{$WARNINGS OFF}
|
|
{$HINTS OFF}
|
|
{$ENDIF}
|
|
|
|
unit flcDataStructs;
|
|
|
|
interface
|
|
|
|
uses
|
|
{ System }
|
|
SysUtils,
|
|
|
|
{ Fundamentals }
|
|
flcStdTypes,
|
|
flcUtils;
|
|
|
|
|
|
|
|
{ }
|
|
{ A note on the class naming convention used in this unit: }
|
|
{ }
|
|
{ Classes with the A-prefix are abstract base classes. They define the }
|
|
{ interface for the type and must never be instanciated. Implementation }
|
|
{ classes follow the standard naming convention of using the T-prefix. }
|
|
{ }
|
|
|
|
|
|
|
|
{ }
|
|
{ TYPE BASE CLASS }
|
|
{ }
|
|
|
|
|
|
|
|
{ }
|
|
{ AType }
|
|
{ Abstract base class for data structures. }
|
|
{ }
|
|
{ Provides an interface for commonly used data operations such as }
|
|
{ assigning, comparing and duplicating. }
|
|
{ }
|
|
{ Duplicate creates a new instance of the object (using CreateInstance) and }
|
|
{ then copies the content (using Assign). Implementations do not have to }
|
|
{ override Duplicate if both CreateInstance and Assign are implemented. }
|
|
{ Assign's default implementation calls the protected AssignTo. }
|
|
{ }
|
|
{ Clear sets an instance's content (value) to an empty/zero state. This }
|
|
{ state should be similar to the state of a new instance created using }
|
|
{ CreateInstance. }
|
|
{ }
|
|
{ IsEqual compares the content of instances. After a call to Assign, an }
|
|
{ equivalent call to IsEqual should return True. }
|
|
{ }
|
|
{ Compare is the ranking function used by sorting and searching. }
|
|
{ }
|
|
{ HashValue returns a 'random' number, based on the content (value). }
|
|
{ }
|
|
{ AsString is the default string type representation of the content. }
|
|
{ }
|
|
type
|
|
EType = class(Exception);
|
|
AType = class
|
|
protected
|
|
procedure RaiseTypeError(const Msg: String; const ErrorClass: ExceptClass = nil); virtual;
|
|
|
|
procedure Init; virtual;
|
|
procedure AssignTo(const Dest: TObject); virtual;
|
|
|
|
function GetAsString: String; virtual;
|
|
procedure SetAsString(const S: String); virtual;
|
|
|
|
function GetAsUTF8String: RawByteString; virtual;
|
|
procedure SetAsUTF8String(const S: RawByteString); virtual;
|
|
|
|
function GetAsUnicodeString: UnicodeString; virtual;
|
|
procedure SetAsUnicodeString(const S: UnicodeString); virtual;
|
|
|
|
public
|
|
constructor Create;
|
|
class function CreateInstance: AType; virtual;
|
|
|
|
function Duplicate: TObject; virtual;
|
|
procedure Assign(const Source: TObject); overload; virtual;
|
|
|
|
procedure Clear; virtual;
|
|
function IsEmpty: Boolean; virtual;
|
|
function IsEqual(const V: TObject): Boolean; virtual;
|
|
function Compare(const V: TObject): TCompareResult; virtual;
|
|
function HashValue: Word32; virtual;
|
|
|
|
property AsString: String read GetAsString write SetAsString;
|
|
property AsUTF8String: RawByteString read GetAsUTF8String write SetAsUTF8String;
|
|
property AsUnicodeString: UnicodeString read GetAsUnicodeString write SetAsUnicodeString;
|
|
end;
|
|
TypeClass = class of AType;
|
|
ATypeArray = Array of AType;
|
|
TypeClassArray = Array of TypeClass;
|
|
|
|
|
|
|
|
{ }
|
|
{ AType helper functions }
|
|
{ }
|
|
function TypeDuplicate(const V: TObject): TObject;
|
|
procedure TypeAssign(const A, B: TObject);
|
|
procedure TypeClear(const V: TObject);
|
|
function TypeIsEqual(const A, B: TObject): Boolean;
|
|
function TypeCompare(const A, B: TObject): TCompareResult;
|
|
function TypeHashValue(const A: TObject): Word32;
|
|
function TypeGetAsString(const V: TObject): String;
|
|
procedure TypeSetAsString(const V: TObject; const S: String);
|
|
function TypeGetAsUTF8String(const V: TObject): RawByteString;
|
|
procedure TypeSetAsUTF8String(const V: TObject; const S: RawByteString);
|
|
function TypeGetAsUnicodeString(const V: TObject): UnicodeString;
|
|
procedure TypeSetAsUnicodeString(const V: TObject; const S: UnicodeString);
|
|
|
|
|
|
|
|
{ }
|
|
{ ARRAY BASE CLASSES }
|
|
{ }
|
|
|
|
|
|
|
|
{ }
|
|
{ AArray }
|
|
{ Base class for an array. }
|
|
{ }
|
|
type
|
|
AArray = class(AType)
|
|
protected
|
|
procedure RaiseIndexError(const Idx: Integer); virtual;
|
|
|
|
function GetAsString: String; override;
|
|
procedure SetAsString(const S: String); override;
|
|
|
|
function GetCount: Integer; virtual; abstract;
|
|
procedure SetCount(const NewCount: Integer); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; virtual;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ AArray }
|
|
property Count: Integer read GetCount write SetCount;
|
|
property ItemAsString[const Idx: Integer]: String read GetItemAsString write SetItemAsString;
|
|
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; virtual; abstract;
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); virtual; abstract;
|
|
procedure Sort; virtual;
|
|
procedure ReverseOrder; virtual;
|
|
procedure RemoveDuplicates(const IsSortedAscending: Boolean); virtual;
|
|
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; virtual; abstract;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); virtual; abstract;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); virtual; abstract;
|
|
function AppendArray(const V: AArray): Integer; overload; virtual; abstract;
|
|
end;
|
|
EArray = class(EType);
|
|
ArrayClass = class of AArray;
|
|
|
|
|
|
|
|
{ }
|
|
{ AInt32Array }
|
|
{ Base class for an array of Int32s. }
|
|
{ }
|
|
type
|
|
AInt32Array = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): Int32; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: Int32); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): Int32Array; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: Int32Array); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AInt32Array interface }
|
|
property Item[const Idx: Integer]: Int32 read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: Int32Array read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: Int32); virtual;
|
|
function AppendItem(const Value: Int32): Integer; virtual;
|
|
function AppendArray(const V: Int32Array): Integer; overload; virtual;
|
|
function PosNext(const Find: Int32; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EInt32Array = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ AInt64Array }
|
|
{ Base class for an array of Int64s. }
|
|
{ }
|
|
type
|
|
AInt64Array = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): Int64; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: Int64); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): Int64Array; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: Int64Array); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AInt64Array interface }
|
|
property Item[const Idx: Integer]: Int64 read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: Int64Array read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: Int64); virtual;
|
|
function AppendItem(const Value: Int64): Integer; virtual;
|
|
function AppendArray(const V: Int64Array): Integer; overload; virtual;
|
|
function PosNext(const Find: Int64; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EInt64Array = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ ALongIntArray }
|
|
{ Base class for an array of LongInts. }
|
|
{ }
|
|
type
|
|
ALongIntArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): LongInt; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: LongInt); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): LongIntArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: LongIntArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ ALongIntArray interface }
|
|
property Item[const Idx: Integer]: LongInt read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: LongIntArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: LongInt); virtual;
|
|
function AppendItem(const Value: LongInt): Integer; virtual;
|
|
function AppendArray(const V: LongIntArray): Integer; overload; virtual;
|
|
function PosNext(const Find: LongInt; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
ELongIntArray = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ AIntegerArray }
|
|
{ }
|
|
type
|
|
AIntegerArray = AInt32Array;
|
|
EIntegerArray = EInt32Array;
|
|
|
|
|
|
|
|
{ }
|
|
{ AWord32Array }
|
|
{ Base class for an array of Word32s. }
|
|
{ }
|
|
type
|
|
AWord32Array = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): Word32; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: Word32); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): Word32Array; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: Word32Array); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AWord32Array interface }
|
|
property Item[const Idx: Integer]: Word32 read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: Word32Array read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: Word32); virtual;
|
|
function AppendItem(const Value: Word32): Integer; virtual;
|
|
function AppendArray(const V: Word32Array): Integer; overload; virtual;
|
|
function PosNext(const Find: Word32; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EWord32Array = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ AWord64Array }
|
|
{ Base class for an array of Word64s. }
|
|
{ }
|
|
type
|
|
AWord64Array = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): Word64; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: Word64); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): Word64Array; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: Word64Array); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AWord64Array interface }
|
|
property Item[const Idx: Integer]: Word64 read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: Word64Array read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: Word64); virtual;
|
|
function AppendItem(const Value: Word64): Integer; virtual;
|
|
function AppendArray(const V: Word64Array): Integer; overload; virtual;
|
|
function PosNext(const Find: Word64; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EWord64Array = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ ALongWordArray }
|
|
{ Base class for an array of LongWords. }
|
|
{ }
|
|
type
|
|
ALongWordArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): LongWord; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: LongWord); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): LongWordArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: LongWordArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ ALongWordArray interface }
|
|
property Item[const Idx: Integer]: LongWord read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: LongWordArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: LongWord); virtual;
|
|
function AppendItem(const Value: LongWord): Integer; virtual;
|
|
function AppendArray(const V: LongWordArray): Integer; overload; virtual;
|
|
function PosNext(const Find: LongWord; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
ELongWordArray = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ ACardinalArray }
|
|
{ }
|
|
type
|
|
ACardinalArray = AWord32Array;
|
|
ECardinalArray = EWord32Array;
|
|
|
|
|
|
|
|
{ }
|
|
{ ASingleArray }
|
|
{ Base class for an array of Singles. }
|
|
{ }
|
|
type
|
|
ASingleArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): Single; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: Single); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): SingleArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: SingleArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ ASingleArray interface }
|
|
property Item[const Idx: Integer]: Single read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: SingleArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: Single); virtual;
|
|
function AppendItem(const Value: Single): Integer; virtual;
|
|
function AppendArray(const V: SingleArray): Integer; overload; virtual;
|
|
function PosNext(const Find: Single; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
ESingleArray = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ ADoubleArray }
|
|
{ Base class for an array of Doubles. }
|
|
{ }
|
|
type
|
|
ADoubleArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): Double; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: Double); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): DoubleArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: DoubleArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ ADoubleArray interface }
|
|
property Item[const Idx: Integer]: Double read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: DoubleArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: Double); virtual;
|
|
function AppendItem(const Value: Double): Integer; virtual;
|
|
function AppendArray(const V: DoubleArray): Integer; overload; virtual;
|
|
function PosNext(const Find: Double; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EDoubleArray = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ AExtendedArray }
|
|
{ Base class for an array of Extendeds. }
|
|
{ }
|
|
type
|
|
AExtendedArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): Extended; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: Extended); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): ExtendedArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: ExtendedArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AExtendedArray interface }
|
|
property Item[const Idx: Integer]: Extended read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: ExtendedArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: Extended); virtual;
|
|
function AppendItem(const Value: Extended): Integer; virtual;
|
|
function AppendArray(const V: ExtendedArray): Integer; overload; virtual;
|
|
function PosNext(const Find: Extended; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EExtendedArray = class(EArray);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AAnsiStringArray }
|
|
{ Base class for an array of AnsiStrings. }
|
|
{ }
|
|
type
|
|
AAnsiStringArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): AnsiString; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: AnsiString); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): AnsiStringArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: AnsiStringArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AAnsiStringArray interface }
|
|
property Item[const Idx: Integer]: AnsiString read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: AnsiStringArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: AnsiString); virtual;
|
|
function AppendItem(const Value: AnsiString): Integer; virtual;
|
|
function AppendArray(const V: AnsiStringArray): Integer; overload; virtual;
|
|
function PosNext(const Find: AnsiString; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EAnsiStringArray = class(EArray);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ARawByteStringArray }
|
|
{ Base class for an array of RawByteStrings. }
|
|
{ }
|
|
type
|
|
ARawByteStringArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): RawByteString; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: RawByteString); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): RawByteStringArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: RawByteStringArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ ARawByteStringArray interface }
|
|
property Item[const Idx: Integer]: RawByteString read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: RawByteStringArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: RawByteString); virtual;
|
|
function AppendItem(const Value: RawByteString): Integer; virtual;
|
|
function AppendArray(const V: RawByteStringArray): Integer; overload; virtual;
|
|
function PosNext(const Find: RawByteString; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
ERawByteStringArray = class(EArray);
|
|
|
|
|
|
|
|
type
|
|
AUTF8StringArray = ARawByteStringArray;
|
|
EUTF8StringArray = ERawByteStringArray;
|
|
|
|
|
|
|
|
{ }
|
|
{ AUnicodeStringArray }
|
|
{ Base class for an array of UnicodeStrings. }
|
|
{ }
|
|
type
|
|
AUnicodeStringArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): UnicodeString; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: UnicodeString); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): UnicodeStringArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: UnicodeStringArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AUnicodeStringArray interface }
|
|
property Item[const Idx: Integer]: UnicodeString read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: UnicodeStringArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: UnicodeString); virtual;
|
|
function AppendItem(const Value: UnicodeString): Integer; virtual;
|
|
function AppendArray(const V: UnicodeStringArray): Integer; overload; virtual;
|
|
function PosNext(const Find: UnicodeString; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EUnicodeStringArray = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ AStringArray }
|
|
{ Base class for an array of Strings. }
|
|
{ }
|
|
type
|
|
AStringArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): String; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: String); virtual; abstract;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): StringArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: StringArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AStringArray interface }
|
|
property Item[const Idx: Integer]: String read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: StringArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: String); virtual;
|
|
function AppendItem(const Value: String): Integer; virtual;
|
|
function AppendArray(const V: StringArray): Integer; overload; virtual;
|
|
function PosNext(const Find: String; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EStringArray = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ APointerArray }
|
|
{ Base class for an array of Pointers. }
|
|
{ }
|
|
type
|
|
APointerArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): Pointer; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: Pointer); virtual; abstract;
|
|
|
|
function GetItemAsString(const Idx: Integer): String; override;
|
|
procedure SetItemAsString(const Idx: Integer; const Value: String); override;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): PointerArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: PointerArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ APointerArray interface }
|
|
property Item[const Idx: Integer]: Pointer read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: PointerArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: Pointer); virtual;
|
|
function AppendItem(const Value: Pointer): Integer; virtual;
|
|
function AppendArray(const V: PointerArray): Integer; overload; virtual;
|
|
function PosNext(const Find: Pointer; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EPointerArray = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ AInterfaceArray }
|
|
{ Base class for an array of Interfaces. }
|
|
{ }
|
|
type
|
|
AInterfaceArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): IInterface; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: IInterface); virtual; abstract;
|
|
|
|
function GetRange(const LoIdx, HiIdx: Integer): InterfaceArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: InterfaceArray); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AInterfaceArray interface }
|
|
property Item[const Idx: Integer]: IInterface read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: InterfaceArray read GetRange write SetRange;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: IInterface); virtual;
|
|
function AppendItem(const Value: IInterface): Integer; virtual;
|
|
function AppendArray(const V: InterfaceArray): Integer; overload; virtual;
|
|
function PosNext(const Find: IInterface; const PrevPos: Integer = -1;
|
|
const IsSortedAscending: Boolean = False): Integer;
|
|
end;
|
|
EInterfaceArray = class(EArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ AObjectArray }
|
|
{ Base class for an array of objects. }
|
|
{ }
|
|
type
|
|
EObjectArray = class(EArray);
|
|
AObjectArray = class(AArray)
|
|
protected
|
|
function GetItem(const Idx: Integer): TObject; virtual; abstract;
|
|
procedure SetItem(const Idx: Integer; const Value: TObject); virtual; abstract;
|
|
function GetRange(const LoIdx, HiIdx: Integer): ObjectArray; virtual;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: ObjectArray); virtual;
|
|
function GetAsString: String; override;
|
|
function GetIsItemOwner: Boolean; virtual; abstract;
|
|
procedure SetIsItemOwner(const AIsItemOwner: Boolean); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Clear; override;
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
function Compare(const V: TObject): TCompareResult; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function AppendArray(const V: AArray): Integer; overload; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AObjectArray interface }
|
|
property Item[const Idx: Integer]: TObject read GetItem write SetItem; default;
|
|
property Range[const LoIdx, HiIdx: Integer]: ObjectArray read GetRange write SetRange;
|
|
function AppendItem(const Value: TObject): Integer; virtual;
|
|
function AppendArray(const V: ObjectArray): Integer; overload; virtual;
|
|
|
|
function PosNext(const Find: TObject; const PrevPos: Integer): Integer; overload;
|
|
function PosNext(var AItem: TObject; const AClassType: TClass; const PrevPos: Integer = -1): Integer; overload;
|
|
function PosNext(var AItem: TObject; const AClassName: String; const PrevPos: Integer = -1): Integer; overload;
|
|
function Find(const AClassType: TClass; const ACount: Integer = 1): TObject; overload;
|
|
function Find(const AClassName: String; const ACount: Integer = 1): TObject; overload;
|
|
function FindAll(const AClassType: TClass): ObjectArray; overload;
|
|
function FindAll(const AClassName: String): ObjectArray; overload;
|
|
function CountItems(const AClassType: TClass): Integer; overload;
|
|
function CountItems(const AClassName: String): Integer; overload;
|
|
function DeleteValue(const Value: TObject): Boolean;
|
|
function DeleteAll(const Value: TObject): Integer;
|
|
|
|
property IsItemOwner: Boolean read GetIsItemOwner write SetIsItemOwner;
|
|
procedure ReleaseItems; virtual; abstract;
|
|
procedure FreeItems; virtual; abstract;
|
|
function ReleaseItem(const Idx: Integer): TObject; virtual; abstract;
|
|
function ReleaseValue(const Value: TObject): Boolean;
|
|
function RemoveItem(const Idx: Integer): TObject;
|
|
function RemoveValue(const Value: TObject): Boolean;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ABitArray }
|
|
{ Base class for bit array implementations. }
|
|
{ Bits are defined as False at initialization. }
|
|
{ FindRange finds Count consecutive bits that are equal to Value. It }
|
|
{ returns the index of the leftmost bit or -1 if not found. }
|
|
{ }
|
|
type
|
|
EBitArray = class(EArray);
|
|
ABitArray = class(AArray)
|
|
protected
|
|
function GetBit(const Idx: Integer): Boolean; virtual; abstract;
|
|
procedure SetBit(const Idx: Integer; const Value: Boolean); virtual; abstract;
|
|
function GetRangeL(const Idx: Integer): Word32; virtual;
|
|
procedure SetRangeL(const Idx: Integer; const Value: Word32); virtual;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
{ AArray }
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
function AppendArray(const V: AArray): Integer; override;
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function CompareItems(const Idx1, Idx2: Integer): TCompareResult; override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
|
|
{ ABitArray interface }
|
|
property Bit[const Idx: Integer]: Boolean read GetBit write SetBit; default;
|
|
property RangeL[const Idx: Integer]: Word32 read GetRangeL write SetRangeL;
|
|
function IsRange(const LoIdx, HiIdx: Integer; const Value: Boolean): Boolean; virtual;
|
|
procedure Fill(const Idx, ACount: Integer; const Value: Boolean); virtual;
|
|
function AppendItem(const Value: Boolean): Integer; virtual;
|
|
procedure Invert; virtual;
|
|
|
|
function Find(const Value: Boolean = False;
|
|
const Start: Integer = 0): Integer; virtual;
|
|
function FindRange(const Value: Boolean = False;
|
|
const Start: Integer = 0;
|
|
const ACount: Integer = 1): Integer; virtual;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ARRAY IMPLEMENTATIONS }
|
|
{ }
|
|
|
|
|
|
|
|
{ }
|
|
{ TInt32Array }
|
|
{ AInt32Array implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TInt32Array = class(AInt32Array)
|
|
protected
|
|
FData : Int32Array;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ AInt32Array }
|
|
function GetItem(const Idx: Integer): Int32; override;
|
|
procedure SetItem(const Idx: Integer; const Value: Int32); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): Int32Array; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: Int32Array); override;
|
|
procedure SetData(const AData: Int32Array); virtual;
|
|
|
|
public
|
|
constructor Create(const V: Int32Array = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AInt32Array }
|
|
procedure Assign(const V: Int32Array); overload;
|
|
procedure Assign(const V: Array of Int32); overload;
|
|
function AppendItem(const Value: Int32): Integer; override;
|
|
|
|
{ TInt32Array }
|
|
property Data: Int32Array read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInt64Array }
|
|
{ AInt64Array implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TInt64Array = class(AInt64Array)
|
|
protected
|
|
FData : Int64Array;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ AInt64Array }
|
|
function GetItem(const Idx: Integer): Int64; override;
|
|
procedure SetItem(const Idx: Integer; const Value: Int64); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): Int64Array; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: Int64Array); override;
|
|
procedure SetData(const AData: Int64Array); virtual;
|
|
|
|
public
|
|
constructor Create(const V: Int64Array = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AInt64Array }
|
|
procedure Assign(const V: Int64Array); overload;
|
|
procedure Assign(const V: Array of Int64); overload;
|
|
function AppendItem(const Value: Int64): Integer; override;
|
|
|
|
{ TInt64Array }
|
|
property Data: Int64Array read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongIntArray }
|
|
{ ALongIntArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TLongIntArray = class(ALongIntArray)
|
|
protected
|
|
FData : LongIntArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ ALongIntArray }
|
|
function GetItem(const Idx: Integer): LongInt; override;
|
|
procedure SetItem(const Idx: Integer; const Value: LongInt); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): LongIntArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: LongIntArray); override;
|
|
procedure SetData(const AData: LongIntArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: LongIntArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ ALongIntArray }
|
|
procedure Assign(const V: LongIntArray); overload;
|
|
procedure Assign(const V: Array of LongInt); overload;
|
|
function AppendItem(const Value: LongInt): Integer; override;
|
|
|
|
{ TLongIntArray }
|
|
property Data: LongIntArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TIntegerArray }
|
|
{ }
|
|
type
|
|
TIntegerArray = TInt32Array;
|
|
|
|
|
|
|
|
{ }
|
|
{ TNativeIntArray }
|
|
{ }
|
|
{$IFDEF CPU_32}
|
|
type
|
|
TNativeIntArray = TInt32Array;
|
|
{$ELSE}{$IFDEF CPU_64}
|
|
type
|
|
TNativeIntArray = TInt64Array;
|
|
{$ENDIF}{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ TIntArray }
|
|
{ }
|
|
type
|
|
TIntArray = TInt64Array;
|
|
|
|
|
|
|
|
{ }
|
|
{ TWord32Array }
|
|
{ AWord32Array implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TWord32Array = class(AWord32Array)
|
|
protected
|
|
FData : Word32Array;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ AWord32Array }
|
|
function GetItem(const Idx: Integer): Word32; override;
|
|
procedure SetItem(const Idx: Integer; const Value: Word32); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): Word32Array; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: Word32Array); override;
|
|
procedure SetData(const AData: Word32Array); virtual;
|
|
|
|
public
|
|
constructor Create(const V: Word32Array = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AWord32Array }
|
|
procedure Assign(const V: Word32Array); overload;
|
|
procedure Assign(const V: Array of Word32); overload;
|
|
function AppendItem(const Value: Word32): Integer; override;
|
|
|
|
{ TWord32Array }
|
|
property Data: Word32Array read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TWord64Array }
|
|
{ AWord64Array implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TWord64Array = class(AWord64Array)
|
|
protected
|
|
FData : Word64Array;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ AWord64Array }
|
|
function GetItem(const Idx: Integer): Word64; override;
|
|
procedure SetItem(const Idx: Integer; const Value: Word64); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): Word64Array; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: Word64Array); override;
|
|
procedure SetData(const AData: Word64Array); virtual;
|
|
|
|
public
|
|
constructor Create(const V: Word64Array = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AWord64Array }
|
|
procedure Assign(const V: Word64Array); overload;
|
|
procedure Assign(const V: Array of Word64); overload;
|
|
function AppendItem(const Value: Word64): Integer; override;
|
|
|
|
{ TWord64Array }
|
|
property Data: Word64Array read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongWordArray }
|
|
{ ALongWordArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TLongWordArray = class(ALongWordArray)
|
|
protected
|
|
FData : LongWordArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ ALongWordArray }
|
|
function GetItem(const Idx: Integer): LongWord; override;
|
|
procedure SetItem(const Idx: Integer; const Value: LongWord); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): LongWordArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: LongWordArray); override;
|
|
procedure SetData(const AData: LongWordArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: LongWordArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ ALongWordArray }
|
|
procedure Assign(const V: LongWordArray); overload;
|
|
procedure Assign(const V: Array of LongWord); overload;
|
|
function AppendItem(const Value: LongWord): Integer; override;
|
|
|
|
{ TLongWordArray }
|
|
property Data: LongWordArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TCardinalArray }
|
|
{ }
|
|
type
|
|
TCardinalArray = TWord32Array;
|
|
|
|
|
|
|
|
{ }
|
|
{ TUInt32Array }
|
|
{ }
|
|
type
|
|
TUInt32Array = Word32Array;
|
|
|
|
|
|
|
|
{ }
|
|
{ TUInt64Array }
|
|
{ }
|
|
type
|
|
TUInt64Array = Word64Array;
|
|
|
|
|
|
|
|
{ }
|
|
{ TNativeUIntArray }
|
|
{ }
|
|
{$IFDEF CPU_32}
|
|
type
|
|
TNativeUIntArray = TUInt32Array;
|
|
{$ELSE}{$IFDEF CPU_64}
|
|
type
|
|
TNativeUIntArray = TUInt64Array;
|
|
{$ENDIF}{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ TNativeWordArray }
|
|
{ }
|
|
type
|
|
TNativeWordArray = TNativeUIntArray;
|
|
|
|
|
|
|
|
{ }
|
|
{ TUIntArray }
|
|
{ }
|
|
type
|
|
TUIntArray = TUInt64Array;
|
|
|
|
|
|
|
|
{ }
|
|
{ TSingleArray }
|
|
{ ASingleArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TSingleArray = class(ASingleArray)
|
|
protected
|
|
FData : SingleArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ ASingleArray }
|
|
function GetItem(const Idx: Integer): Single; override;
|
|
procedure SetItem(const Idx: Integer; const Value: Single); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): SingleArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: SingleArray); override;
|
|
procedure SetData(const AData: SingleArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: SingleArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ ASingleArray }
|
|
procedure Assign(const V: SingleArray); overload;
|
|
procedure Assign(const V: Array of Single); overload;
|
|
function AppendItem(const Value: Single): Integer; override;
|
|
|
|
{ TSingleArray }
|
|
property Data: SingleArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoubleArray }
|
|
{ ADoubleArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TDoubleArray = class(ADoubleArray)
|
|
protected
|
|
FData : DoubleArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ ADoubleArray }
|
|
function GetItem(const Idx: Integer): Double; override;
|
|
procedure SetItem(const Idx: Integer; const Value: Double); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): DoubleArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: DoubleArray); override;
|
|
procedure SetData(const AData: DoubleArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: DoubleArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ ADoubleArray }
|
|
procedure Assign(const V: DoubleArray); overload;
|
|
procedure Assign(const V: Array of Double); overload;
|
|
function AppendItem(const Value: Double): Integer; override;
|
|
|
|
{ TDoubleArray }
|
|
property Data: DoubleArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TExtendedArray }
|
|
{ AExtendedArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TExtendedArray = class(AExtendedArray)
|
|
protected
|
|
FData : ExtendedArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ AExtendedArray }
|
|
function GetItem(const Idx: Integer): Extended; override;
|
|
procedure SetItem(const Idx: Integer; const Value: Extended); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): ExtendedArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: ExtendedArray); override;
|
|
procedure SetData(const AData: ExtendedArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: ExtendedArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AExtendedArray }
|
|
procedure Assign(const V: ExtendedArray); overload;
|
|
procedure Assign(const V: Array of Extended); overload;
|
|
function AppendItem(const Value: Extended): Integer; override;
|
|
|
|
{ TExtendedArray }
|
|
property Data: ExtendedArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TAnsiStringArray }
|
|
{ AAnsiStringArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TAnsiStringArray = class(AAnsiStringArray)
|
|
protected
|
|
FData : AnsiStringArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ AAnsiStringArray }
|
|
function GetItem(const Idx: Integer): AnsiString; override;
|
|
procedure SetItem(const Idx: Integer; const Value: AnsiString); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): AnsiStringArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: AnsiStringArray); override;
|
|
procedure SetData(const AData: AnsiStringArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: AnsiStringArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AAnsiStringArray }
|
|
procedure Assign(const V: AnsiStringArray); overload;
|
|
procedure Assign(const V: Array of AnsiString); overload;
|
|
function AppendItem(const Value: AnsiString): Integer; override;
|
|
|
|
{ TAnsiStringArray }
|
|
property Data: AnsiStringArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TRawByteStringArray }
|
|
{ ARawByteStringArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TRawByteStringArray = class(ARawByteStringArray)
|
|
protected
|
|
FData : RawByteStringArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ ARawByteStringArray }
|
|
function GetItem(const Idx: Integer): RawByteString; override;
|
|
procedure SetItem(const Idx: Integer; const Value: RawByteString); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): RawByteStringArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: RawByteStringArray); override;
|
|
procedure SetData(const AData: RawByteStringArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: RawByteStringArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ ARawByteStringArray }
|
|
procedure Assign(const V: RawByteStringArray); overload;
|
|
procedure Assign(const V: Array of RawByteString); overload;
|
|
function AppendItem(const Value: RawByteString): Integer; override;
|
|
|
|
{ TRawByteStringArray }
|
|
property Data: RawByteStringArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TUTF8StringArray }
|
|
{ }
|
|
type
|
|
TUTF8StringArray = TRawByteStringArray;
|
|
|
|
|
|
|
|
{ }
|
|
{ TUnicodeStringArray }
|
|
{ AUnicodeStringArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TUnicodeStringArray = class(AUnicodeStringArray)
|
|
protected
|
|
FData : UnicodeStringArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ AUnicodeStringArray }
|
|
function GetItem(const Idx: Integer): UnicodeString; override;
|
|
procedure SetItem(const Idx: Integer; const Value: UnicodeString); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): UnicodeStringArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: UnicodeStringArray); override;
|
|
procedure SetData(const AData: UnicodeStringArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: UnicodeStringArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AUnicodeStringArray }
|
|
procedure Assign(const V: UnicodeStringArray); overload;
|
|
procedure Assign(const V: Array of UnicodeString); overload;
|
|
function AppendItem(const Value: UnicodeString): Integer; override;
|
|
|
|
{ TUnicodeStringArray }
|
|
property Data: UnicodeStringArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TStringArray }
|
|
{ AStringArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TStringArray = class(AStringArray)
|
|
protected
|
|
FData : StringArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ AStringArray }
|
|
function GetItem(const Idx: Integer): String; override;
|
|
procedure SetItem(const Idx: Integer; const Value: String); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): StringArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: StringArray); override;
|
|
procedure SetData(const AData: StringArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: StringArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AStringArray }
|
|
procedure Assign(const V: StringArray); overload;
|
|
procedure Assign(const V: Array of String); overload;
|
|
function AppendItem(const Value: String): Integer; override;
|
|
|
|
{ TStringArray }
|
|
property Data: StringArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TPointerArray }
|
|
{ APointerArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TPointerArray = class(APointerArray)
|
|
protected
|
|
FData : PointerArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ APointerArray }
|
|
function GetItem(const Idx: Integer): Pointer; override;
|
|
procedure SetItem(const Idx: Integer; const Value: Pointer); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): PointerArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: PointerArray); override;
|
|
procedure SetData(const AData: PointerArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: PointerArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ APointerArray }
|
|
procedure Assign(const V: PointerArray); overload;
|
|
procedure Assign(const V: Array of Pointer); overload;
|
|
function AppendItem(const Value: Pointer): Integer; override;
|
|
|
|
{ TPointerArray }
|
|
property Data: PointerArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInterfaceArray }
|
|
{ AInterfaceArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TInterfaceArray = class(AInterfaceArray)
|
|
protected
|
|
FData : InterfaceArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
|
|
{ ACollection }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ AInterfaceArray }
|
|
function GetItem(const Idx: Integer): IInterface; override;
|
|
procedure SetItem(const Idx: Integer; const Value: IInterface); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): InterfaceArray; override;
|
|
procedure SetRange(const LoIdx, HiIdx: Integer; const V: InterfaceArray); override;
|
|
procedure SetData(const AData: InterfaceArray); virtual;
|
|
|
|
public
|
|
constructor Create(const V: InterfaceArray = nil); overload;
|
|
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); overload; override;
|
|
|
|
{ AArray }
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AInterfaceArray }
|
|
procedure Assign(const V: InterfaceArray); overload;
|
|
procedure Assign(const V: Array of IInterface); overload;
|
|
function AppendItem(const Value: IInterface): Integer; override;
|
|
|
|
{ TInterfaceArray }
|
|
property Data: InterfaceArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TObjectArray }
|
|
{ AObjectArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TObjectArray = class(AObjectArray)
|
|
protected
|
|
FData : ObjectArray;
|
|
FCapacity : Integer;
|
|
FCount : Integer;
|
|
FIsItemOwner : Boolean;
|
|
|
|
procedure Init; override;
|
|
procedure SetData(const AData: ObjectArray); virtual;
|
|
|
|
{ AArray }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ AObjectArray }
|
|
function GetItem(const Idx: Integer): TObject; override;
|
|
procedure SetItem(const Idx: Integer; const Value: TObject); override;
|
|
function GetRange(const LoIdx, HiIdx: Integer): ObjectArray; override;
|
|
function GetIsItemOwner: Boolean; override;
|
|
procedure SetIsItemOwner(const AIsItemOwner: Boolean); override;
|
|
|
|
public
|
|
{ TObjectArray interface }
|
|
constructor Create(const V: ObjectArray = nil;
|
|
const AIsItemOwner: Boolean = False); reintroduce; overload;
|
|
destructor Destroy; override;
|
|
|
|
property Data: ObjectArray read FData write SetData;
|
|
property Count: Integer read FCount write SetCount;
|
|
property IsItemOwner: Boolean read FIsItemOwner write FIsItemOwner;
|
|
procedure FreeItems; override;
|
|
procedure ReleaseItems; override;
|
|
function ReleaseItem(const Idx: Integer): TObject; override;
|
|
|
|
{ AArray }
|
|
function DuplicateRange(const LoIdx, HiIdx: Integer): AArray; override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
|
|
{ AObjectArray }
|
|
function AppendItem(const Value: TObject): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TBitArray }
|
|
{ ABitArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TBitArray = class(ABitArray)
|
|
protected
|
|
FData : Word32Array;
|
|
FCount : Integer;
|
|
|
|
{ AArray }
|
|
function GetCount: Integer; override;
|
|
procedure SetCount(const NewCount: Integer); override;
|
|
|
|
{ ABitArray }
|
|
function GetBit(const Idx: Integer): Boolean; override;
|
|
procedure SetBit(const Idx: Integer; const Value: Boolean); override;
|
|
function GetRangeL(const Idx: Integer): Word32; override;
|
|
procedure SetRangeL(const Idx: Integer; const Value: Word32); override;
|
|
|
|
public
|
|
{ ABitArray }
|
|
procedure Fill(const LoIdx, HiIdx: Integer; const Value: Boolean); override;
|
|
function IsRange(const LoIdx, HiIdx: Integer; const Value: Boolean): Boolean; override;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ THashedAnsiStringArray }
|
|
{ AAnsiStringArray that maintains a hash lookup table of array values. }
|
|
{ }
|
|
type
|
|
THashedAnsiStringArray = class(TAnsiStringArray)
|
|
protected
|
|
FLookup : Array of IntegerArray;
|
|
FCaseSensitive : Boolean;
|
|
|
|
function LocateItemHash(const Value: AnsiString;
|
|
var LookupList, LookupIdx: Integer): Boolean;
|
|
procedure Rehash;
|
|
|
|
procedure Init; override;
|
|
procedure SetItem(const Idx: Integer; const Value: AnsiString); override;
|
|
procedure SetData(const AData: AnsiStringArray); override;
|
|
|
|
public
|
|
constructor Create(const ACaseSensitive: Boolean = True);
|
|
|
|
procedure Assign(const Source: TObject); override;
|
|
procedure Clear; override;
|
|
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
function AppendItem(const Value: AnsiString): Integer; override;
|
|
|
|
function PosNext(const Find: AnsiString; const PrevPos: Integer = -1): Integer;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ THashedRawByteStringArray }
|
|
{ ARawByteStringArray that maintains a hash lookup table of array values. }
|
|
{ }
|
|
type
|
|
THashedRawByteStringArray = class(TRawByteStringArray)
|
|
protected
|
|
FLookup : Array of IntegerArray;
|
|
FCaseSensitive : Boolean;
|
|
|
|
function LocateItemHash(const Value: RawByteString;
|
|
var LookupList, LookupIdx: Integer): Boolean;
|
|
procedure Rehash;
|
|
|
|
procedure Init; override;
|
|
procedure SetItem(const Idx: Integer; const Value: RawByteString); override;
|
|
procedure SetData(const AData: RawByteStringArray); override;
|
|
|
|
public
|
|
constructor Create(const ACaseSensitive: Boolean = True);
|
|
|
|
procedure Assign(const Source: TObject); override;
|
|
procedure Clear; override;
|
|
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
function AppendItem(const Value: RawByteString): Integer; override;
|
|
|
|
function PosNext(const Find: RawByteString; const PrevPos: Integer = -1): Integer;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ THashedUnicodeStringArray }
|
|
{ AUnicodeStringArray that maintains a hash lookup table of array values. }
|
|
{ }
|
|
type
|
|
THashedUnicodeStringArray = class(TUnicodeStringArray)
|
|
protected
|
|
FLookup : Array of IntegerArray;
|
|
FCaseSensitive : Boolean;
|
|
|
|
function LocateItemHash(const Value: UnicodeString;
|
|
var LookupList, LookupIdx: Integer): Boolean;
|
|
procedure Rehash;
|
|
|
|
procedure Init; override;
|
|
procedure SetItem(const Idx: Integer; const Value: UnicodeString); override;
|
|
procedure SetData(const AData: UnicodeStringArray); override;
|
|
|
|
public
|
|
constructor Create(const ACaseSensitive: Boolean = True);
|
|
|
|
procedure Assign(const Source: TObject); override;
|
|
procedure Clear; override;
|
|
|
|
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
|
|
procedure Delete(const Idx: Integer; const ACount: Integer = 1); override;
|
|
procedure Insert(const Idx: Integer; const ACount: Integer = 1); override;
|
|
function AppendItem(const Value: UnicodeString): Integer; override;
|
|
|
|
function PosNext(const Find: UnicodeString; const PrevPos: Integer = -1): Integer;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ DICTIONARY BASE CLASSES }
|
|
{ }
|
|
|
|
|
|
|
|
{ }
|
|
{ ADictionary }
|
|
{ }
|
|
type
|
|
TDictionaryDuplicatesAction = (
|
|
ddError, // raises an exception on duplicate keys
|
|
ddAccept, // allow duplicate keys
|
|
ddIgnore); // silently discard duplicates
|
|
|
|
ADictionaryBase = class(AType)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetAddOnSet: Boolean; virtual; abstract;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); virtual; abstract;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; virtual; abstract;
|
|
procedure SetDuplicatesAction(const Value: TDictionaryDuplicatesAction); virtual; abstract;
|
|
|
|
function GetKeyStrByIndex(const Idx: Integer): String; virtual; abstract;
|
|
function GetItemStrByIndex(const Idx: Integer): String; virtual;
|
|
|
|
public
|
|
{ ADictionaryBase }
|
|
property AddOnSet: Boolean read GetAddOnSet write SetAddOnSet;
|
|
property DuplicatesAction: TDictionaryDuplicatesAction
|
|
read GetDuplicatesAction write SetDuplicatesAction;
|
|
|
|
function Count: Integer; virtual; abstract;
|
|
end;
|
|
|
|
EDictionary = class(EType);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ADictionaryA }
|
|
{ Base class for a dictionary with AnsiString keys. }
|
|
{ }
|
|
type
|
|
ADictionaryA = class(ADictionaryBase)
|
|
protected
|
|
procedure RaiseKeyNotFoundError(const Key: AnsiString);
|
|
procedure RaiseDuplicateKeyError(const Key: AnsiString);
|
|
|
|
function GetKeysCaseSensitive: Boolean; virtual; abstract;
|
|
|
|
public
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); virtual; abstract;
|
|
function HasKey(const Key: AnsiString): Boolean; virtual; abstract;
|
|
procedure Rename(const Key, NewKey: AnsiString); virtual; abstract;
|
|
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; virtual; abstract;
|
|
function GetKeyStrByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); virtual; abstract;
|
|
|
|
property KeysCaseSensitive: Boolean read GetKeysCaseSensitive;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ADictionaryB }
|
|
{ Base class for a dictionary with RawByteString keys. }
|
|
{ }
|
|
type
|
|
ADictionaryB = class(ADictionaryBase)
|
|
protected
|
|
procedure RaiseKeyNotFoundError(const Key: RawByteString);
|
|
procedure RaiseDuplicateKeyError(const Key: RawByteString);
|
|
|
|
function GetKeysCaseSensitive: Boolean; virtual; abstract;
|
|
|
|
public
|
|
{ ADictionary }
|
|
procedure Delete(const Key: RawByteString); virtual; abstract;
|
|
function HasKey(const Key: RawByteString): Boolean; virtual; abstract;
|
|
procedure Rename(const Key, NewKey: RawByteString); virtual; abstract;
|
|
|
|
function GetKeyByIndex(const Idx: Integer): RawByteString; virtual; abstract;
|
|
function GetKeyStrByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); virtual; abstract;
|
|
|
|
property KeysCaseSensitive: Boolean read GetKeysCaseSensitive;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ADictionaryU }
|
|
{ Base class for a dictionary with UnicodeString keys. }
|
|
{ }
|
|
type
|
|
ADictionaryU = class(ADictionaryBase)
|
|
protected
|
|
procedure RaiseKeyNotFoundError(const Key: UnicodeString);
|
|
procedure RaiseDuplicateKeyError(const Key: UnicodeString);
|
|
|
|
function GetKeysCaseSensitive: Boolean; virtual; abstract;
|
|
|
|
public
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); virtual; abstract;
|
|
function HasKey(const Key: UnicodeString): Boolean; virtual; abstract;
|
|
procedure Rename(const Key, NewKey: UnicodeString); virtual; abstract;
|
|
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; virtual; abstract;
|
|
function GetKeyStrByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); virtual; abstract;
|
|
|
|
property KeysCaseSensitive: Boolean read GetKeysCaseSensitive;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ADictionary }
|
|
{ Base class for a dictionary with String keys. }
|
|
{ }
|
|
type
|
|
ADictionary = class(ADictionaryBase)
|
|
protected
|
|
procedure RaiseKeyNotFoundError(const Key: String);
|
|
procedure RaiseDuplicateKeyError(const Key: String);
|
|
|
|
function GetKeysCaseSensitive: Boolean; virtual; abstract;
|
|
|
|
public
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); virtual; abstract;
|
|
function HasKey(const Key: String): Boolean; virtual; abstract;
|
|
procedure Rename(const Key, NewKey: String); virtual; abstract;
|
|
|
|
function GetKeyByIndex(const Idx: Integer): String; virtual; abstract;
|
|
function GetKeyStrByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); virtual; abstract;
|
|
|
|
property KeysCaseSensitive: Boolean read GetKeysCaseSensitive;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ALongIntDictionaryA }
|
|
{ A Dictionary with LongInt values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
ALongIntDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): LongInt; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: LongInt); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ALongIntDictionary }
|
|
property Item[const Key: AnsiString]: LongInt read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: LongInt); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): LongInt; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: LongInt): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: LongInt): Integer; virtual; abstract;
|
|
end;
|
|
ELongIntDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ALongIntDictionaryB }
|
|
{ A Dictionary with LongInt values and RawByteString keys. }
|
|
{ }
|
|
type
|
|
ALongIntDictionaryB = class(ADictionaryB)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: RawByteString): LongInt; virtual;
|
|
procedure SetItem(const Key: RawByteString; const Value: LongInt); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ALongIntDictionary }
|
|
property Item[const Key: RawByteString]: LongInt read GetItem write SetItem; default;
|
|
procedure Add(const Key: RawByteString; const Value: LongInt); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): LongInt; virtual; abstract;
|
|
function LocateItem(const Key: RawByteString; var Value: LongInt): Integer; virtual; abstract;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: LongInt): Integer; virtual; abstract;
|
|
end;
|
|
ELongIntDictionaryB = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ALongIntDictionaryU }
|
|
{ A Dictionary with LongInt values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
ALongIntDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): LongInt; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: LongInt); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ALongIntDictionary }
|
|
property Item[const Key: UnicodeString]: LongInt read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: LongInt); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): LongInt; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: LongInt): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: LongInt): Integer; virtual; abstract;
|
|
end;
|
|
ELongIntDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ALongIntDictionary }
|
|
{ A Dictionary with LongInt values and String keys. }
|
|
{ }
|
|
type
|
|
ALongIntDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): LongInt; virtual;
|
|
procedure SetItem(const Key: String; const Value: LongInt); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ALongIntDictionary }
|
|
property Item[const Key: String]: LongInt read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: LongInt); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): LongInt; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: LongInt): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: LongInt): Integer; virtual; abstract;
|
|
end;
|
|
ELongIntDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AIntegerDictionary }
|
|
{ }
|
|
type
|
|
{$IFDEF SupportAnsiString}
|
|
AIntegerDictionaryA = ALongIntDictionaryA;
|
|
{$ENDIF}
|
|
AIntegerDictionaryB = ALongIntDictionaryB;
|
|
AIntegerDictionaryU = ALongIntDictionaryU;
|
|
AIntegerDictionary = ALongIntDictionary;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ALongWordDictionaryA }
|
|
{ A Dictionary with LongWord values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
ALongWordDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): LongWord; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: LongWord); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ALongWordDictionary }
|
|
property Item[const Key: AnsiString]: LongWord read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: LongWord); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): LongWord; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: LongWord): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: LongWord): Integer; virtual; abstract;
|
|
end;
|
|
ELongWordDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ALongWordDictionaryB }
|
|
{ A Dictionary with LongWord values and RawByteString keys. }
|
|
{ }
|
|
type
|
|
ALongWordDictionaryB = class(ADictionaryB)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: RawByteString): LongWord; virtual;
|
|
procedure SetItem(const Key: RawByteString; const Value: LongWord); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ALongWordDictionary }
|
|
property Item[const Key: RawByteString]: LongWord read GetItem write SetItem; default;
|
|
procedure Add(const Key: RawByteString; const Value: LongWord); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): LongWord; virtual; abstract;
|
|
function LocateItem(const Key: RawByteString; var Value: LongWord): Integer; virtual; abstract;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: LongWord): Integer; virtual; abstract;
|
|
end;
|
|
ELongWordDictionaryB = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ALongWordDictionaryU }
|
|
{ A Dictionary with LongWord values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
ALongWordDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): LongWord; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: LongWord); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ALongWordDictionary }
|
|
property Item[const Key: UnicodeString]: LongWord read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: LongWord); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): LongWord; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: LongWord): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: LongWord): Integer; virtual; abstract;
|
|
end;
|
|
ELongWordDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ALongWordDictionary }
|
|
{ A Dictionary with LongWord values and String keys. }
|
|
{ }
|
|
type
|
|
ALongWordDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): LongWord; virtual;
|
|
procedure SetItem(const Key: String; const Value: LongWord); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ALongWordDictionary }
|
|
property Item[const Key: String]: LongWord read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: LongWord); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): LongWord; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: LongWord): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: LongWord): Integer; virtual; abstract;
|
|
end;
|
|
ELongWordDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ACardinalDictionary }
|
|
{ }
|
|
type
|
|
{$IFDEF SupportAnsiString}
|
|
ACardinalDictionaryA = ALongWordDictionaryA;
|
|
{$ENDIF}
|
|
ACardinalDictionaryB = ALongWordDictionaryB;
|
|
ACardinalDictionaryU = ALongWordDictionaryU;
|
|
ACardinalDictionary = ALongWordDictionary;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AInt64DictionaryA }
|
|
{ A Dictionary with Int64 values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
AInt64DictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): Int64; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: Int64); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AInt64Dictionary }
|
|
property Item[const Key: AnsiString]: Int64 read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: Int64); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Int64; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: Int64): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: Int64): Integer; virtual; abstract;
|
|
end;
|
|
EInt64DictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AInt64DictionaryB }
|
|
{ A Dictionary with Int64 values and RawByteString keys. }
|
|
{ }
|
|
type
|
|
AInt64DictionaryB = class(ADictionaryB)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: RawByteString): Int64; virtual;
|
|
procedure SetItem(const Key: RawByteString; const Value: Int64); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AInt64Dictionary }
|
|
property Item[const Key: RawByteString]: Int64 read GetItem write SetItem; default;
|
|
procedure Add(const Key: RawByteString; const Value: Int64); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Int64; virtual; abstract;
|
|
function LocateItem(const Key: RawByteString; var Value: Int64): Integer; virtual; abstract;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: Int64): Integer; virtual; abstract;
|
|
end;
|
|
EInt64DictionaryB = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AInt64DictionaryU }
|
|
{ A Dictionary with Int64 values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
AInt64DictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): Int64; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: Int64); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AInt64Dictionary }
|
|
property Item[const Key: UnicodeString]: Int64 read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: Int64); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Int64; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: Int64): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: Int64): Integer; virtual; abstract;
|
|
end;
|
|
EInt64DictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AInt64Dictionary }
|
|
{ A Dictionary with Int64 values and String keys. }
|
|
{ }
|
|
type
|
|
AInt64Dictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): Int64; virtual;
|
|
procedure SetItem(const Key: String; const Value: Int64); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AInt64Dictionary }
|
|
property Item[const Key: String]: Int64 read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: Int64); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Int64; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: Int64): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: Int64): Integer; virtual; abstract;
|
|
end;
|
|
EInt64Dictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ASingleDictionaryA }
|
|
{ A Dictionary with Single values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
ASingleDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): Single; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: Single); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ASingleDictionary }
|
|
property Item[const Key: AnsiString]: Single read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: Single); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Single; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: Single): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: Single): Integer; virtual; abstract;
|
|
end;
|
|
ESingleDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ASingleDictionaryB }
|
|
{ A Dictionary with Single values and RawByteString keys. }
|
|
{ }
|
|
type
|
|
ASingleDictionaryB = class(ADictionaryB)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: RawByteString): Single; virtual;
|
|
procedure SetItem(const Key: RawByteString; const Value: Single); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ASingleDictionary }
|
|
property Item[const Key: RawByteString]: Single read GetItem write SetItem; default;
|
|
procedure Add(const Key: RawByteString; const Value: Single); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Single; virtual; abstract;
|
|
function LocateItem(const Key: RawByteString; var Value: Single): Integer; virtual; abstract;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: Single): Integer; virtual; abstract;
|
|
end;
|
|
ESingleDictionaryB = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ASingleDictionaryU }
|
|
{ A Dictionary with Single values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
ASingleDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): Single; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: Single); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ASingleDictionary }
|
|
property Item[const Key: UnicodeString]: Single read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: Single); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Single; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: Single): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: Single): Integer; virtual; abstract;
|
|
end;
|
|
ESingleDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ASingleDictionary }
|
|
{ A Dictionary with Single values and String keys. }
|
|
{ }
|
|
type
|
|
ASingleDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): Single; virtual;
|
|
procedure SetItem(const Key: String; const Value: Single); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ASingleDictionary }
|
|
property Item[const Key: String]: Single read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: Single); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Single; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: Single): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: Single): Integer; virtual; abstract;
|
|
end;
|
|
ESingleDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ADoubleDictionaryA }
|
|
{ A Dictionary with Double values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
ADoubleDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): Double; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: Double); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ADoubleDictionary }
|
|
property Item[const Key: AnsiString]: Double read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: Double); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Double; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: Double): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: Double): Integer; virtual; abstract;
|
|
end;
|
|
EDoubleDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ADoubleDictionaryB }
|
|
{ A Dictionary with Double values and RawByteString keys. }
|
|
{ }
|
|
type
|
|
ADoubleDictionaryB = class(ADictionaryB)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: RawByteString): Double; virtual;
|
|
procedure SetItem(const Key: RawByteString; const Value: Double); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ADoubleDictionary }
|
|
property Item[const Key: RawByteString]: Double read GetItem write SetItem; default;
|
|
procedure Add(const Key: RawByteString; const Value: Double); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Double; virtual; abstract;
|
|
function LocateItem(const Key: RawByteString; var Value: Double): Integer; virtual; abstract;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: Double): Integer; virtual; abstract;
|
|
end;
|
|
EDoubleDictionaryB = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ADoubleDictionaryU }
|
|
{ A Dictionary with Double values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
ADoubleDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): Double; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: Double); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ADoubleDictionary }
|
|
property Item[const Key: UnicodeString]: Double read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: Double); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Double; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: Double): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: Double): Integer; virtual; abstract;
|
|
end;
|
|
EDoubleDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ADoubleDictionary }
|
|
{ A Dictionary with Double values and String keys. }
|
|
{ }
|
|
type
|
|
ADoubleDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): Double; virtual;
|
|
procedure SetItem(const Key: String; const Value: Double); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ADoubleDictionary }
|
|
property Item[const Key: String]: Double read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: Double); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Double; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: Double): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: Double): Integer; virtual; abstract;
|
|
end;
|
|
EDoubleDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AExtendedDictionaryA }
|
|
{ A Dictionary with Extended values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
AExtendedDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): Extended; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: Extended); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AExtendedDictionary }
|
|
property Item[const Key: AnsiString]: Extended read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: Extended); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Extended; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: Extended): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: Extended): Integer; virtual; abstract;
|
|
end;
|
|
EExtendedDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AExtendedDictionaryB }
|
|
{ A Dictionary with Extended values and RawByteString keys. }
|
|
{ }
|
|
type
|
|
AExtendedDictionaryB = class(ADictionaryB)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: RawByteString): Extended; virtual;
|
|
procedure SetItem(const Key: RawByteString; const Value: Extended); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AExtendedDictionary }
|
|
property Item[const Key: RawByteString]: Extended read GetItem write SetItem; default;
|
|
procedure Add(const Key: RawByteString; const Value: Extended); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Extended; virtual; abstract;
|
|
function LocateItem(const Key: RawByteString; var Value: Extended): Integer; virtual; abstract;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: Extended): Integer; virtual; abstract;
|
|
end;
|
|
EExtendedDictionaryB = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AExtendedDictionaryU }
|
|
{ A Dictionary with Extended values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
AExtendedDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): Extended; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: Extended); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AExtendedDictionary }
|
|
property Item[const Key: UnicodeString]: Extended read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: Extended); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Extended; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: Extended): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: Extended): Integer; virtual; abstract;
|
|
end;
|
|
EExtendedDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AExtendedDictionary }
|
|
{ A Dictionary with Extended values and String keys. }
|
|
{ }
|
|
type
|
|
AExtendedDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): Extended; virtual;
|
|
procedure SetItem(const Key: String; const Value: Extended); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AExtendedDictionary }
|
|
property Item[const Key: String]: Extended read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: Extended); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Extended; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: Extended): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: Extended): Integer; virtual; abstract;
|
|
end;
|
|
EExtendedDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AAnsiStringDictionaryA }
|
|
{ A Dictionary with AnsiString values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
AAnsiStringDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): AnsiString; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: AnsiString); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AAnsiStringDictionary }
|
|
property Item[const Key: AnsiString]: AnsiString read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: AnsiString); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): AnsiString; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: AnsiString): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: AnsiString): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: AnsiString): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
EAnsiStringDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AAnsiStringDictionaryU }
|
|
{ A Dictionary with AnsiString values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
AAnsiStringDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): AnsiString; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: AnsiString); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AAnsiStringDictionary }
|
|
property Item[const Key: UnicodeString]: AnsiString read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: AnsiString); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): AnsiString; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: AnsiString): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: AnsiString): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: UnicodeString): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
EAnsiStringDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AAnsiStringDictionary }
|
|
{ A Dictionary with AnsiString values and String keys. }
|
|
{ }
|
|
type
|
|
AAnsiStringDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): AnsiString; virtual;
|
|
procedure SetItem(const Key: String; const Value: AnsiString); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AAnsiStringDictionary }
|
|
property Item[const Key: String]: AnsiString read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: AnsiString); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): AnsiString; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: AnsiString): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: AnsiString): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: String): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
EAnsiStringDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ARawByteStringDictionaryA }
|
|
{ A Dictionary with RawByteString values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
ARawByteStringDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): RawByteString; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: RawByteString); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
property Item[const Key: AnsiString]: RawByteString read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: RawByteString); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): RawByteString; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: RawByteString): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: RawByteString): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: AnsiString): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
ERawByteStringDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ARawByteStringDictionaryB }
|
|
{ A Dictionary with RawByteString values and RawByteString keys. }
|
|
{ }
|
|
type
|
|
ARawByteStringDictionaryB = class(ADictionaryB)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: RawByteString): RawByteString; virtual;
|
|
procedure SetItem(const Key: RawByteString; const Value: RawByteString); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
property Item[const Key: RawByteString]: RawByteString read GetItem write SetItem; default;
|
|
procedure Add(const Key: RawByteString; const Value: RawByteString); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): RawByteString; virtual; abstract;
|
|
function LocateItem(const Key: RawByteString; var Value: RawByteString): Integer; virtual; abstract;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: RawByteString): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: RawByteString): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
ERawByteStringDictionaryB = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ARawByteStringDictionaryU }
|
|
{ A Dictionary with RawByteString values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
ARawByteStringDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): RawByteString; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: RawByteString); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
property Item[const Key: UnicodeString]: RawByteString read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: RawByteString); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): RawByteString; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: RawByteString): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: RawByteString): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: UnicodeString): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
ERawByteStringDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ ARawByteStringDictionary }
|
|
{ A Dictionary with RawByteString values and String keys. }
|
|
{ }
|
|
type
|
|
ARawByteStringDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): RawByteString; virtual;
|
|
procedure SetItem(const Key: String; const Value: RawByteString); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
property Item[const Key: String]: RawByteString read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: RawByteString); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): RawByteString; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: RawByteString): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: RawByteString): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: String): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
ERawByteStringDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AUnicodeStringDictionaryA }
|
|
{ A Dictionary with UnicodeString values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
AUnicodeStringDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): UnicodeString; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: UnicodeString); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AUnicodeStringDictionary }
|
|
property Item[const Key: AnsiString]: UnicodeString read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: UnicodeString); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): UnicodeString; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: UnicodeString): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: UnicodeString): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: AnsiString): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
EUnicodeStringDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AUnicodeStringDictionaryU }
|
|
{ A Dictionary with UnicodeString values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
AUnicodeStringDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): UnicodeString; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: UnicodeString); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AUnicodeStringDictionary }
|
|
property Item[const Key: UnicodeString]: UnicodeString read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: UnicodeString); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): UnicodeString; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: UnicodeString): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: UnicodeString): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: UnicodeString): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
EUnicodeStringDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AUnicodeStringDictionary }
|
|
{ A Dictionary with UnicodeString values and String keys. }
|
|
{ }
|
|
type
|
|
AUnicodeStringDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): UnicodeString; virtual;
|
|
procedure SetItem(const Key: String; const Value: UnicodeString); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AUnicodeStringDictionary }
|
|
property Item[const Key: String]: UnicodeString read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: UnicodeString); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): UnicodeString; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: UnicodeString): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: UnicodeString): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: String): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
EUnicodeStringDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AStringDictionaryA }
|
|
{ A Dictionary with String values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
AStringDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItem(const Key: AnsiString): String; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: String); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AStringDictionary }
|
|
property Item[const Key: AnsiString]: String read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: String); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): String; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: String): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: String): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: AnsiString): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
EStringDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AStringDictionaryU }
|
|
{ A Dictionary with String values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
AStringDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): String; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: String); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AStringDictionary }
|
|
property Item[const Key: UnicodeString]: String read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: String); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): String; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: String): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: String): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: UnicodeString): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
EStringDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AStringDictionary }
|
|
{ A Dictionary with String values and String keys. }
|
|
{ }
|
|
type
|
|
AStringDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItem(const Key: String): String; virtual;
|
|
procedure SetItem(const Key: String; const Value: String); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AStringDictionary }
|
|
property Item[const Key: String]: String read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: String); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): String; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: String): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: String): Integer; virtual; abstract;
|
|
|
|
function GetItemLength(const Key: String): Integer; virtual;
|
|
function GetTotalLength: Int64; virtual;
|
|
end;
|
|
EStringDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ APointerDictionaryA }
|
|
{ A Dictionary with Pointer values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
APointerDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): Pointer; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: Pointer); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ APointerDictionary }
|
|
property Item[const Key: AnsiString]: Pointer read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: Pointer); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Pointer; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: Pointer): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: Pointer): Integer; virtual; abstract;
|
|
end;
|
|
EPointerDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ APointerDictionaryB }
|
|
{ A Dictionary with Pointer values and RawByteString keys. }
|
|
{ }
|
|
type
|
|
APointerDictionaryB = class(ADictionaryB)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: RawByteString): Pointer; virtual;
|
|
procedure SetItem(const Key: RawByteString; const Value: Pointer); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ APointerDictionary }
|
|
property Item[const Key: RawByteString]: Pointer read GetItem write SetItem; default;
|
|
procedure Add(const Key: RawByteString; const Value: Pointer); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Pointer; virtual; abstract;
|
|
function LocateItem(const Key: RawByteString; var Value: Pointer): Integer; virtual; abstract;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: Pointer): Integer; virtual; abstract;
|
|
end;
|
|
EPointerDictionaryB = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ APointerDictionaryU }
|
|
{ A Dictionary with Pointer values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
APointerDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): Pointer; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: Pointer); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ APointerDictionary }
|
|
property Item[const Key: UnicodeString]: Pointer read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: Pointer); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Pointer; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: Pointer): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: Pointer): Integer; virtual; abstract;
|
|
end;
|
|
EPointerDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ APointerDictionary }
|
|
{ A Dictionary with Pointer values and String keys. }
|
|
{ }
|
|
type
|
|
APointerDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): Pointer; virtual;
|
|
procedure SetItem(const Key: String; const Value: Pointer); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ APointerDictionary }
|
|
property Item[const Key: String]: Pointer read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: Pointer); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): Pointer; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: Pointer): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: Pointer): Integer; virtual; abstract;
|
|
end;
|
|
EPointerDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AInterfaceDictionaryA }
|
|
{ A Dictionary with Interface values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
AInterfaceDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItem(const Key: AnsiString): IInterface; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: IInterface); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AInterfaceDictionary }
|
|
property Item[const Key: AnsiString]: IInterface read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: IInterface); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): IInterface; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: IInterface): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: IInterface): Integer; virtual; abstract;
|
|
end;
|
|
EInterfaceDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AInterfaceDictionaryU }
|
|
{ A Dictionary with Interface values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
AInterfaceDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): IInterface; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: IInterface); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AInterfaceDictionary }
|
|
property Item[const Key: UnicodeString]: IInterface read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: IInterface); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): IInterface; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: IInterface): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: IInterface): Integer; virtual; abstract;
|
|
end;
|
|
EInterfaceDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AInterfaceDictionary }
|
|
{ A Dictionary with Interface values and String keys. }
|
|
{ }
|
|
type
|
|
AInterfaceDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItem(const Key: String): IInterface; virtual;
|
|
procedure SetItem(const Key: String; const Value: IInterface); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
|
|
{ AInterfaceDictionary }
|
|
property Item[const Key: String]: IInterface read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: IInterface); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): IInterface; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: IInterface): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: IInterface): Integer; virtual; abstract;
|
|
end;
|
|
EInterfaceDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AObjectDictionaryA }
|
|
{ A Dictionary with Object values and AnsiString keys. }
|
|
{ }
|
|
type
|
|
AObjectDictionaryA = class(ADictionaryA)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: AnsiString): TObject; virtual;
|
|
procedure SetItem(const Key: AnsiString; const Value: TObject); virtual; abstract;
|
|
|
|
function GetIsItemOwner: Boolean; virtual; abstract;
|
|
procedure SetIsItemOwner(const AIsItemOwner: Boolean); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
procedure Clear; override;
|
|
|
|
{ AObjectDictionary }
|
|
property Item[const Key: AnsiString]: TObject read GetItem write SetItem; default;
|
|
procedure Add(const Key: AnsiString; const Value: TObject); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): TObject; virtual; abstract;
|
|
function LocateItem(const Key: AnsiString; var Value: TObject): Integer; virtual; abstract;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: TObject): Integer; virtual; abstract;
|
|
|
|
property IsItemOwner: Boolean read GetIsItemOwner write SetIsItemOwner;
|
|
function ReleaseItem(const Key: AnsiString): TObject; virtual; abstract;
|
|
procedure ReleaseItems; virtual; abstract;
|
|
procedure FreeItems; virtual; abstract;
|
|
end;
|
|
EObjectDictionaryA = class(EDictionary);
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AObjectDictionaryB }
|
|
{ A Dictionary with Object values and RawByteString keys. }
|
|
{ }
|
|
type
|
|
AObjectDictionaryB = class(ADictionaryB)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: RawByteString): TObject; virtual;
|
|
procedure SetItem(const Key: RawByteString; const Value: TObject); virtual; abstract;
|
|
|
|
function GetIsItemOwner: Boolean; virtual; abstract;
|
|
procedure SetIsItemOwner(const AIsItemOwner: Boolean); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
procedure Clear; override;
|
|
|
|
{ AObjectDictionary }
|
|
property Item[const Key: RawByteString]: TObject read GetItem write SetItem; default;
|
|
procedure Add(const Key: RawByteString; const Value: TObject); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): TObject; virtual; abstract;
|
|
function LocateItem(const Key: RawByteString; var Value: TObject): Integer; virtual; abstract;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: TObject): Integer; virtual; abstract;
|
|
|
|
property IsItemOwner: Boolean read GetIsItemOwner write SetIsItemOwner;
|
|
function ReleaseItem(const Key: RawByteString): TObject; virtual; abstract;
|
|
procedure ReleaseItems; virtual; abstract;
|
|
procedure FreeItems; virtual; abstract;
|
|
end;
|
|
EObjectDictionaryB = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AObjectDictionaryU }
|
|
{ A Dictionary with Object values and UnicodeString keys. }
|
|
{ }
|
|
type
|
|
AObjectDictionaryU = class(ADictionaryU)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: UnicodeString): TObject; virtual;
|
|
procedure SetItem(const Key: UnicodeString; const Value: TObject); virtual; abstract;
|
|
|
|
function GetIsItemOwner: Boolean; virtual; abstract;
|
|
procedure SetIsItemOwner(const AIsItemOwner: Boolean); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
procedure Clear; override;
|
|
|
|
{ AObjectDictionary }
|
|
property Item[const Key: UnicodeString]: TObject read GetItem write SetItem; default;
|
|
procedure Add(const Key: UnicodeString; const Value: TObject); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): TObject; virtual; abstract;
|
|
function LocateItem(const Key: UnicodeString; var Value: TObject): Integer; virtual; abstract;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: TObject): Integer; virtual; abstract;
|
|
|
|
property IsItemOwner: Boolean read GetIsItemOwner write SetIsItemOwner;
|
|
function ReleaseItem(const Key: UnicodeString): TObject; virtual; abstract;
|
|
procedure ReleaseItems; virtual; abstract;
|
|
procedure FreeItems; virtual; abstract;
|
|
end;
|
|
EObjectDictionaryU = class(EDictionary);
|
|
|
|
|
|
|
|
{ }
|
|
{ AObjectDictionary }
|
|
{ A Dictionary with Object values and String keys. }
|
|
{ }
|
|
type
|
|
AObjectDictionary = class(ADictionary)
|
|
protected
|
|
function GetAsString: String; override;
|
|
|
|
function GetItemStrByIndex(const Idx: Integer): String; override;
|
|
|
|
function GetItem(const Key: String): TObject; virtual;
|
|
procedure SetItem(const Key: String; const Value: TObject); virtual; abstract;
|
|
|
|
function GetIsItemOwner: Boolean; virtual; abstract;
|
|
procedure SetIsItemOwner(const AIsItemOwner: Boolean); virtual; abstract;
|
|
|
|
public
|
|
{ AType }
|
|
procedure Assign(const Source: TObject); override;
|
|
procedure Clear; override;
|
|
|
|
{ AObjectDictionary }
|
|
property Item[const Key: String]: TObject read GetItem write SetItem; default;
|
|
procedure Add(const Key: String; const Value: TObject); virtual; abstract;
|
|
|
|
function GetItemByIndex(const Idx: Integer): TObject; virtual; abstract;
|
|
function LocateItem(const Key: String; var Value: TObject): Integer; virtual; abstract;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: TObject): Integer; virtual; abstract;
|
|
|
|
property IsItemOwner: Boolean read GetIsItemOwner write SetIsItemOwner;
|
|
function ReleaseItem(const Key: String): TObject; virtual; abstract;
|
|
procedure ReleaseItems; virtual; abstract;
|
|
procedure FreeItems; virtual; abstract;
|
|
end;
|
|
EObjectDictionary = class(EDictionary);
|
|
|
|
|
|
|
|
|
|
|
|
|
|
{ }
|
|
{ DICTIONARY IMPLEMENTATIONS }
|
|
{ }
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TLongIntDictionary }
|
|
{ Implements ALongIntDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralLongIntDictionaryA = class(ALongIntDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TLongIntArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ALongIntDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: LongInt); override;
|
|
|
|
public
|
|
{ TGeneralLongIntDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TLongIntArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TLongIntArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ALongIntDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: LongInt); override;
|
|
function GetItemByIndex(const Idx: Integer): LongInt; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: LongInt);
|
|
function LocateItem(const Key: AnsiString; var Value: LongInt): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: LongInt): Integer; override;
|
|
end;
|
|
|
|
TLongIntDictionaryA = class(TGeneralLongIntDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): LongInt; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TLongIntArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: LongInt): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TLongIntDictionary }
|
|
{ Implements ALongIntDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralLongIntDictionaryB = class(ALongIntDictionaryB)
|
|
protected
|
|
FKeys : TRawByteStringArray;
|
|
FValues : TLongIntArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ALongIntDictionary }
|
|
procedure SetItem(const Key: RawByteString; const Value: LongInt); override;
|
|
|
|
public
|
|
{ TGeneralLongIntDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TLongIntArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TRawByteStringArray read FKeys;
|
|
property Values: TLongIntArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: RawByteString); override;
|
|
function HasKey(const Key: RawByteString): Boolean; override;
|
|
procedure Rename(const Key: RawByteString; const NewKey: RawByteString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ALongIntDictionary }
|
|
procedure Add(const Key: RawByteString; const Value: LongInt); override;
|
|
function GetItemByIndex(const Idx: Integer): LongInt; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: LongInt);
|
|
function LocateItem(const Key: RawByteString; var Value: LongInt): Integer; override;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: LongInt): Integer; override;
|
|
end;
|
|
|
|
TLongIntDictionaryB = class(TGeneralLongIntDictionaryB)
|
|
protected
|
|
function GetItem(const Key: RawByteString): LongInt; override;
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TLongIntArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: RawByteString; var Value: LongInt): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongIntDictionary }
|
|
{ Implements ALongIntDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralLongIntDictionaryU = class(ALongIntDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TLongIntArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ALongIntDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: LongInt); override;
|
|
|
|
public
|
|
{ TGeneralLongIntDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TLongIntArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TLongIntArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ALongIntDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: LongInt); override;
|
|
function GetItemByIndex(const Idx: Integer): LongInt; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: LongInt);
|
|
function LocateItem(const Key: UnicodeString; var Value: LongInt): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: LongInt): Integer; override;
|
|
end;
|
|
|
|
TLongIntDictionaryU = class(TGeneralLongIntDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): LongInt; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TLongIntArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: LongInt): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongIntDictionary }
|
|
{ Implements ALongIntDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralLongIntDictionary = class(ALongIntDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TLongIntArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ALongIntDictionary }
|
|
procedure SetItem(const Key: String; const Value: LongInt); override;
|
|
|
|
public
|
|
{ TGeneralLongIntDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TLongIntArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TLongIntArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ALongIntDictionary }
|
|
procedure Add(const Key: String; const Value: LongInt); override;
|
|
function GetItemByIndex(const Idx: Integer): LongInt; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: LongInt);
|
|
function LocateItem(const Key: String; var Value: LongInt): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: LongInt): Integer; override;
|
|
end;
|
|
|
|
TLongIntDictionary = class(TGeneralLongIntDictionary)
|
|
protected
|
|
function GetItem(const Key: String): LongInt; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TLongIntArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: LongInt): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TIntegerDictionary }
|
|
{ }
|
|
type
|
|
{$IFDEF SupportAnsiString}
|
|
TGeneralIntegerDictionaryA = TGeneralLongIntDictionaryA;
|
|
{$ENDIF}
|
|
TGeneralIntegerDictionary = TGeneralLongIntDictionary;
|
|
{$IFDEF SupportAnsiString}
|
|
TIntegerDictionaryA = TLongIntDictionaryA;
|
|
{$ENDIF}
|
|
TIntegerDictionary = TLongIntDictionary;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TLongWordDictionary }
|
|
{ Implements ALongWordDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralLongWordDictionaryA = class(ALongWordDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TLongWordArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ALongWordDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: LongWord); override;
|
|
|
|
public
|
|
{ TGeneralLongWordDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TLongWordArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TLongWordArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ALongWordDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: LongWord); override;
|
|
function GetItemByIndex(const Idx: Integer): LongWord; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: LongWord);
|
|
function LocateItem(const Key: AnsiString; var Value: LongWord): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: LongWord): Integer; override;
|
|
end;
|
|
|
|
TLongWordDictionaryA = class(TGeneralLongWordDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): LongWord; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TLongWordArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: LongWord): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TLongWordDictionary }
|
|
{ Implements ALongWordDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralLongWordDictionaryB = class(ALongWordDictionaryB)
|
|
protected
|
|
FKeys : TRawByteStringArray;
|
|
FValues : TLongWordArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ALongWordDictionary }
|
|
procedure SetItem(const Key: RawByteString; const Value: LongWord); override;
|
|
|
|
public
|
|
{ TGeneralLongWordDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TLongWordArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TRawByteStringArray read FKeys;
|
|
property Values: TLongWordArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: RawByteString); override;
|
|
function HasKey(const Key: RawByteString): Boolean; override;
|
|
procedure Rename(const Key: RawByteString; const NewKey: RawByteString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ALongWordDictionary }
|
|
procedure Add(const Key: RawByteString; const Value: LongWord); override;
|
|
function GetItemByIndex(const Idx: Integer): LongWord; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: LongWord);
|
|
function LocateItem(const Key: RawByteString; var Value: LongWord): Integer; override;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: LongWord): Integer; override;
|
|
end;
|
|
|
|
TLongWordDictionaryB = class(TGeneralLongWordDictionaryB)
|
|
protected
|
|
function GetItem(const Key: RawByteString): LongWord; override;
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TLongWordArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: RawByteString; var Value: LongWord): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongWordDictionary }
|
|
{ Implements ALongWordDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralLongWordDictionaryU = class(ALongWordDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TLongWordArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ALongWordDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: LongWord); override;
|
|
|
|
public
|
|
{ TGeneralLongWordDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TLongWordArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TLongWordArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ALongWordDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: LongWord); override;
|
|
function GetItemByIndex(const Idx: Integer): LongWord; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: LongWord);
|
|
function LocateItem(const Key: UnicodeString; var Value: LongWord): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: LongWord): Integer; override;
|
|
end;
|
|
|
|
TLongWordDictionaryU = class(TGeneralLongWordDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): LongWord; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TLongWordArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: LongWord): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongWordDictionary }
|
|
{ Implements ALongWordDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralLongWordDictionary = class(ALongWordDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TLongWordArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ALongWordDictionary }
|
|
procedure SetItem(const Key: String; const Value: LongWord); override;
|
|
|
|
public
|
|
{ TGeneralLongWordDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TLongWordArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TLongWordArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ALongWordDictionary }
|
|
procedure Add(const Key: String; const Value: LongWord); override;
|
|
function GetItemByIndex(const Idx: Integer): LongWord; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: LongWord);
|
|
function LocateItem(const Key: String; var Value: LongWord): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: LongWord): Integer; override;
|
|
end;
|
|
|
|
TLongWordDictionary = class(TGeneralLongWordDictionary)
|
|
protected
|
|
function GetItem(const Key: String): LongWord; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TLongWordArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: LongWord): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TCardinalDictionary }
|
|
{ }
|
|
type
|
|
{$IFDEF SupportAnsiString}
|
|
TGeneralCardinalDictionaryA = TGeneralLongWordDictionaryA;
|
|
{$ENDIF}
|
|
TGeneralCardinalDictionaryU = TGeneralLongWordDictionaryU;
|
|
TGeneralCardinalDictionary = TGeneralLongWordDictionary;
|
|
{$IFDEF SupportAnsiString}
|
|
TCardinalDictionaryA = TLongWordDictionaryA;
|
|
{$ENDIF}
|
|
TCardinalDictionaryU = TLongWordDictionaryU;
|
|
TCardinalDictionary = TLongWordDictionary;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TInt64Dictionary }
|
|
{ Implements AInt64Dictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralInt64DictionaryA = class(AInt64DictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TInt64Array;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AInt64Dictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: Int64); override;
|
|
|
|
public
|
|
{ TGeneralInt64Dictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TInt64Array = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TInt64Array read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AInt64Dictionary }
|
|
procedure Add(const Key: AnsiString; const Value: Int64); override;
|
|
function GetItemByIndex(const Idx: Integer): Int64; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Int64);
|
|
function LocateItem(const Key: AnsiString; var Value: Int64): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: Int64): Integer; override;
|
|
end;
|
|
|
|
TInt64DictionaryA = class(TGeneralInt64DictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): Int64; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TInt64Array = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: Int64): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TInt64Dictionary }
|
|
{ Implements AInt64Dictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralInt64DictionaryB = class(AInt64DictionaryB)
|
|
protected
|
|
FKeys : TRawByteStringArray;
|
|
FValues : TInt64Array;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AInt64Dictionary }
|
|
procedure SetItem(const Key: RawByteString; const Value: Int64); override;
|
|
|
|
public
|
|
{ TGeneralInt64Dictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TInt64Array = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TRawByteStringArray read FKeys;
|
|
property Values: TInt64Array read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: RawByteString); override;
|
|
function HasKey(const Key: RawByteString): Boolean; override;
|
|
procedure Rename(const Key: RawByteString; const NewKey: RawByteString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AInt64Dictionary }
|
|
procedure Add(const Key: RawByteString; const Value: Int64); override;
|
|
function GetItemByIndex(const Idx: Integer): Int64; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Int64);
|
|
function LocateItem(const Key: RawByteString; var Value: Int64): Integer; override;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: Int64): Integer; override;
|
|
end;
|
|
|
|
TInt64DictionaryB = class(TGeneralInt64DictionaryB)
|
|
protected
|
|
function GetItem(const Key: RawByteString): Int64; override;
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TInt64Array = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: RawByteString; var Value: Int64): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInt64Dictionary }
|
|
{ Implements AInt64Dictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralInt64DictionaryU = class(AInt64DictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TInt64Array;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AInt64Dictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: Int64); override;
|
|
|
|
public
|
|
{ TGeneralInt64Dictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TInt64Array = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TInt64Array read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AInt64Dictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: Int64); override;
|
|
function GetItemByIndex(const Idx: Integer): Int64; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Int64);
|
|
function LocateItem(const Key: UnicodeString; var Value: Int64): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: Int64): Integer; override;
|
|
end;
|
|
|
|
TInt64DictionaryU = class(TGeneralInt64DictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): Int64; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TInt64Array = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: Int64): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInt64Dictionary }
|
|
{ Implements AInt64Dictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralInt64Dictionary = class(AInt64Dictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TInt64Array;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AInt64Dictionary }
|
|
procedure SetItem(const Key: String; const Value: Int64); override;
|
|
|
|
public
|
|
{ TGeneralInt64Dictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TInt64Array = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TInt64Array read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AInt64Dictionary }
|
|
procedure Add(const Key: String; const Value: Int64); override;
|
|
function GetItemByIndex(const Idx: Integer): Int64; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Int64);
|
|
function LocateItem(const Key: String; var Value: Int64): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: Int64): Integer; override;
|
|
end;
|
|
|
|
TInt64Dictionary = class(TGeneralInt64Dictionary)
|
|
protected
|
|
function GetItem(const Key: String): Int64; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TInt64Array = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: Int64): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TSingleDictionary }
|
|
{ Implements ASingleDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralSingleDictionaryA = class(ASingleDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TSingleArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ASingleDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: Single); override;
|
|
|
|
public
|
|
{ TGeneralSingleDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TSingleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TSingleArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ASingleDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: Single); override;
|
|
function GetItemByIndex(const Idx: Integer): Single; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Single);
|
|
function LocateItem(const Key: AnsiString; var Value: Single): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: Single): Integer; override;
|
|
end;
|
|
|
|
TSingleDictionaryA = class(TGeneralSingleDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): Single; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TSingleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: Single): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TSingleDictionary }
|
|
{ Implements ASingleDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralSingleDictionaryB = class(ASingleDictionaryB)
|
|
protected
|
|
FKeys : TRawByteStringArray;
|
|
FValues : TSingleArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ASingleDictionary }
|
|
procedure SetItem(const Key: RawByteString; const Value: Single); override;
|
|
|
|
public
|
|
{ TGeneralSingleDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TSingleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TRawByteStringArray read FKeys;
|
|
property Values: TSingleArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: RawByteString); override;
|
|
function HasKey(const Key: RawByteString): Boolean; override;
|
|
procedure Rename(const Key: RawByteString; const NewKey: RawByteString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ASingleDictionary }
|
|
procedure Add(const Key: RawByteString; const Value: Single); override;
|
|
function GetItemByIndex(const Idx: Integer): Single; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Single);
|
|
function LocateItem(const Key: RawByteString; var Value: Single): Integer; override;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: Single): Integer; override;
|
|
end;
|
|
|
|
TSingleDictionaryB = class(TGeneralSingleDictionaryB)
|
|
protected
|
|
function GetItem(const Key: RawByteString): Single; override;
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TSingleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: RawByteString; var Value: Single): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TSingleDictionary }
|
|
{ Implements ASingleDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralSingleDictionaryU = class(ASingleDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TSingleArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ASingleDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: Single); override;
|
|
|
|
public
|
|
{ TGeneralSingleDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TSingleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TSingleArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ASingleDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: Single); override;
|
|
function GetItemByIndex(const Idx: Integer): Single; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Single);
|
|
function LocateItem(const Key: UnicodeString; var Value: Single): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: Single): Integer; override;
|
|
end;
|
|
|
|
TSingleDictionaryU = class(TGeneralSingleDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): Single; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TSingleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: Single): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TSingleDictionary }
|
|
{ Implements ASingleDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralSingleDictionary = class(ASingleDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TSingleArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ASingleDictionary }
|
|
procedure SetItem(const Key: String; const Value: Single); override;
|
|
|
|
public
|
|
{ TGeneralSingleDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TSingleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TSingleArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ASingleDictionary }
|
|
procedure Add(const Key: String; const Value: Single); override;
|
|
function GetItemByIndex(const Idx: Integer): Single; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Single);
|
|
function LocateItem(const Key: String; var Value: Single): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: Single): Integer; override;
|
|
end;
|
|
|
|
TSingleDictionary = class(TGeneralSingleDictionary)
|
|
protected
|
|
function GetItem(const Key: String): Single; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TSingleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: Single): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TDoubleDictionary }
|
|
{ Implements ADoubleDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralDoubleDictionaryA = class(ADoubleDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TDoubleArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ADoubleDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: Double); override;
|
|
|
|
public
|
|
{ TGeneralDoubleDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TDoubleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TDoubleArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ADoubleDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: Double); override;
|
|
function GetItemByIndex(const Idx: Integer): Double; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Double);
|
|
function LocateItem(const Key: AnsiString; var Value: Double): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: Double): Integer; override;
|
|
end;
|
|
|
|
TDoubleDictionaryA = class(TGeneralDoubleDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): Double; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TDoubleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: Double): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TDoubleDictionary }
|
|
{ Implements ADoubleDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralDoubleDictionaryB = class(ADoubleDictionaryB)
|
|
protected
|
|
FKeys : TRawByteStringArray;
|
|
FValues : TDoubleArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ADoubleDictionary }
|
|
procedure SetItem(const Key: RawByteString; const Value: Double); override;
|
|
|
|
public
|
|
{ TGeneralDoubleDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TDoubleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TRawByteStringArray read FKeys;
|
|
property Values: TDoubleArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: RawByteString); override;
|
|
function HasKey(const Key: RawByteString): Boolean; override;
|
|
procedure Rename(const Key: RawByteString; const NewKey: RawByteString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ADoubleDictionary }
|
|
procedure Add(const Key: RawByteString; const Value: Double); override;
|
|
function GetItemByIndex(const Idx: Integer): Double; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Double);
|
|
function LocateItem(const Key: RawByteString; var Value: Double): Integer; override;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: Double): Integer; override;
|
|
end;
|
|
|
|
TDoubleDictionaryB = class(TGeneralDoubleDictionaryB)
|
|
protected
|
|
function GetItem(const Key: RawByteString): Double; override;
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TDoubleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: RawByteString; var Value: Double): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoubleDictionary }
|
|
{ Implements ADoubleDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralDoubleDictionaryU = class(ADoubleDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TDoubleArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ADoubleDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: Double); override;
|
|
|
|
public
|
|
{ TGeneralDoubleDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TDoubleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TDoubleArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ADoubleDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: Double); override;
|
|
function GetItemByIndex(const Idx: Integer): Double; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Double);
|
|
function LocateItem(const Key: UnicodeString; var Value: Double): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: Double): Integer; override;
|
|
end;
|
|
|
|
TDoubleDictionaryU = class(TGeneralDoubleDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): Double; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TDoubleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: Double): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoubleDictionary }
|
|
{ Implements ADoubleDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralDoubleDictionary = class(ADoubleDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TDoubleArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ADoubleDictionary }
|
|
procedure SetItem(const Key: String; const Value: Double); override;
|
|
|
|
public
|
|
{ TGeneralDoubleDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TDoubleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TDoubleArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ADoubleDictionary }
|
|
procedure Add(const Key: String; const Value: Double); override;
|
|
function GetItemByIndex(const Idx: Integer): Double; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Double);
|
|
function LocateItem(const Key: String; var Value: Double): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: Double): Integer; override;
|
|
end;
|
|
|
|
TDoubleDictionary = class(TGeneralDoubleDictionary)
|
|
protected
|
|
function GetItem(const Key: String): Double; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TDoubleArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: Double): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TExtendedDictionary }
|
|
{ Implements AExtendedDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralExtendedDictionaryA = class(AExtendedDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TExtendedArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AExtendedDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: Extended); override;
|
|
|
|
public
|
|
{ TGeneralExtendedDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TExtendedArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TExtendedArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AExtendedDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: Extended); override;
|
|
function GetItemByIndex(const Idx: Integer): Extended; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Extended);
|
|
function LocateItem(const Key: AnsiString; var Value: Extended): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: Extended): Integer; override;
|
|
end;
|
|
|
|
TExtendedDictionaryA = class(TGeneralExtendedDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): Extended; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TExtendedArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: Extended): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TExtendedDictionary }
|
|
{ Implements AExtendedDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralExtendedDictionaryB = class(AExtendedDictionaryB)
|
|
protected
|
|
FKeys : TRawByteStringArray;
|
|
FValues : TExtendedArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AExtendedDictionary }
|
|
procedure SetItem(const Key: RawByteString; const Value: Extended); override;
|
|
|
|
public
|
|
{ TGeneralExtendedDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TExtendedArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TRawByteStringArray read FKeys;
|
|
property Values: TExtendedArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: RawByteString); override;
|
|
function HasKey(const Key: RawByteString): Boolean; override;
|
|
procedure Rename(const Key: RawByteString; const NewKey: RawByteString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AExtendedDictionary }
|
|
procedure Add(const Key: RawByteString; const Value: Extended); override;
|
|
function GetItemByIndex(const Idx: Integer): Extended; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Extended);
|
|
function LocateItem(const Key: RawByteString; var Value: Extended): Integer; override;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: Extended): Integer; override;
|
|
end;
|
|
|
|
TExtendedDictionaryB = class(TGeneralExtendedDictionaryB)
|
|
protected
|
|
function GetItem(const Key: RawByteString): Extended; override;
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TExtendedArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: RawByteString; var Value: Extended): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TExtendedDictionary }
|
|
{ Implements AExtendedDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralExtendedDictionaryU = class(AExtendedDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TExtendedArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AExtendedDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: Extended); override;
|
|
|
|
public
|
|
{ TGeneralExtendedDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TExtendedArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TExtendedArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AExtendedDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: Extended); override;
|
|
function GetItemByIndex(const Idx: Integer): Extended; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Extended);
|
|
function LocateItem(const Key: UnicodeString; var Value: Extended): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: Extended): Integer; override;
|
|
end;
|
|
|
|
TExtendedDictionaryU = class(TGeneralExtendedDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): Extended; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TExtendedArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: Extended): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TExtendedDictionary }
|
|
{ Implements AExtendedDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralExtendedDictionary = class(AExtendedDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TExtendedArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AExtendedDictionary }
|
|
procedure SetItem(const Key: String; const Value: Extended); override;
|
|
|
|
public
|
|
{ TGeneralExtendedDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TExtendedArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TExtendedArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AExtendedDictionary }
|
|
procedure Add(const Key: String; const Value: Extended); override;
|
|
function GetItemByIndex(const Idx: Integer): Extended; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Extended);
|
|
function LocateItem(const Key: String; var Value: Extended): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: Extended): Integer; override;
|
|
end;
|
|
|
|
TExtendedDictionary = class(TGeneralExtendedDictionary)
|
|
protected
|
|
function GetItem(const Key: String): Extended; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TExtendedArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: Extended): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TAnsiStringDictionary }
|
|
{ Implements AAnsiStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralAnsiStringDictionaryA = class(AAnsiStringDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TAnsiStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AAnsiStringDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: AnsiString); override;
|
|
|
|
public
|
|
{ TGeneralAnsiStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TAnsiStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TAnsiStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AAnsiStringDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: AnsiString); override;
|
|
function GetItemByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: AnsiString);
|
|
function LocateItem(const Key: AnsiString; var Value: AnsiString): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: AnsiString): Integer; override;
|
|
end;
|
|
|
|
TAnsiStringDictionaryA = class(TGeneralAnsiStringDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): AnsiString; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TAnsiStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: AnsiString): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TAnsiStringDictionary }
|
|
{ Implements AAnsiStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralAnsiStringDictionaryU = class(AAnsiStringDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TAnsiStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AAnsiStringDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: AnsiString); override;
|
|
|
|
public
|
|
{ TGeneralAnsiStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TAnsiStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TAnsiStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AAnsiStringDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: AnsiString); override;
|
|
function GetItemByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: AnsiString);
|
|
function LocateItem(const Key: UnicodeString; var Value: AnsiString): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: AnsiString): Integer; override;
|
|
end;
|
|
|
|
TAnsiStringDictionaryU = class(TGeneralAnsiStringDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): AnsiString; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TAnsiStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: AnsiString): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TAnsiStringDictionary }
|
|
{ Implements AAnsiStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralAnsiStringDictionary = class(AAnsiStringDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TAnsiStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AAnsiStringDictionary }
|
|
procedure SetItem(const Key: String; const Value: AnsiString); override;
|
|
|
|
public
|
|
{ TGeneralAnsiStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TAnsiStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TAnsiStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AAnsiStringDictionary }
|
|
procedure Add(const Key: String; const Value: AnsiString); override;
|
|
function GetItemByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: AnsiString);
|
|
function LocateItem(const Key: String; var Value: AnsiString): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: AnsiString): Integer; override;
|
|
end;
|
|
|
|
TAnsiStringDictionary = class(TGeneralAnsiStringDictionary)
|
|
protected
|
|
function GetItem(const Key: String): AnsiString; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TAnsiStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: AnsiString): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TRawByteStringDictionary }
|
|
{ Implements ARawByteStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralRawByteStringDictionaryA = class(ARawByteStringDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TRawByteStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: RawByteString); override;
|
|
|
|
public
|
|
{ TGeneralRawByteStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TRawByteStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TRawByteStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: RawByteString); override;
|
|
function GetItemByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: RawByteString);
|
|
function LocateItem(const Key: AnsiString; var Value: RawByteString): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: RawByteString): Integer; override;
|
|
end;
|
|
|
|
TRawByteStringDictionaryA = class(TGeneralRawByteStringDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): RawByteString; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TRawByteStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: RawByteString): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TRawByteStringDictionary }
|
|
{ Implements ARawByteStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralRawByteStringDictionaryB = class(ARawByteStringDictionaryB)
|
|
protected
|
|
FKeys : TRawByteStringArray;
|
|
FValues : TRawByteStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
procedure SetItem(const Key: RawByteString; const Value: RawByteString); override;
|
|
|
|
public
|
|
{ TGeneralRawByteStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TRawByteStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TRawByteStringArray read FKeys;
|
|
property Values: TRawByteStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: RawByteString); override;
|
|
function HasKey(const Key: RawByteString): Boolean; override;
|
|
procedure Rename(const Key: RawByteString; const NewKey: RawByteString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
procedure Add(const Key: RawByteString; const Value: RawByteString); override;
|
|
function GetItemByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: RawByteString);
|
|
function LocateItem(const Key: RawByteString; var Value: RawByteString): Integer; override;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: RawByteString): Integer; override;
|
|
end;
|
|
|
|
TRawByteStringDictionaryB = class(TGeneralRawByteStringDictionaryB)
|
|
protected
|
|
function GetItem(const Key: RawByteString): RawByteString; override;
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TRawByteStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: RawByteString; var Value: RawByteString): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TRawByteStringDictionary }
|
|
{ Implements ARawByteStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralRawByteStringDictionaryU = class(ARawByteStringDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TRawByteStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: RawByteString); override;
|
|
|
|
public
|
|
{ TGeneralRawByteStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TRawByteStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TRawByteStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: RawByteString); override;
|
|
function GetItemByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: RawByteString);
|
|
function LocateItem(const Key: UnicodeString; var Value: RawByteString): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: RawByteString): Integer; override;
|
|
end;
|
|
|
|
TRawByteStringDictionaryU = class(TGeneralRawByteStringDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): RawByteString; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TRawByteStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: RawByteString): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TRawByteStringDictionary }
|
|
{ Implements ARawByteStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralRawByteStringDictionary = class(ARawByteStringDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TRawByteStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
procedure SetItem(const Key: String; const Value: RawByteString); override;
|
|
|
|
public
|
|
{ TGeneralRawByteStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TRawByteStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TRawByteStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ ARawByteStringDictionary }
|
|
procedure Add(const Key: String; const Value: RawByteString); override;
|
|
function GetItemByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: RawByteString);
|
|
function LocateItem(const Key: String; var Value: RawByteString): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: RawByteString): Integer; override;
|
|
end;
|
|
|
|
TRawByteStringDictionary = class(TGeneralRawByteStringDictionary)
|
|
protected
|
|
function GetItem(const Key: String): RawByteString; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TRawByteStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: RawByteString): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TUnicodeStringDictionary }
|
|
{ Implements AUnicodeStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralUnicodeStringDictionaryA = class(AUnicodeStringDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TUnicodeStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AUnicodeStringDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: UnicodeString); override;
|
|
|
|
public
|
|
{ TGeneralUnicodeStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TUnicodeStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TUnicodeStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AUnicodeStringDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: UnicodeString); override;
|
|
function GetItemByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: UnicodeString);
|
|
function LocateItem(const Key: AnsiString; var Value: UnicodeString): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: UnicodeString): Integer; override;
|
|
end;
|
|
|
|
TUnicodeStringDictionaryA = class(TGeneralUnicodeStringDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): UnicodeString; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TUnicodeStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: UnicodeString): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TUnicodeStringDictionary }
|
|
{ Implements AUnicodeStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralUnicodeStringDictionaryU = class(AUnicodeStringDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TUnicodeStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AUnicodeStringDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: UnicodeString); override;
|
|
|
|
public
|
|
{ TGeneralUnicodeStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TUnicodeStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TUnicodeStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AUnicodeStringDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: UnicodeString); override;
|
|
function GetItemByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: UnicodeString);
|
|
function LocateItem(const Key: UnicodeString; var Value: UnicodeString): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: UnicodeString): Integer; override;
|
|
end;
|
|
|
|
TUnicodeStringDictionaryU = class(TGeneralUnicodeStringDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): UnicodeString; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TUnicodeStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: UnicodeString): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TUnicodeStringDictionary }
|
|
{ Implements AUnicodeStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralUnicodeStringDictionary = class(AUnicodeStringDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TUnicodeStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AUnicodeStringDictionary }
|
|
procedure SetItem(const Key: String; const Value: UnicodeString); override;
|
|
|
|
public
|
|
{ TGeneralUnicodeStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TUnicodeStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TUnicodeStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AUnicodeStringDictionary }
|
|
procedure Add(const Key: String; const Value: UnicodeString); override;
|
|
function GetItemByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: UnicodeString);
|
|
function LocateItem(const Key: String; var Value: UnicodeString): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: UnicodeString): Integer; override;
|
|
end;
|
|
|
|
TUnicodeStringDictionary = class(TGeneralUnicodeStringDictionary)
|
|
protected
|
|
function GetItem(const Key: String): UnicodeString; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TUnicodeStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: UnicodeString): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TStringDictionary }
|
|
{ Implements AStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralStringDictionaryA = class(AStringDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AStringDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: String); override;
|
|
|
|
public
|
|
{ TGeneralStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AStringDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: String); override;
|
|
function GetItemByIndex(const Idx: Integer): String; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: String);
|
|
function LocateItem(const Key: AnsiString; var Value: String): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: String): Integer; override;
|
|
end;
|
|
|
|
TStringDictionaryA = class(TGeneralStringDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): String; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: String): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TStringDictionary }
|
|
{ Implements AStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralStringDictionaryU = class(AStringDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AStringDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: String); override;
|
|
|
|
public
|
|
{ TGeneralStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AStringDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: String); override;
|
|
function GetItemByIndex(const Idx: Integer): String; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: String);
|
|
function LocateItem(const Key: UnicodeString; var Value: String): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: String): Integer; override;
|
|
end;
|
|
|
|
TStringDictionaryU = class(TGeneralStringDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): String; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: String): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TStringDictionary }
|
|
{ Implements AStringDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralStringDictionary = class(AStringDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TStringArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AStringDictionary }
|
|
procedure SetItem(const Key: String; const Value: String); override;
|
|
|
|
public
|
|
{ TGeneralStringDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TStringArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AStringDictionary }
|
|
procedure Add(const Key: String; const Value: String); override;
|
|
function GetItemByIndex(const Idx: Integer): String; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: String);
|
|
function LocateItem(const Key: String; var Value: String): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: String): Integer; override;
|
|
end;
|
|
|
|
TStringDictionary = class(TGeneralStringDictionary)
|
|
protected
|
|
function GetItem(const Key: String): String; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TStringArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: String): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TPointerDictionary }
|
|
{ Implements APointerDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralPointerDictionaryA = class(APointerDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TPointerArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ APointerDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: Pointer); override;
|
|
|
|
public
|
|
{ TGeneralPointerDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TPointerArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TPointerArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ APointerDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: Pointer); override;
|
|
function GetItemByIndex(const Idx: Integer): Pointer; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Pointer);
|
|
function LocateItem(const Key: AnsiString; var Value: Pointer): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: Pointer): Integer; override;
|
|
end;
|
|
|
|
TPointerDictionaryA = class(TGeneralPointerDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): Pointer; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TPointerArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: Pointer): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TPointerDictionary }
|
|
{ Implements APointerDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralPointerDictionaryB = class(APointerDictionaryB)
|
|
protected
|
|
FKeys : TRawByteStringArray;
|
|
FValues : TPointerArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ APointerDictionary }
|
|
procedure SetItem(const Key: RawByteString; const Value: Pointer); override;
|
|
|
|
public
|
|
{ TGeneralPointerDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TPointerArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TRawByteStringArray read FKeys;
|
|
property Values: TPointerArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: RawByteString); override;
|
|
function HasKey(const Key: RawByteString): Boolean; override;
|
|
procedure Rename(const Key: RawByteString; const NewKey: RawByteString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ APointerDictionary }
|
|
procedure Add(const Key: RawByteString; const Value: Pointer); override;
|
|
function GetItemByIndex(const Idx: Integer): Pointer; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Pointer);
|
|
function LocateItem(const Key: RawByteString; var Value: Pointer): Integer; override;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: Pointer): Integer; override;
|
|
end;
|
|
|
|
TPointerDictionaryB = class(TGeneralPointerDictionaryB)
|
|
protected
|
|
function GetItem(const Key: RawByteString): Pointer; override;
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TPointerArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: RawByteString; var Value: Pointer): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TPointerDictionary }
|
|
{ Implements APointerDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralPointerDictionaryU = class(APointerDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TPointerArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ APointerDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: Pointer); override;
|
|
|
|
public
|
|
{ TGeneralPointerDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TPointerArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TPointerArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ APointerDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: Pointer); override;
|
|
function GetItemByIndex(const Idx: Integer): Pointer; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Pointer);
|
|
function LocateItem(const Key: UnicodeString; var Value: Pointer): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: Pointer): Integer; override;
|
|
end;
|
|
|
|
TPointerDictionaryU = class(TGeneralPointerDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): Pointer; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TPointerArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: Pointer): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TPointerDictionary }
|
|
{ Implements APointerDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralPointerDictionary = class(APointerDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TPointerArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ APointerDictionary }
|
|
procedure SetItem(const Key: String; const Value: Pointer); override;
|
|
|
|
public
|
|
{ TGeneralPointerDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TPointerArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TPointerArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ APointerDictionary }
|
|
procedure Add(const Key: String; const Value: Pointer); override;
|
|
function GetItemByIndex(const Idx: Integer): Pointer; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: Pointer);
|
|
function LocateItem(const Key: String; var Value: Pointer): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: Pointer): Integer; override;
|
|
end;
|
|
|
|
TPointerDictionary = class(TGeneralPointerDictionary)
|
|
protected
|
|
function GetItem(const Key: String): Pointer; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TPointerArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: Pointer): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TInterfaceDictionary }
|
|
{ Implements AInterfaceDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralInterfaceDictionaryA = class(AInterfaceDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TInterfaceArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AInterfaceDictionary }
|
|
procedure SetItem(const Key: AnsiString; const Value: IInterface); override;
|
|
|
|
public
|
|
{ TGeneralInterfaceDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TInterfaceArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TInterfaceArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AInterfaceDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: IInterface); override;
|
|
function GetItemByIndex(const Idx: Integer): IInterface; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: IInterface);
|
|
function LocateItem(const Key: AnsiString; var Value: IInterface): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: IInterface): Integer; override;
|
|
end;
|
|
|
|
TInterfaceDictionaryA = class(TGeneralInterfaceDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): IInterface; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TInterfaceArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: IInterface): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TInterfaceDictionary }
|
|
{ Implements AInterfaceDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralInterfaceDictionaryU = class(AInterfaceDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TInterfaceArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AInterfaceDictionary }
|
|
procedure SetItem(const Key: UnicodeString; const Value: IInterface); override;
|
|
|
|
public
|
|
{ TGeneralInterfaceDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TInterfaceArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TInterfaceArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AInterfaceDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: IInterface); override;
|
|
function GetItemByIndex(const Idx: Integer): IInterface; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: IInterface);
|
|
function LocateItem(const Key: UnicodeString; var Value: IInterface): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: IInterface): Integer; override;
|
|
end;
|
|
|
|
TInterfaceDictionaryU = class(TGeneralInterfaceDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): IInterface; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TInterfaceArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: IInterface): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInterfaceDictionary }
|
|
{ Implements AInterfaceDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralInterfaceDictionary = class(AInterfaceDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TInterfaceArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AInterfaceDictionary }
|
|
procedure SetItem(const Key: String; const Value: IInterface); override;
|
|
|
|
public
|
|
{ TGeneralInterfaceDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TInterfaceArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TInterfaceArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AInterfaceDictionary }
|
|
procedure Add(const Key: String; const Value: IInterface); override;
|
|
function GetItemByIndex(const Idx: Integer): IInterface; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: IInterface);
|
|
function LocateItem(const Key: String; var Value: IInterface): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: IInterface): Integer; override;
|
|
end;
|
|
|
|
TInterfaceDictionary = class(TGeneralInterfaceDictionary)
|
|
protected
|
|
function GetItem(const Key: String): IInterface; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TInterfaceArray = nil;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: IInterface): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TObjectDictionary }
|
|
{ Implements AObjectDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralObjectDictionaryA = class(AObjectDictionaryA)
|
|
protected
|
|
FKeys : TAnsiStringArray;
|
|
FValues : TObjectArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AObjectDictionary }
|
|
function GetIsItemOwner: Boolean; override;
|
|
procedure SetIsItemOwner(const AIsItemOwner: Boolean); override;
|
|
|
|
procedure SetItem(const Key: AnsiString; const Value: TObject); override;
|
|
|
|
public
|
|
{ TGeneralObjectDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TObjectArray = nil;
|
|
const AIsItemOwner: Boolean = False;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TAnsiStringArray read FKeys;
|
|
property Values: TObjectArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: AnsiString); override;
|
|
function HasKey(const Key: AnsiString): Boolean; override;
|
|
procedure Rename(const Key: AnsiString; const NewKey: AnsiString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): AnsiString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AObjectDictionary }
|
|
procedure Add(const Key: AnsiString; const Value: TObject); override;
|
|
function GetItemByIndex(const Idx: Integer): TObject; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: TObject);
|
|
function LocateItem(const Key: AnsiString; var Value: TObject): Integer; override;
|
|
function LocateNext(const Key: AnsiString; const Idx: Integer;
|
|
var Value: TObject): Integer; override;
|
|
|
|
function ReleaseItem(const Key: AnsiString): TObject; override;
|
|
procedure ReleaseItems; override;
|
|
procedure FreeItems; override;
|
|
end;
|
|
|
|
TObjectDictionaryA = class(TGeneralObjectDictionaryA)
|
|
protected
|
|
function GetItem(const Key: AnsiString): TObject; override;
|
|
function LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TAnsiStringArray = nil;
|
|
const AValues: TObjectArray = nil;
|
|
const AIsItemOwner: Boolean = False;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: AnsiString; var Value: TObject): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TObjectDictionary }
|
|
{ Implements AObjectDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralObjectDictionaryB = class(AObjectDictionaryB)
|
|
protected
|
|
FKeys : TRawByteStringArray;
|
|
FValues : TObjectArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AObjectDictionary }
|
|
function GetIsItemOwner: Boolean; override;
|
|
procedure SetIsItemOwner(const AIsItemOwner: Boolean); override;
|
|
|
|
procedure SetItem(const Key: RawByteString; const Value: TObject); override;
|
|
|
|
public
|
|
{ TGeneralObjectDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TObjectArray = nil;
|
|
const AIsItemOwner: Boolean = False;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TRawByteStringArray read FKeys;
|
|
property Values: TObjectArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: RawByteString); override;
|
|
function HasKey(const Key: RawByteString): Boolean; override;
|
|
procedure Rename(const Key: RawByteString; const NewKey: RawByteString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): RawByteString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AObjectDictionary }
|
|
procedure Add(const Key: RawByteString; const Value: TObject); override;
|
|
function GetItemByIndex(const Idx: Integer): TObject; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: TObject);
|
|
function LocateItem(const Key: RawByteString; var Value: TObject): Integer; override;
|
|
function LocateNext(const Key: RawByteString; const Idx: Integer;
|
|
var Value: TObject): Integer; override;
|
|
|
|
function ReleaseItem(const Key: RawByteString): TObject; override;
|
|
procedure ReleaseItems; override;
|
|
procedure FreeItems; override;
|
|
end;
|
|
|
|
TObjectDictionaryB = class(TGeneralObjectDictionaryB)
|
|
protected
|
|
function GetItem(const Key: RawByteString): TObject; override;
|
|
function LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TRawByteStringArray = nil;
|
|
const AValues: TObjectArray = nil;
|
|
const AIsItemOwner: Boolean = False;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: RawByteString; var Value: TObject): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TObjectDictionary }
|
|
{ Implements AObjectDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralObjectDictionaryU = class(AObjectDictionaryU)
|
|
protected
|
|
FKeys : TUnicodeStringArray;
|
|
FValues : TObjectArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AObjectDictionary }
|
|
function GetIsItemOwner: Boolean; override;
|
|
procedure SetIsItemOwner(const AIsItemOwner: Boolean); override;
|
|
|
|
procedure SetItem(const Key: UnicodeString; const Value: TObject); override;
|
|
|
|
public
|
|
{ TGeneralObjectDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TObjectArray = nil;
|
|
const AIsItemOwner: Boolean = False;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TUnicodeStringArray read FKeys;
|
|
property Values: TObjectArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: UnicodeString); override;
|
|
function HasKey(const Key: UnicodeString): Boolean; override;
|
|
procedure Rename(const Key: UnicodeString; const NewKey: UnicodeString); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): UnicodeString; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AObjectDictionary }
|
|
procedure Add(const Key: UnicodeString; const Value: TObject); override;
|
|
function GetItemByIndex(const Idx: Integer): TObject; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: TObject);
|
|
function LocateItem(const Key: UnicodeString; var Value: TObject): Integer; override;
|
|
function LocateNext(const Key: UnicodeString; const Idx: Integer;
|
|
var Value: TObject): Integer; override;
|
|
|
|
function ReleaseItem(const Key: UnicodeString): TObject; override;
|
|
procedure ReleaseItems; override;
|
|
procedure FreeItems; override;
|
|
end;
|
|
|
|
TObjectDictionaryU = class(TGeneralObjectDictionaryU)
|
|
protected
|
|
function GetItem(const Key: UnicodeString): TObject; override;
|
|
function LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TUnicodeStringArray = nil;
|
|
const AValues: TObjectArray = nil;
|
|
const AIsItemOwner: Boolean = False;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: UnicodeString; var Value: TObject): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TObjectDictionary }
|
|
{ Implements AObjectDictionary using arrays. }
|
|
{ A 'chained-hash' lookup table is used for quick access. }
|
|
{ }
|
|
type
|
|
TGeneralObjectDictionary = class(AObjectDictionary)
|
|
protected
|
|
FKeys : TStringArray;
|
|
FValues : TObjectArray;
|
|
FLookup : Array of IntegerArray;
|
|
FHashSize : Integer;
|
|
FCaseSensitive : Boolean;
|
|
FAddOnSet : Boolean;
|
|
FDuplicatesAction : TDictionaryDuplicatesAction;
|
|
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; virtual;
|
|
procedure DeleteByIndex(const Idx: Integer; const Hash: Integer = -1);
|
|
procedure Rehash;
|
|
function GetHashTableSize: Integer;
|
|
procedure RaiseIndexError;
|
|
|
|
{ ADictionary }
|
|
function GetKeysCaseSensitive: Boolean; override;
|
|
function GetAddOnSet: Boolean; override;
|
|
procedure SetAddOnSet(const AAddOnSet: Boolean); override;
|
|
function GetDuplicatesAction: TDictionaryDuplicatesAction; override;
|
|
procedure SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction); override;
|
|
|
|
{ AObjectDictionary }
|
|
function GetIsItemOwner: Boolean; override;
|
|
procedure SetIsItemOwner(const AIsItemOwner: Boolean); override;
|
|
|
|
procedure SetItem(const Key: String; const Value: TObject); override;
|
|
|
|
public
|
|
{ TGeneralObjectDictionary }
|
|
constructor Create;
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TObjectArray = nil;
|
|
const AIsItemOwner: Boolean = False;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
destructor Destroy; override;
|
|
|
|
property Keys: TStringArray read FKeys;
|
|
property Values: TObjectArray read FValues;
|
|
property HashTableSize: Integer read GetHashTableSize;
|
|
|
|
{ AType }
|
|
procedure Clear; override;
|
|
|
|
{ ADictionary }
|
|
procedure Delete(const Key: String); override;
|
|
function HasKey(const Key: String): Boolean; override;
|
|
procedure Rename(const Key: String; const NewKey: String); override;
|
|
function Count: Integer; override;
|
|
function GetKeyByIndex(const Idx: Integer): String; override;
|
|
procedure DeleteItemByIndex(const Idx: Integer); override;
|
|
|
|
{ AObjectDictionary }
|
|
procedure Add(const Key: String; const Value: TObject); override;
|
|
function GetItemByIndex(const Idx: Integer): TObject; override;
|
|
procedure SetItemByIndex(const Idx: Integer; const Value: TObject);
|
|
function LocateItem(const Key: String; var Value: TObject): Integer; override;
|
|
function LocateNext(const Key: String; const Idx: Integer;
|
|
var Value: TObject): Integer; override;
|
|
|
|
function ReleaseItem(const Key: String): TObject; override;
|
|
procedure ReleaseItems; override;
|
|
procedure FreeItems; override;
|
|
end;
|
|
|
|
TObjectDictionary = class(TGeneralObjectDictionary)
|
|
protected
|
|
function GetItem(const Key: String): TObject; override;
|
|
function LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer; override;
|
|
|
|
public
|
|
constructor CreateEx(
|
|
const AKeys: TStringArray = nil;
|
|
const AValues: TObjectArray = nil;
|
|
const AIsItemOwner: Boolean = False;
|
|
const AKeysCaseSensitive: Boolean = True;
|
|
const AAddOnSet: Boolean = True;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction = ddAccept);
|
|
|
|
function LocateItem(const Key: String; var Value: TObject): Integer; override;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Dictionary functions }
|
|
{ }
|
|
const
|
|
DictionaryAverageHashChainSize = 4;
|
|
|
|
function DictionaryRehashSize(const Count: Integer): Integer;
|
|
|
|
|
|
|
|
{ }
|
|
{ SPARSE ARRAY BASE CLASSES }
|
|
{ }
|
|
|
|
|
|
|
|
{ }
|
|
{ ASparseArray }
|
|
{ Sparse array base class. }
|
|
{ }
|
|
type
|
|
ASparseArray = class(AType)
|
|
protected
|
|
procedure IndexError;
|
|
function GetCount: Integer; virtual; abstract;
|
|
|
|
public
|
|
property Count: Integer read GetCount;
|
|
function IsEmpty: Boolean; override;
|
|
procedure Delete(const Idx: Integer); virtual; abstract;
|
|
function HasItem(const Idx: Integer): Boolean; virtual; abstract;
|
|
end;
|
|
ESparseArray = class(EType);
|
|
|
|
|
|
|
|
{ }
|
|
{ SPARSE ARRAY IMPLEMENTATIONS }
|
|
{ }
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TSparseAnsiStringArray }
|
|
{ Sparse array that holds String values. }
|
|
{ }
|
|
type
|
|
TSparseAnsiStringRecord = record
|
|
Idx : Integer;
|
|
Value : AnsiString;
|
|
end;
|
|
PSparseAnsiStringRecord = ^TSparseAnsiStringRecord;
|
|
TSparseAnsiStringRecordArray = Array of TSparseAnsiStringRecord;
|
|
TSparseAnsiStringArrayHashList = Array of TSparseAnsiStringRecordArray;
|
|
|
|
TSparseAnsiStringArray = class(ASparseArray)
|
|
private
|
|
FHashList : TSparseAnsiStringArrayHashList;
|
|
FHashSize : Integer;
|
|
FCount : Integer;
|
|
|
|
protected
|
|
function LocateItemRecord(const Idx: Integer;
|
|
var LookupIdx, ChainIdx: Integer): PSparseAnsiStringRecord;
|
|
procedure Rehash;
|
|
|
|
function GetCount: Integer; override;
|
|
function GetItem(const Idx: Integer): AnsiString;
|
|
procedure SetItem(const Idx: Integer; const Value: AnsiString);
|
|
|
|
public
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
property Item[const Idx: Integer]: AnsiString read GetItem write SetItem; default;
|
|
function LocateItem(const Idx: Integer; var Value: AnsiString): Boolean;
|
|
|
|
property Count: Integer read FCount;
|
|
function IsEmpty: Boolean; override;
|
|
procedure Clear; override;
|
|
|
|
procedure Delete(const Idx: Integer); override;
|
|
|
|
function HasItem(const Idx: Integer): Boolean; override;
|
|
function FindFirst(var Idx: Integer; var Value: AnsiString): Boolean;
|
|
function FindNext(var Idx: Integer; var Value: AnsiString): Boolean;
|
|
end;
|
|
ESparseAnsiStringArray = class(ESparseArray);
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ TSparseInt64Array }
|
|
{ Sparse array that holds Int64 values. }
|
|
{ }
|
|
type
|
|
TSparseInt64Record = record
|
|
Idx : Integer;
|
|
Value : Int64;
|
|
end;
|
|
PSparseInt64Record = ^TSparseInt64Record;
|
|
TSparseInt64RecordArray = Array of TSparseInt64Record;
|
|
TSparseInt64ArrayHashList = Array of TSparseInt64RecordArray;
|
|
|
|
TSparseInt64Array = class(ASparseArray)
|
|
private
|
|
FHashList : TSparseInt64ArrayHashList;
|
|
FHashSize : Integer;
|
|
FCount : Integer;
|
|
|
|
protected
|
|
function LocateItemRecord(const Idx: Integer;
|
|
var LookupIdx, ChainIdx: Integer): PSparseInt64Record;
|
|
procedure Rehash;
|
|
|
|
function GetCount: Integer; override;
|
|
function GetItem(const Idx: Integer): Int64;
|
|
procedure SetItem(const Idx: Integer; const Value: Int64);
|
|
|
|
public
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
property Item[const Idx: Integer]: Int64 read GetItem write SetItem; default;
|
|
function LocateItem(const Idx: Integer; var Value: Int64): Boolean;
|
|
|
|
property Count: Integer read FCount;
|
|
function IsEmpty: Boolean; override;
|
|
procedure Clear; override;
|
|
|
|
procedure Delete(const Idx: Integer); override;
|
|
|
|
function HasItem(const Idx: Integer): Boolean; override;
|
|
function FindFirst(var Idx: Integer; var Value: Int64): Boolean;
|
|
function FindNext(var Idx: Integer; var Value: Int64): Boolean;
|
|
end;
|
|
ESparseInt64Array = class(ESparseArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ TSparseExtendedArray }
|
|
{ Sparse array that holds Extended values. }
|
|
{ }
|
|
type
|
|
TSparseExtendedRecord = record
|
|
Idx : Integer;
|
|
Value : Extended;
|
|
end;
|
|
PSparseExtendedRecord = ^TSparseExtendedRecord;
|
|
TSparseExtendedRecordArray = Array of TSparseExtendedRecord;
|
|
TSparseExtendedArrayHashList = Array of TSparseExtendedRecordArray;
|
|
|
|
TSparseExtendedArray = class(ASparseArray)
|
|
private
|
|
FHashList : TSparseExtendedArrayHashList;
|
|
FHashSize : Integer;
|
|
FCount : Integer;
|
|
|
|
protected
|
|
function LocateItemRecord(const Idx: Integer;
|
|
var LookupIdx, ChainIdx: Integer): PSparseExtendedRecord;
|
|
procedure Rehash;
|
|
|
|
function GetCount: Integer; override;
|
|
function GetItem(const Idx: Integer): Extended;
|
|
procedure SetItem(const Idx: Integer; const Value: Extended);
|
|
|
|
public
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
property Item[const Idx: Integer]: Extended read GetItem write SetItem; default;
|
|
function LocateItem(const Idx: Integer; var Value: Extended): Boolean;
|
|
|
|
property Count: Integer read FCount;
|
|
function IsEmpty: Boolean; override;
|
|
procedure Clear; override;
|
|
|
|
procedure Delete(const Idx: Integer); override;
|
|
|
|
function HasItem(const Idx: Integer): Boolean; override;
|
|
function FindFirst(var Idx: Integer; var Value: Extended): Boolean;
|
|
function FindNext(var Idx: Integer; var Value: Extended): Boolean;
|
|
end;
|
|
ESparseExtendedArray = class(ESparseArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ TSparseObjectArray }
|
|
{ Sparse array that holds TObject values. }
|
|
{ }
|
|
type
|
|
TSparseObjectRecord = record
|
|
Idx : Integer;
|
|
Value : TObject;
|
|
end;
|
|
PSparseObjectRecord = ^TSparseObjectRecord;
|
|
TSparseObjectRecordArray = Array of TSparseObjectRecord;
|
|
TSparseObjectArrayHashList = Array of TSparseObjectRecordArray;
|
|
|
|
TSparseObjectArray = class(ASparseArray)
|
|
private
|
|
FHashList : TSparseObjectArrayHashList;
|
|
FHashSize : Integer;
|
|
FCount : Integer;
|
|
FIsItemOwner : Boolean;
|
|
|
|
protected
|
|
procedure Init; override;
|
|
|
|
function LocateItemRecord(const Idx: Integer;
|
|
var LookupIdx, ChainIdx: Integer): PSparseObjectRecord;
|
|
procedure Rehash;
|
|
|
|
function GetCount: Integer; override;
|
|
function GetItem(const Idx: Integer): TObject;
|
|
procedure SetItem(const Idx: Integer; const Value: TObject);
|
|
|
|
public
|
|
constructor Create(const AIsItemOwner: Boolean = False);
|
|
destructor Destroy; override;
|
|
|
|
procedure Assign(const Source: TObject); override;
|
|
function IsEqual(const V: TObject): Boolean; override;
|
|
|
|
property IsItemOwner: Boolean read FIsItemOwner write FIsItemOwner;
|
|
property Item[const Idx: Integer]: TObject read GetItem write SetItem; default;
|
|
function LocateItem(const Idx: Integer; var Value: TObject): Boolean;
|
|
|
|
property Count: Integer read FCount;
|
|
function IsEmpty: Boolean; override;
|
|
procedure Clear; override;
|
|
|
|
procedure Delete(const Idx: Integer); override;
|
|
function ReleaseItem(const Idx: Integer): TObject;
|
|
|
|
function HasItem(const Idx: Integer): Boolean; override;
|
|
function FindFirst(var Idx: Integer; var Value: TObject): Boolean;
|
|
function FindNext(var Idx: Integer; var Value: TObject): Boolean;
|
|
end;
|
|
ESparseObjectArray = class(ESparseArray);
|
|
|
|
|
|
|
|
{ }
|
|
{ Linked lists }
|
|
{ }
|
|
type
|
|
TDoublyLinkedItem = class
|
|
protected
|
|
FNext : TDoublyLinkedItem;
|
|
FPrev : TDoublyLinkedItem;
|
|
|
|
public
|
|
destructor DestroyList;
|
|
|
|
property Next: TDoublyLinkedItem read FNext write FNext;
|
|
property Prev: TDoublyLinkedItem read FPrev write FPrev;
|
|
|
|
function HasNext: Boolean;
|
|
function HasPrev: Boolean;
|
|
function Last: TDoublyLinkedItem;
|
|
function First: TDoublyLinkedItem;
|
|
function Count: Integer;
|
|
|
|
procedure Remove;
|
|
function RemoveNext: TDoublyLinkedItem;
|
|
procedure DeleteNext;
|
|
function RemovePrev: TDoublyLinkedItem;
|
|
procedure DeletePrev;
|
|
procedure InsertAfter(const Item: TDoublyLinkedItem);
|
|
procedure InsertBefore(const Item: TDoublyLinkedItem);
|
|
procedure Delete;
|
|
end;
|
|
|
|
TDoublyLinkedInteger = class(TDoublyLinkedItem)
|
|
public
|
|
Value : Integer;
|
|
|
|
constructor Create(const V: Integer);
|
|
|
|
procedure InsertAfter(const V: Integer); overload;
|
|
procedure InsertBefore(const V: Integer); overload;
|
|
procedure InsertFirst(const V: Integer);
|
|
procedure Append(const V: Integer);
|
|
function FindNext(const Find: Integer): TDoublyLinkedInteger;
|
|
function FindPrev(const Find: Integer): TDoublyLinkedInteger;
|
|
end;
|
|
|
|
TDoublyLinkedExtended = class(TDoublyLinkedItem)
|
|
public
|
|
Value : Extended;
|
|
|
|
constructor Create(const V: Extended);
|
|
|
|
procedure InsertAfter(const V: Extended); overload;
|
|
procedure InsertBefore(const V: Extended); overload;
|
|
procedure InsertFirst(const V: Extended);
|
|
procedure Append(const V: Extended);
|
|
function FindNext(const Find: Extended): TDoublyLinkedExtended;
|
|
function FindPrev(const Find: Extended): TDoublyLinkedExtended;
|
|
end;
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
TDoublyLinkedString = class(TDoublyLinkedItem)
|
|
public
|
|
Value : AnsiString;
|
|
|
|
constructor Create(const V: AnsiString);
|
|
|
|
procedure InsertAfter(const V: AnsiString); overload;
|
|
procedure InsertBefore(const V: AnsiString); overload;
|
|
procedure InsertFirst(const V: AnsiString);
|
|
procedure Append(const V: AnsiString);
|
|
function FindNext(const Find: AnsiString): TDoublyLinkedString;
|
|
function FindPrev(const Find: AnsiString): TDoublyLinkedString;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
TDoublyLinkedObject = class(TDoublyLinkedItem)
|
|
public
|
|
Value : TObject;
|
|
|
|
constructor Create(const V: TObject);
|
|
|
|
procedure InsertAfter(const V: TObject); overload;
|
|
procedure InsertBefore(const V: TObject); overload;
|
|
procedure InsertFirst(const V: TObject);
|
|
procedure Append(const V: TObject);
|
|
function FindNext(const Find: TObject): TDoublyLinkedObject;
|
|
function FindPrev(const Find: TObject): TDoublyLinkedObject;
|
|
end;
|
|
|
|
|
|
function AsDoublyLinkedIntegerList(const V: Array of Integer): TDoublyLinkedInteger;
|
|
function AsDoublyLinkedExtendedList(const V: Array of Extended): TDoublyLinkedExtended;
|
|
{$IFDEF SupportAnsiString}
|
|
function AsDoublyLinkedStringList(const V: Array of AnsiString): TDoublyLinkedString;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoublyLinkedList }
|
|
{ }
|
|
type
|
|
TDoublyLinkedList = class
|
|
protected
|
|
FFirst : TDoublyLinkedItem;
|
|
FLast : TDoublyLinkedItem;
|
|
FCount : Integer;
|
|
|
|
public
|
|
destructor Destroy; override;
|
|
|
|
property First: TDoublyLinkedItem read FFirst;
|
|
property Last: TDoublyLinkedItem read FLast;
|
|
function IsEmpty: Boolean;
|
|
property Count: Integer read FCount;
|
|
|
|
procedure Remove(const Item: TDoublyLinkedItem);
|
|
function RemoveFirst: TDoublyLinkedItem;
|
|
function RemoveLast: TDoublyLinkedItem;
|
|
|
|
procedure Delete(const Item: TDoublyLinkedItem);
|
|
procedure DeleteFirst;
|
|
procedure DeleteLast;
|
|
procedure DeleteList;
|
|
|
|
procedure Append(const Item: TDoublyLinkedItem);
|
|
procedure InsertFront(const Item: TDoublyLinkedItem);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Self testing code }
|
|
{ }
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF TEST}
|
|
procedure Test;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{ Fundamentals }
|
|
flcDynArrays,
|
|
flcUTF,
|
|
flcStrings;
|
|
|
|
|
|
|
|
{ }
|
|
{ AType }
|
|
{ }
|
|
constructor AType.Create;
|
|
begin
|
|
inherited Create;
|
|
Init;
|
|
end;
|
|
|
|
procedure AType.Init;
|
|
begin
|
|
end;
|
|
|
|
procedure AType.RaiseTypeError(const Msg: String; const ErrorClass: ExceptClass);
|
|
begin
|
|
if Assigned(ErrorClass) then
|
|
raise ErrorClass.Create(Msg)
|
|
else
|
|
raise EType.Create(Msg);
|
|
end;
|
|
|
|
class function AType.CreateInstance: AType;
|
|
begin
|
|
Result := AType(TypeClass(self).Create);
|
|
end;
|
|
|
|
procedure AType.Clear;
|
|
begin
|
|
raise EType.CreateFmt('Method %s.Clear not implemented', [ClassName]);
|
|
end;
|
|
|
|
function AType.IsEmpty: Boolean;
|
|
begin
|
|
raise EType.CreateFmt('Method %s.IsEmpty not implemented', [ClassName]);
|
|
end;
|
|
|
|
function AType.Duplicate: TObject;
|
|
begin
|
|
try
|
|
Result := CreateInstance;
|
|
try
|
|
AType(Result).Assign(self);
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
except
|
|
on E : Exception do
|
|
raise EType.CreateFmt('%s cannot duplicate: %s', [ClassName, E.Message]);
|
|
end;
|
|
end;
|
|
|
|
procedure AType.Assign(const Source: TObject);
|
|
var R : Boolean;
|
|
begin
|
|
if Source is AType then
|
|
try
|
|
AType(Source).AssignTo(self);
|
|
R := True;
|
|
except
|
|
R := False;
|
|
end
|
|
else
|
|
R := False;
|
|
if not R then
|
|
raise EType.CreateFmt('%s cannot assign from %s', [ClassName, ObjectClassName(Source)]);
|
|
end;
|
|
|
|
procedure AType.AssignTo(const Dest: TObject);
|
|
begin
|
|
raise EType.CreateFmt('%s cannot assign to %s', [ClassName, ObjectClassName(Dest)]);
|
|
end;
|
|
|
|
function AType.IsEqual(const V: TObject): Boolean;
|
|
begin
|
|
raise EType.CreateFmt('%s cannot compare with %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
function AType.Compare(const V: TObject): TCompareResult;
|
|
begin
|
|
raise EType.CreateFmt('%s cannot compare with %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
function AType.HashValue: Word32;
|
|
begin
|
|
try
|
|
Result := HashStr(GetAsString, 1, -1, True);
|
|
except
|
|
on E : Exception do
|
|
raise EType.CreateFmt('Hash error: %s', [E.Message]);
|
|
end;
|
|
end;
|
|
|
|
function AType.GetAsString: String;
|
|
begin
|
|
raise EType.CreateFmt('Method %s.GetAsString not implemented', [ClassName]);
|
|
end;
|
|
|
|
function AType.GetAsUTF8String: RawByteString;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := StringToUTF8String(GetAsString);
|
|
{$ELSE}
|
|
Result := GetAsString;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function AType.GetAsUnicodeString: UnicodeString;
|
|
begin
|
|
{$IFDEF StringIsUnicode}
|
|
Result := GetAsString;
|
|
{$ELSE}
|
|
Result := UTF8Decode(GetAsString);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure AType.SetAsUTF8String(const S: RawByteString);
|
|
begin
|
|
raise EType.CreateFmt('Method %s.SetAsUTF8String not implemented', [ClassName]);
|
|
end;
|
|
|
|
procedure AType.SetAsUnicodeString(const S: UnicodeString);
|
|
begin
|
|
raise EType.CreateFmt('Method %s.SetAsUnicodeString not implemented', [ClassName]);
|
|
end;
|
|
|
|
procedure AType.SetAsString(const S: String);
|
|
begin
|
|
raise EType.CreateFmt('Method %s.SetAsString not implemented', [ClassName]);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AType helper functions }
|
|
{ }
|
|
function TypeGetAsString(const V: TObject): String;
|
|
begin
|
|
if V is AType then
|
|
Result := AType(V).GetAsString
|
|
else
|
|
raise EType.CreateFmt('%s cannot convert to string', [ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure TypeSetAsString(const V: TObject; const S: String);
|
|
begin
|
|
if V is AType then
|
|
AType(V).SetAsString(S)
|
|
else
|
|
raise EType.CreateFmt('%s cannot set as string', [ObjectClassName(V)]);
|
|
end;
|
|
|
|
function TypeGetAsUTF8String(const V: TObject): RawByteString;
|
|
begin
|
|
if V is AType then
|
|
Result := AType(V).GetAsUTF8String
|
|
else
|
|
raise EType.CreateFmt('%s cannot convert to utf-8 string', [ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure TypeSetAsUTF8String(const V: TObject; const S: RawByteString);
|
|
begin
|
|
if V is AType then
|
|
AType(V).SetAsUTF8String(S)
|
|
else
|
|
raise EType.CreateFmt('%s cannot set as utf-8 string', [ObjectClassName(V)]);
|
|
end;
|
|
|
|
function TypeGetAsUnicodeString(const V: TObject): UnicodeString;
|
|
begin
|
|
if V is AType then
|
|
Result := AType(V).GetAsUnicodeString
|
|
else
|
|
raise EType.CreateFmt('%s cannot convert to utf-16 string', [ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure TypeSetAsUnicodeString(const V: TObject; const S: UnicodeString);
|
|
begin
|
|
if V is AType then
|
|
AType(V).SetAsUnicodeString(S)
|
|
else
|
|
raise EType.CreateFmt('%s cannot set as utf-16 string', [ObjectClassName(V)]);
|
|
end;
|
|
|
|
function TypeDuplicate(const V: TObject): TObject;
|
|
begin
|
|
if V is AType then
|
|
Result := AType(V).Duplicate else
|
|
if not Assigned(V) then
|
|
Result := nil
|
|
else
|
|
raise EType.CreateFmt('%s cannot duplicate', [ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure TypeClear(const V: TObject);
|
|
begin
|
|
if V is AType then
|
|
AType(V).Clear else
|
|
if Assigned(V) then
|
|
raise EType.CreateFmt('%s cannot clear', [ObjectClassName(V)]);
|
|
end;
|
|
|
|
function TypeIsEqual(const A, B: TObject): Boolean;
|
|
begin
|
|
if A = B then
|
|
Result := True else
|
|
if not Assigned(A) or not Assigned(B) then
|
|
Result := False else
|
|
if A is AType then
|
|
Result := AType(A).IsEqual(B) else
|
|
if B is AType then
|
|
Result := AType(B).IsEqual(A)
|
|
else
|
|
raise EType.CreateFmt('%s and %s cannot compare',
|
|
[ObjectClassName(A), ObjectClassName(B)]);
|
|
end;
|
|
|
|
function TypeCompare(const A, B: TObject): TCompareResult;
|
|
begin
|
|
if A = B then
|
|
Result := crEqual else
|
|
if A is AType then
|
|
Result := AType(A).Compare(B) else
|
|
if B is AType then
|
|
Result := InverseCompareResult(AType(B).Compare(A))
|
|
else
|
|
Result := crUndefined;
|
|
end;
|
|
|
|
procedure TypeAssign(const A, B: TObject);
|
|
begin
|
|
if A = B then
|
|
exit else
|
|
if A is AType then
|
|
AType(A).Assign(B) else
|
|
if B is AType then
|
|
AType(B).AssignTo(A)
|
|
else
|
|
raise EType.CreateFmt('%s cannot assign %s',
|
|
[ObjectClassName(A), ObjectClassName(B)]);
|
|
end;
|
|
|
|
function TypeHashValue(const A: TObject): Word32;
|
|
begin
|
|
if not Assigned(A) then
|
|
Result := 0 else
|
|
if A is AType then
|
|
Result := AType(A).HashValue
|
|
else
|
|
raise EType.CreateFmt('%s cannot calculate hash value', [A.ClassName]);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ }
|
|
{ TYPE BASE CLASSES }
|
|
{ }
|
|
{ }
|
|
|
|
|
|
|
|
{ }
|
|
{ AArray }
|
|
{ }
|
|
procedure AArray.RaiseIndexError(const Idx: Integer);
|
|
begin
|
|
raise EArray.Create(
|
|
'Array index out of bounds'
|
|
{$IFDEF DEBUG} + ': ' + IntToStr(Idx) + '/' + IntToStr(GetCount){$ENDIF}
|
|
);
|
|
end;
|
|
|
|
function AArray.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
raise EArray.CreateFmt('%s.GetItemAsString not implemented', [ClassName]);
|
|
end;
|
|
|
|
procedure AArray.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
raise EArray.CreateFmt('%s.SetItemAsString not implemented', [ClassName]);
|
|
end;
|
|
|
|
procedure AArray.Clear;
|
|
begin
|
|
Count := 0;
|
|
end;
|
|
|
|
procedure AArray.Sort;
|
|
|
|
procedure QuickSort(L, R: Integer);
|
|
var I, J : Integer;
|
|
M : Integer;
|
|
begin
|
|
repeat
|
|
I := L;
|
|
J := R;
|
|
M := (L + R) shr 1;
|
|
repeat
|
|
while CompareItems(I, M) = crLess do
|
|
Inc(I);
|
|
while CompareItems(J, M) = crGreater do
|
|
Dec(J);
|
|
if I <= J then
|
|
begin
|
|
ExchangeItems(I, J);
|
|
if M = I then
|
|
M := J else
|
|
if M = J then
|
|
M := I;
|
|
Inc(I);
|
|
Dec(J);
|
|
end;
|
|
until I > J;
|
|
if L < J then
|
|
QuickSort(L, J);
|
|
L := I;
|
|
until I >= R;
|
|
end;
|
|
|
|
var I : Integer;
|
|
begin
|
|
I := Count;
|
|
if I > 0 then
|
|
QuickSort(0, I - 1);
|
|
end;
|
|
|
|
procedure AArray.ReverseOrder;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count;
|
|
for I := 1 to L div 2 do
|
|
ExchangeItems(I - 1, L - I);
|
|
end;
|
|
|
|
function AArray.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count;
|
|
if L = 0 then
|
|
begin
|
|
Result := '';
|
|
exit;
|
|
end;
|
|
Result := GetItemAsString(0);
|
|
for I := 1 to L - 1 do
|
|
Result := Result + ',' + GetItemAsString(I);
|
|
end;
|
|
|
|
procedure AArray.SetAsString(const S: String);
|
|
var F, G, L, C : Integer;
|
|
begin
|
|
L := Length(S);
|
|
if L = 0 then
|
|
begin
|
|
Count := 0;
|
|
exit;
|
|
end;
|
|
L := 0;
|
|
F := 1;
|
|
C := Length(S);
|
|
while F < C do
|
|
begin
|
|
G := 0;
|
|
while (F + G <= C) and (S[F + G] <> ',') do
|
|
Inc(G);
|
|
Inc(L);
|
|
Count := L;
|
|
SetItemAsString(L - 1, Copy(S, F, G));
|
|
Inc(F, G + 1);
|
|
end;
|
|
end;
|
|
|
|
procedure AArray.RemoveDuplicates(const IsSortedAscending: Boolean);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
L := GetCount;
|
|
if L = 0 then
|
|
exit;
|
|
if IsSortedAscending then
|
|
begin
|
|
J := 0;
|
|
repeat
|
|
I := J + 1;
|
|
while (I < L) and (CompareItems(I, J) = crEqual) do
|
|
Inc(I);
|
|
C := I - J;
|
|
if C > 1 then
|
|
begin
|
|
Delete(J + 1, C - 1);
|
|
Dec(L, C - 1);
|
|
Inc(J);
|
|
end
|
|
else
|
|
J := I;
|
|
until J >= L;
|
|
end else
|
|
begin
|
|
J := 0;
|
|
while J < L - 1 do
|
|
begin
|
|
I := J + 1;
|
|
while I <= L - 1 do
|
|
if CompareItems(J, I) = crEqual then
|
|
begin
|
|
Delete(I, 1);
|
|
Dec(L);
|
|
end else
|
|
Inc(I);
|
|
Inc(J);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AInt32Array }
|
|
{ }
|
|
procedure AInt32Array.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Int32;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function AInt32Array.AppendItem(const Value: Int32): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function AInt32Array.GetRange(const LoIdx, HiIdx: Integer): Int32Array;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function AInt32Array.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := AInt32Array(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
AInt32Array(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
AInt32Array(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure AInt32Array.SetRange(const LoIdx, HiIdx: Integer; const V: Int32Array);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure AInt32Array.Fill(const Idx, ACount: Integer; const Value: Int32);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function AInt32Array.AppendArray(const V: Int32Array): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function AInt32Array.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : Int32;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function AInt32Array.PosNext(const Find: Int32;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : Int32;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function AInt32Array.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItem(Idx));
|
|
end;
|
|
|
|
procedure AInt32Array.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, StrToInt(Value));
|
|
end;
|
|
|
|
procedure AInt32Array.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is AInt32Array then
|
|
begin
|
|
L := AInt32Array(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AInt32Array(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AInt32Array.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is AInt32Array then
|
|
begin
|
|
L := AInt32Array(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> AInt32Array(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function AInt32Array.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is AInt32Array then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := AInt32Array(V)[I];
|
|
end
|
|
else
|
|
raise EInt32Array.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure AInt32Array.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure AInt32Array.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ AInt64Array }
|
|
{ }
|
|
procedure AInt64Array.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Int64;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function AInt64Array.AppendItem(const Value: Int64): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function AInt64Array.GetRange(const LoIdx, HiIdx: Integer): Int64Array;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function AInt64Array.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := AInt64Array(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
AInt64Array(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
AInt64Array(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure AInt64Array.SetRange(const LoIdx, HiIdx: Integer; const V: Int64Array);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure AInt64Array.Fill(const Idx, ACount: Integer; const Value: Int64);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function AInt64Array.AppendArray(const V: Int64Array): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function AInt64Array.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : Int64;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function AInt64Array.PosNext(const Find: Int64;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : Int64;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function AInt64Array.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItem(Idx));
|
|
end;
|
|
|
|
procedure AInt64Array.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, StrToInt64(Value));
|
|
end;
|
|
|
|
procedure AInt64Array.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is AInt64Array then
|
|
begin
|
|
L := AInt64Array(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AInt64Array(Source).Item[I];
|
|
end else
|
|
if Source is ALongIntArray then
|
|
begin
|
|
L := ALongIntArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := ALongIntArray(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AInt64Array.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is AInt64Array then
|
|
begin
|
|
L := AInt64Array(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> AInt64Array(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function AInt64Array.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is AInt64Array then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := AInt64Array(V)[I];
|
|
end
|
|
else
|
|
raise EInt64Array.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure AInt64Array.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure AInt64Array.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ ALongIntArray }
|
|
{ }
|
|
procedure ALongIntArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : LongInt;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function ALongIntArray.AppendItem(const Value: LongInt): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function ALongIntArray.GetRange(const LoIdx, HiIdx: Integer): LongIntArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function ALongIntArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := ALongIntArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
ALongIntArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
ALongIntArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure ALongIntArray.SetRange(const LoIdx, HiIdx: Integer; const V: LongIntArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure ALongIntArray.Fill(const Idx, ACount: Integer; const Value: LongInt);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function ALongIntArray.AppendArray(const V: LongIntArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function ALongIntArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : LongInt;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function ALongIntArray.PosNext(const Find: LongInt;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : LongInt;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function ALongIntArray.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItem(Idx));
|
|
end;
|
|
|
|
procedure ALongIntArray.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, StrToInt(Value));
|
|
end;
|
|
|
|
procedure ALongIntArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is ALongIntArray then
|
|
begin
|
|
L := ALongIntArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := ALongIntArray(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ALongIntArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is ALongIntArray then
|
|
begin
|
|
L := ALongIntArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> ALongIntArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function ALongIntArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is ALongIntArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := ALongIntArray(V)[I];
|
|
end
|
|
else
|
|
raise ELongIntArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure ALongIntArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure ALongIntArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ AWord32Array }
|
|
{ }
|
|
procedure AWord32Array.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Word32;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function AWord32Array.AppendItem(const Value: Word32): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function AWord32Array.GetRange(const LoIdx, HiIdx: Integer): Word32Array;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function AWord32Array.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := AWord32Array(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
AWord32Array(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
AWord32Array(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure AWord32Array.SetRange(const LoIdx, HiIdx: Integer; const V: Word32Array);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure AWord32Array.Fill(const Idx, ACount: Integer; const Value: Word32);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function AWord32Array.AppendArray(const V: Word32Array): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function AWord32Array.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : Word32;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function AWord32Array.PosNext(const Find: Word32;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : Word32;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function AWord32Array.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItem(Idx));
|
|
end;
|
|
|
|
procedure AWord32Array.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, StrToInt64(Value));
|
|
end;
|
|
|
|
procedure AWord32Array.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is AWord32Array then
|
|
begin
|
|
L := AWord32Array(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AWord32Array(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AWord32Array.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is AWord32Array then
|
|
begin
|
|
L := AWord32Array(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> AWord32Array(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function AWord32Array.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is AWord32Array then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := AWord32Array(V)[I];
|
|
end
|
|
else
|
|
raise EWord32Array.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure AWord32Array.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure AWord32Array.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ AWord64Array }
|
|
{ }
|
|
procedure AWord64Array.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Word64;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function AWord64Array.AppendItem(const Value: Word64): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function AWord64Array.GetRange(const LoIdx, HiIdx: Integer): Word64Array;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function AWord64Array.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := AWord64Array(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
AWord64Array(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
AWord64Array(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure AWord64Array.SetRange(const LoIdx, HiIdx: Integer; const V: Word64Array);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure AWord64Array.Fill(const Idx, ACount: Integer; const Value: Word64);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function AWord64Array.AppendArray(const V: Word64Array): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function AWord64Array.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : Word64;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function AWord64Array.PosNext(const Find: Word64;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : Word64;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function AWord64Array.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := UIntToString(GetItem(Idx));
|
|
end;
|
|
|
|
procedure AWord64Array.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, StringToUInt64(Value));
|
|
end;
|
|
|
|
procedure AWord64Array.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is AWord64Array then
|
|
begin
|
|
L := AWord64Array(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AWord64Array(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AWord64Array.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is AWord64Array then
|
|
begin
|
|
L := AWord64Array(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> AWord64Array(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function AWord64Array.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is AWord64Array then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := AWord64Array(V)[I];
|
|
end
|
|
else
|
|
raise EWord64Array.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure AWord64Array.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure AWord64Array.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ ALongWordArray }
|
|
{ }
|
|
procedure ALongWordArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : LongWord;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function ALongWordArray.AppendItem(const Value: LongWord): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function ALongWordArray.GetRange(const LoIdx, HiIdx: Integer): LongWordArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function ALongWordArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := ALongWordArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
ALongWordArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
ALongWordArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure ALongWordArray.SetRange(const LoIdx, HiIdx: Integer; const V: LongWordArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure ALongWordArray.Fill(const Idx, ACount: Integer; const Value: LongWord);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function ALongWordArray.AppendArray(const V: LongWordArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function ALongWordArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : LongWord;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function ALongWordArray.PosNext(const Find: LongWord;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : LongWord;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function ALongWordArray.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItem(Idx));
|
|
end;
|
|
|
|
procedure ALongWordArray.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, StrToInt64(Value));
|
|
end;
|
|
|
|
procedure ALongWordArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is ALongWordArray then
|
|
begin
|
|
L := ALongWordArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := ALongWordArray(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ALongWordArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is ALongWordArray then
|
|
begin
|
|
L := ALongWordArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> ALongWordArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function ALongWordArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is ALongWordArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := ALongWordArray(V)[I];
|
|
end
|
|
else
|
|
raise ELongWordArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure ALongWordArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure ALongWordArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ ASingleArray }
|
|
{ }
|
|
procedure ASingleArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Single;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function ASingleArray.AppendItem(const Value: Single): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function ASingleArray.GetRange(const LoIdx, HiIdx: Integer): SingleArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function ASingleArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := ASingleArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
ASingleArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
ASingleArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure ASingleArray.SetRange(const LoIdx, HiIdx: Integer; const V: SingleArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure ASingleArray.Fill(const Idx, ACount: Integer; const Value: Single);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function ASingleArray.AppendArray(const V: SingleArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function ASingleArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : Single;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function ASingleArray.PosNext(const Find: Single;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : Single;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function ASingleArray.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItem(Idx));
|
|
end;
|
|
|
|
procedure ASingleArray.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, StrToFloat(Value));
|
|
end;
|
|
|
|
procedure ASingleArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is ASingleArray then
|
|
begin
|
|
L := ASingleArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := ASingleArray(Source).Item[I];
|
|
end else
|
|
if Source is AInt64Array then
|
|
begin
|
|
L := AInt64Array(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AInt64Array(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ASingleArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is ASingleArray then
|
|
begin
|
|
L := ASingleArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> ASingleArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function ASingleArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is ASingleArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := ASingleArray(V)[I];
|
|
end
|
|
else
|
|
raise ESingleArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure ASingleArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure ASingleArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ ADoubleArray }
|
|
{ }
|
|
procedure ADoubleArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Double;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function ADoubleArray.AppendItem(const Value: Double): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function ADoubleArray.GetRange(const LoIdx, HiIdx: Integer): DoubleArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function ADoubleArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := ADoubleArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
ADoubleArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
ADoubleArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure ADoubleArray.SetRange(const LoIdx, HiIdx: Integer; const V: DoubleArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure ADoubleArray.Fill(const Idx, ACount: Integer; const Value: Double);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function ADoubleArray.AppendArray(const V: DoubleArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function ADoubleArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : Double;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function ADoubleArray.PosNext(const Find: Double;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : Double;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function ADoubleArray.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItem(Idx));
|
|
end;
|
|
|
|
procedure ADoubleArray.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, StrToFloat(Value));
|
|
end;
|
|
|
|
procedure ADoubleArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is ADoubleArray then
|
|
begin
|
|
L := ADoubleArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := ADoubleArray(Source).Item[I];
|
|
end else
|
|
if Source is AInt64Array then
|
|
begin
|
|
L := AInt64Array(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AInt64Array(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ADoubleArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is ADoubleArray then
|
|
begin
|
|
L := ADoubleArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> ADoubleArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function ADoubleArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is ADoubleArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := ADoubleArray(V)[I];
|
|
end
|
|
else
|
|
raise EDoubleArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure ADoubleArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure ADoubleArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ AExtendedArray }
|
|
{ }
|
|
procedure AExtendedArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Extended;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function AExtendedArray.AppendItem(const Value: Extended): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function AExtendedArray.GetRange(const LoIdx, HiIdx: Integer): ExtendedArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function AExtendedArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := AExtendedArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
AExtendedArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
AExtendedArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure AExtendedArray.SetRange(const LoIdx, HiIdx: Integer; const V: ExtendedArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure AExtendedArray.Fill(const Idx, ACount: Integer; const Value: Extended);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function AExtendedArray.AppendArray(const V: ExtendedArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function AExtendedArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : Extended;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function AExtendedArray.PosNext(const Find: Extended;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : Extended;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function AExtendedArray.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItem(Idx));
|
|
end;
|
|
|
|
procedure AExtendedArray.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, StrToFloat(Value));
|
|
end;
|
|
|
|
procedure AExtendedArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is AExtendedArray then
|
|
begin
|
|
L := AExtendedArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AExtendedArray(Source).Item[I];
|
|
end else
|
|
if Source is AInt64Array then
|
|
begin
|
|
L := AInt64Array(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AInt64Array(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AExtendedArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is AExtendedArray then
|
|
begin
|
|
L := AExtendedArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> AExtendedArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function AExtendedArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is AExtendedArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := AExtendedArray(V)[I];
|
|
end
|
|
else
|
|
raise EExtendedArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure AExtendedArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure AExtendedArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
|
|
{ }
|
|
{ AAnsiStringArray }
|
|
{ }
|
|
procedure AAnsiStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : AnsiString;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function AAnsiStringArray.AppendItem(const Value: AnsiString): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function AAnsiStringArray.GetRange(const LoIdx, HiIdx: Integer): AnsiStringArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function AAnsiStringArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := AAnsiStringArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
AAnsiStringArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
AAnsiStringArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure AAnsiStringArray.SetRange(const LoIdx, HiIdx: Integer; const V: AnsiStringArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure AAnsiStringArray.Fill(const Idx, ACount: Integer; const Value: AnsiString);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function AAnsiStringArray.AppendArray(const V: AnsiStringArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function AAnsiStringArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : AnsiString;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function AAnsiStringArray.PosNext(const Find: AnsiString;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : AnsiString;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function AAnsiStringArray.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringA(GetItem(Idx));
|
|
end;
|
|
|
|
procedure AAnsiStringArray.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, ToAnsiString(Value));
|
|
end;
|
|
|
|
procedure AAnsiStringArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is AAnsiStringArray then
|
|
begin
|
|
L := AAnsiStringArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AAnsiStringArray(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AAnsiStringArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is AAnsiStringArray then
|
|
begin
|
|
L := AAnsiStringArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> AAnsiStringArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function AAnsiStringArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is AAnsiStringArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := AAnsiStringArray(V)[I];
|
|
end
|
|
else
|
|
raise EAnsiStringArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure AAnsiStringArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure AAnsiStringArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
{ }
|
|
{ ARawByteStringArray }
|
|
{ }
|
|
procedure ARawByteStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : RawByteString;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function ARawByteStringArray.AppendItem(const Value: RawByteString): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function ARawByteStringArray.GetRange(const LoIdx, HiIdx: Integer): RawByteStringArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function ARawByteStringArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := ARawByteStringArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
ARawByteStringArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
ARawByteStringArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure ARawByteStringArray.SetRange(const LoIdx, HiIdx: Integer; const V: RawByteStringArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure ARawByteStringArray.Fill(const Idx, ACount: Integer; const Value: RawByteString);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function ARawByteStringArray.AppendArray(const V: RawByteStringArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function ARawByteStringArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : RawByteString;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function ARawByteStringArray.PosNext(const Find: RawByteString;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : RawByteString;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function ARawByteStringArray.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringB(GetItem(Idx));
|
|
end;
|
|
|
|
procedure ARawByteStringArray.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, ToRawByteString(Value));
|
|
end;
|
|
|
|
procedure ARawByteStringArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is ARawByteStringArray then
|
|
begin
|
|
L := ARawByteStringArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := ARawByteStringArray(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ARawByteStringArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is ARawByteStringArray then
|
|
begin
|
|
L := ARawByteStringArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> ARawByteStringArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function ARawByteStringArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is ARawByteStringArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := ARawByteStringArray(V)[I];
|
|
end
|
|
else
|
|
raise ERawByteStringArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure ARawByteStringArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure ARawByteStringArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ AUnicodeStringArray }
|
|
{ }
|
|
procedure AUnicodeStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : UnicodeString;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function AUnicodeStringArray.AppendItem(const Value: UnicodeString): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function AUnicodeStringArray.GetRange(const LoIdx, HiIdx: Integer): UnicodeStringArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function AUnicodeStringArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := AUnicodeStringArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
AUnicodeStringArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
AUnicodeStringArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure AUnicodeStringArray.SetRange(const LoIdx, HiIdx: Integer; const V: UnicodeStringArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure AUnicodeStringArray.Fill(const Idx, ACount: Integer; const Value: UnicodeString);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function AUnicodeStringArray.AppendArray(const V: UnicodeStringArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function AUnicodeStringArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : UnicodeString;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function AUnicodeStringArray.PosNext(const Find: UnicodeString;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : UnicodeString;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function AUnicodeStringArray.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringU(GetItem(Idx));
|
|
end;
|
|
|
|
procedure AUnicodeStringArray.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, ToUnicodeString(Value));
|
|
end;
|
|
|
|
procedure AUnicodeStringArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is AUnicodeStringArray then
|
|
begin
|
|
L := AUnicodeStringArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AUnicodeStringArray(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AUnicodeStringArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is AUnicodeStringArray then
|
|
begin
|
|
L := AUnicodeStringArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> AUnicodeStringArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function AUnicodeStringArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is AUnicodeStringArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := AUnicodeStringArray(V)[I];
|
|
end
|
|
else
|
|
raise EUnicodeStringArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure AUnicodeStringArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure AUnicodeStringArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ AStringArray }
|
|
{ }
|
|
procedure AStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : String;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function AStringArray.AppendItem(const Value: String): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function AStringArray.GetRange(const LoIdx, HiIdx: Integer): StringArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function AStringArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := AStringArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
AStringArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
AStringArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure AStringArray.SetRange(const LoIdx, HiIdx: Integer; const V: StringArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure AStringArray.Fill(const Idx, ACount: Integer; const Value: String);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function AStringArray.AppendArray(const V: StringArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function AStringArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : String;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if I < J then
|
|
Result := crLess else
|
|
if I > J then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function AStringArray.PosNext(const Find: String;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : String;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if D > Find then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure AStringArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is AStringArray then
|
|
begin
|
|
L := AStringArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AStringArray(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AStringArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is AStringArray then
|
|
begin
|
|
L := AStringArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> AStringArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function AStringArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is AStringArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := AStringArray(V)[I];
|
|
end
|
|
else
|
|
raise EStringArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure AStringArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure AStringArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ APointerArray }
|
|
{ }
|
|
procedure APointerArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Pointer;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function APointerArray.AppendItem(const Value: Pointer): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function APointerArray.GetRange(const LoIdx, HiIdx: Integer): PointerArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function APointerArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := APointerArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
APointerArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
APointerArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure APointerArray.SetRange(const LoIdx, HiIdx: Integer; const V: PointerArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure APointerArray.Fill(const Idx, ACount: Integer; const Value: Pointer);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function APointerArray.AppendArray(const V: PointerArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function APointerArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : Pointer;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if NativeInt(I) < NativeInt(J) then
|
|
Result := crLess else
|
|
if NativeInt(I) > NativeInt(J) then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function APointerArray.PosNext(const Find: Pointer;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : Pointer;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if NativeInt(D) > NativeInt(Find) then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function APointerArray.GetItemAsString(const Idx: Integer): String;
|
|
begin
|
|
Result := PointerToStr(GetItem(Idx));
|
|
end;
|
|
|
|
procedure APointerArray.SetItemAsString(const Idx: Integer; const Value: String);
|
|
begin
|
|
SetItem(Idx, StrToPointer(Value));
|
|
end;
|
|
|
|
procedure APointerArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is APointerArray then
|
|
begin
|
|
L := APointerArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := APointerArray(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function APointerArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is APointerArray then
|
|
begin
|
|
L := APointerArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> APointerArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function APointerArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is APointerArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := APointerArray(V)[I];
|
|
end
|
|
else
|
|
raise EPointerArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure APointerArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure APointerArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ AInterfaceArray }
|
|
{ }
|
|
procedure AInterfaceArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : IInterface;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function AInterfaceArray.AppendItem(const Value: IInterface): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function AInterfaceArray.GetRange(const LoIdx, HiIdx: Integer): InterfaceArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[I] := Item[L + I];
|
|
end;
|
|
|
|
function AInterfaceArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
Result := AInterfaceArray(CreateInstance);
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
AInterfaceArray(Result).Count := C;
|
|
for I := 0 to C - 1 do
|
|
AInterfaceArray(Result)[I] := Item[L + I];
|
|
end;
|
|
|
|
procedure AInterfaceArray.SetRange(const LoIdx, HiIdx: Integer; const V: InterfaceArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
procedure AInterfaceArray.Fill(const Idx, ACount: Integer; const Value: IInterface);
|
|
var I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Item[I] := Value;
|
|
end;
|
|
|
|
function AInterfaceArray.AppendArray(const V: InterfaceArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
function AInterfaceArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var I, J : IInterface;
|
|
begin
|
|
I := Item[Idx1];
|
|
J := Item[Idx2];
|
|
if NativeInt(I) < NativeInt(J) then
|
|
Result := crLess else
|
|
if NativeInt(I) > NativeInt(J) then
|
|
Result := crGreater else
|
|
Result := crEqual;
|
|
end;
|
|
|
|
function AInterfaceArray.PosNext(const Find: IInterface;
|
|
const PrevPos: Integer; const IsSortedAscending: Boolean): Integer;
|
|
var I, L, H : Integer;
|
|
D : IInterface;
|
|
begin
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if MaxInt(PrevPos + 1, 0) = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := Item[I];
|
|
if D = Find then
|
|
begin
|
|
while (I > 0) and (Item[I - 1] = Find) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end else
|
|
if NativeInt(D) > NativeInt(Find) then
|
|
H := I - 1 else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end else // find next
|
|
if PrevPos >= Count - 1 then
|
|
Result := -1 else
|
|
if Item[PrevPos + 1] = Find then
|
|
Result := PrevPos + 1 else
|
|
Result := -1;
|
|
end else // linear search
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Item[I] = Find then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure AInterfaceArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is AInterfaceArray then
|
|
begin
|
|
L := AInterfaceArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AInterfaceArray(Source).Item[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AInterfaceArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is AInterfaceArray then
|
|
begin
|
|
L := AInterfaceArray(V).Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if Item[I] <> AInterfaceArray(V).Item[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function AInterfaceArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
Result := Count;
|
|
if V is AInterfaceArray then
|
|
begin
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := AInterfaceArray(V)[I];
|
|
end
|
|
else
|
|
raise EInterfaceArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
procedure AInterfaceArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(I, GetItem(I + ACount));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
procedure AInterfaceArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
exit;
|
|
C := GetCount;
|
|
SetCount(C + ACount);
|
|
J := MinInt(MaxInt(Idx, 0), C);
|
|
L := C - J;
|
|
for I := C - 1 downto C - L do
|
|
SetItem(I + ACount, GetItem(I));
|
|
end;
|
|
|
|
|
|
{ }
|
|
{ AObjectArray }
|
|
{ }
|
|
procedure AObjectArray.Clear;
|
|
begin
|
|
if IsItemOwner then
|
|
FreeItems
|
|
else
|
|
ReleaseItems;
|
|
end;
|
|
|
|
procedure AObjectArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
V : TObject;
|
|
begin
|
|
if Source is AObjectArray then
|
|
begin
|
|
FreeItems;
|
|
IsItemOwner := AObjectArray(Source).IsItemOwner;
|
|
L := AObjectArray(Source).Count;
|
|
Count := L;
|
|
if GetIsItemOwner then
|
|
for I := 0 to L - 1 do
|
|
begin
|
|
V := AObjectArray(Source)[I];
|
|
if V is AArray then
|
|
Item[I] := AArray(V).Duplicate else
|
|
Item[I] := V;
|
|
end
|
|
else
|
|
for I := 0 to L - 1 do
|
|
Item[I] := AObjectArray(Source)[I];
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AObjectArray.IsEqual(const V: TObject): Boolean;
|
|
var I, L : Integer;
|
|
A, B : TObject;
|
|
begin
|
|
if V is AObjectArray then
|
|
begin
|
|
L := AArray(V).Count;
|
|
if Count <> L then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
for I := 0 to L - 1 do
|
|
begin
|
|
A := Item[I];
|
|
B := AObjectArray(V)[I];
|
|
Result := A = B;
|
|
if not Result then
|
|
exit;
|
|
end;
|
|
Result := True;
|
|
end else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function AObjectArray.Compare(const V: TObject): TCompareResult;
|
|
var I, C1, C2 : Integer;
|
|
A, B : TObject;
|
|
begin
|
|
if V is AObjectArray then
|
|
begin
|
|
C1 := GetCount;
|
|
C2 := AObjectArray(V).GetCount;
|
|
if C1 < C2 then
|
|
Result := crLess else
|
|
if C1 > C2 then
|
|
Result := crGreater else
|
|
begin
|
|
Result := crEqual;
|
|
for I := 0 to GetCount - 1 do
|
|
begin
|
|
A := Item[I];
|
|
B := AObjectArray(V)[I];
|
|
if A <> B then
|
|
begin
|
|
Result := crUndefined;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end else
|
|
Result := inherited Compare(V);
|
|
end;
|
|
|
|
function AObjectArray.GetRange(const LoIdx, HiIdx: Integer): ObjectArray;
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := H - L + 1;
|
|
SetLength(Result, C);
|
|
for I := 0 to C - 1 do
|
|
Result[L + I] := Item[I];
|
|
end;
|
|
|
|
procedure AObjectArray.SetRange(const LoIdx, HiIdx: Integer; const V: ObjectArray);
|
|
var I, L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(Count - 1, HiIdx);
|
|
C := MinInt(Length(V), H - L + 1);
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
function AObjectArray.GetAsString: String;
|
|
var I, L : Integer;
|
|
V : TObject;
|
|
begin
|
|
Result := '';
|
|
L := Count;
|
|
for I := 0 to L - 1 do
|
|
begin
|
|
V := Item[I];
|
|
Result := Result + PointerToStr(Pointer(V));
|
|
if I < L - 1 then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
procedure AObjectArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : TObject;
|
|
begin
|
|
I := Item[Idx1];
|
|
Item[Idx1] := Item[Idx2];
|
|
Item[Idx2] := I;
|
|
end;
|
|
|
|
function AObjectArray.AppendItem(const Value: TObject): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Item[Result] := Value;
|
|
end;
|
|
|
|
function AObjectArray.AppendArray(const V: ObjectArray): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + Length(V);
|
|
Range[Result, Count - 1] := V;
|
|
end;
|
|
|
|
{$WARNINGS OFF}
|
|
function AObjectArray.AppendArray(const V: AArray): Integer;
|
|
var I, L : Integer;
|
|
begin
|
|
if V is AObjectArray then
|
|
begin
|
|
Result := Count;
|
|
L := V.Count;
|
|
Count := Result + L;
|
|
for I := 0 to L - 1 do
|
|
Item[Result + I] := AObjectArray(V)[I];
|
|
end
|
|
else
|
|
raise EObjectArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
{$IFDEF DEBUG}{$IFNDEF FREEPASCAL}{$WARNINGS ON}{$ENDIF}{$ENDIF}
|
|
|
|
procedure AObjectArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, C, J, L : Integer;
|
|
begin
|
|
J := MaxInt(Idx, 0);
|
|
C := GetCount;
|
|
L := MinInt(ACount, C - J);
|
|
if L > 0 then
|
|
begin
|
|
for I := J to J + C - 1 do
|
|
SetItem(Idx + I, GetItem(Idx + ACount + I));
|
|
SetCount(C - L);
|
|
end;
|
|
end;
|
|
|
|
function AObjectArray.PosNext(const Find: TObject; const PrevPos: Integer): Integer;
|
|
var I : Integer;
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
if Find = Item[I] then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function AObjectArray.PosNext(var AItem: TObject; const AClassType: TClass;
|
|
const PrevPos: Integer): Integer;
|
|
var I : Integer;
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
begin
|
|
AItem := GetItem(I);
|
|
if AItem.InheritsFrom(AClassType) then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
end;
|
|
AItem := nil;
|
|
Result := -1;
|
|
end;
|
|
|
|
function AObjectArray.PosNext(var AItem: TObject; const AClassName: String;
|
|
const PrevPos: Integer): Integer;
|
|
var I : Integer;
|
|
begin
|
|
for I := MaxInt(PrevPos + 1, 0) to Count - 1 do
|
|
begin
|
|
AItem := GetItem(I);
|
|
if Assigned(AItem) and AItem.ClassNameIs(AClassName) then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
end;
|
|
AItem := nil;
|
|
Result := -1;
|
|
end;
|
|
|
|
function AObjectArray.Find(const AClassType: TClass; const ACount: Integer): TObject;
|
|
var I, J : Integer;
|
|
begin
|
|
Result := nil;
|
|
I := -1;
|
|
for J := 1 to ACount do
|
|
begin
|
|
I := PosNext(Result, AClassType, I);
|
|
if I = -1 then
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
function AObjectArray.Find(const AClassName: String; const ACount: Integer): TObject;
|
|
var I, J : Integer;
|
|
begin
|
|
Result := nil;
|
|
I := -1;
|
|
for J := 1 to ACount do
|
|
begin
|
|
I := PosNext(Result, AClassName, I);
|
|
if I = -1 then
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
function AObjectArray.FindAll(const AClassType: TClass): ObjectArray;
|
|
var I : Integer;
|
|
V : TObject;
|
|
begin
|
|
SetLength(Result, 0);
|
|
I := PosNext(V, AClassType);
|
|
while I >= 0 do
|
|
begin
|
|
DynArrayAppend(Result, V);
|
|
I := PosNext(V, AClassType, I);
|
|
end;
|
|
end;
|
|
|
|
function AObjectArray.FindAll(const AClassName: String): ObjectArray;
|
|
var I : Integer;
|
|
V : TObject;
|
|
begin
|
|
SetLength(Result, 0);
|
|
I := PosNext(V, AClassName);
|
|
while I >= 0 do
|
|
begin
|
|
DynArrayAppend(Result, V);
|
|
I := PosNext(V, AClassName, I);
|
|
end;
|
|
end;
|
|
|
|
function AObjectArray.CountItems(const AClassType: TClass): Integer;
|
|
var I : Integer;
|
|
V : TObject;
|
|
begin
|
|
Result := 0;
|
|
I := PosNext(V, AClassType);
|
|
while I >= 0 do
|
|
begin
|
|
Inc(Result);
|
|
I := PosNext(V, AClassType, I);
|
|
end;
|
|
end;
|
|
|
|
function AObjectArray.CountItems(const AClassName: String): Integer;
|
|
var I : Integer;
|
|
V : TObject;
|
|
begin
|
|
Result := 0;
|
|
I := PosNext(V, AClassName);
|
|
while I >= 0 do
|
|
begin
|
|
Inc(Result);
|
|
I := PosNext(V, AClassName, I);
|
|
end;
|
|
end;
|
|
|
|
function AObjectArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
var A, B : TObject;
|
|
begin
|
|
A := Item[Idx1];
|
|
B := Item[Idx2];
|
|
if A = B then
|
|
Result := crEqual else
|
|
Result := crUndefined;
|
|
end;
|
|
|
|
function AObjectArray.DeleteValue(const Value: TObject): Boolean;
|
|
var I : Integer;
|
|
begin
|
|
I := PosNext(Value, -1);
|
|
Result := I >= 0;
|
|
if Result then
|
|
Delete(I, 1);
|
|
end;
|
|
|
|
function AObjectArray.DeleteAll(const Value: TObject): Integer;
|
|
begin
|
|
Result := 0;
|
|
while DeleteValue(Value) do
|
|
Inc(Result);
|
|
end;
|
|
|
|
function AObjectArray.ReleaseValue(const Value: TObject): Boolean;
|
|
var I : Integer;
|
|
begin
|
|
I := PosNext(Value, -1);
|
|
Result := I >= 0;
|
|
if Result then
|
|
ReleaseItem(I);
|
|
end;
|
|
|
|
function AObjectArray.RemoveItem(const Idx: Integer): TObject;
|
|
begin
|
|
Result := ReleaseItem(Idx);
|
|
Delete(Idx, 1);
|
|
end;
|
|
|
|
function AObjectArray.RemoveValue(const Value: TObject): Boolean;
|
|
var I : Integer;
|
|
begin
|
|
I := PosNext(Value, -1);
|
|
Result := I >= 0;
|
|
if Result then
|
|
RemoveItem(I);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ABitArray }
|
|
{ }
|
|
const
|
|
BitMaskTable32: array[0..31] of Word32 =
|
|
($00000001, $00000002, $00000004, $00000008,
|
|
$00000010, $00000020, $00000040, $00000080,
|
|
$00000100, $00000200, $00000400, $00000800,
|
|
$00001000, $00002000, $00004000, $00008000,
|
|
$00010000, $00020000, $00040000, $00080000,
|
|
$00100000, $00200000, $00400000, $00800000,
|
|
$01000000, $02000000, $04000000, $08000000,
|
|
$10000000, $20000000, $40000000, $80000000);
|
|
|
|
function ABitArray.GetRangeL(const Idx: Integer): Word32;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to 31 do
|
|
if Bit[Idx + I] then
|
|
Result := Result or BitMaskTable32[I];
|
|
end;
|
|
|
|
procedure ABitArray.SetRangeL(const Idx: Integer; const Value: Word32);
|
|
var
|
|
I : Integer;
|
|
C : Word32;
|
|
begin
|
|
C := 1;
|
|
for I := Idx to Idx + 31 do
|
|
begin
|
|
Bit[I] := Value and C <> 0;
|
|
C := C shl 1;
|
|
end;
|
|
end;
|
|
|
|
procedure ABitArray.Fill(const Idx, ACount: Integer; const Value: Boolean);
|
|
var
|
|
I : Integer;
|
|
begin
|
|
for I := Idx to Idx + ACount - 1 do
|
|
Bit[I] := Value;
|
|
end;
|
|
|
|
function ABitArray.IsRange(const LoIdx, HiIdx: Integer; const Value: Boolean): Boolean;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
for I := LoIdx to HiIdx do
|
|
if Bit[I] <> Value then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure ABitArray.Assign(const Source: TObject);
|
|
var
|
|
I, L : Integer;
|
|
begin
|
|
if Source is ABitArray then
|
|
begin
|
|
L := AArray(Source).Count;
|
|
Count := L;
|
|
for I := 0 to L - 1 do
|
|
Bit[I] := ABitArray(Source)[I];
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ABitArray.IsEqual(const V: TObject): Boolean;
|
|
var
|
|
I, L : Integer;
|
|
begin
|
|
if V is ABitArray then
|
|
begin
|
|
L := AArray(V).Count;
|
|
if Count <> L then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
for I := 0 to L - 1 do
|
|
if Bit[I] <> ABitArray(V)[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
procedure ABitArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var
|
|
I : Boolean;
|
|
begin
|
|
I := Bit[Idx1];
|
|
Bit[Idx1] := Bit[Idx2];
|
|
Bit[Idx2] := I;
|
|
end;
|
|
|
|
function ABitArray.AppendItem(const Value: Boolean): Integer;
|
|
begin
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
Bit[Result] := Value;
|
|
end;
|
|
|
|
function ABitArray.CompareItems(const Idx1, Idx2: Integer): TCompareResult;
|
|
begin
|
|
Result := flcUtils.Compare(Bit[Idx1], Bit[Idx2]);
|
|
end;
|
|
|
|
procedure ABitArray.Invert;
|
|
var
|
|
I : Integer;
|
|
begin
|
|
for I := 0 to Count - 1 do
|
|
Bit[I] := not Bit[I];
|
|
end;
|
|
|
|
function ABitArray.Find(const Value: Boolean; const Start: Integer): Integer;
|
|
var
|
|
I, C : Integer;
|
|
begin
|
|
if Start < 0 then
|
|
I := 0
|
|
else
|
|
I := Start;
|
|
C := Count;
|
|
while I < C do
|
|
if Bit[I] = Value then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end
|
|
else
|
|
Inc(I);
|
|
Result := -1;
|
|
end;
|
|
|
|
function ABitArray.FindRange(const Value: Boolean; const Start: Integer;
|
|
const ACount: Integer): Integer;
|
|
var
|
|
I, C, F : Integer;
|
|
begin
|
|
if ACount <= 0 then
|
|
begin
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
if Start < 0 then
|
|
I := 0
|
|
else
|
|
I := Start;
|
|
C := self.Count;
|
|
F := 0;
|
|
while I + F < C do
|
|
if Bit[I + F] = Value then
|
|
begin
|
|
Inc(F);
|
|
if F = ACount then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
Inc(I, F + 1);
|
|
F := 0;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure ABitArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var
|
|
I, C : Integer;
|
|
begin
|
|
C := GetCount;
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx + ACount > C) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
for I := Idx + ACount to C - 1 do
|
|
SetBit(I - ACount, GetBit(I));
|
|
SetCount(C - ACount);
|
|
end;
|
|
|
|
procedure ABitArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
var
|
|
I, C : Integer;
|
|
begin
|
|
C := GetCount;
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx > C) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
SetCount(C + ACount);
|
|
for I := Idx to C - 1 do
|
|
SetBit(I + ACount, GetBit(I));
|
|
Fill(Idx, Idx + ACount - 1, False);
|
|
end;
|
|
|
|
function ABitArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var
|
|
I, C : Integer;
|
|
begin
|
|
C := GetCount;
|
|
{$IFOPT R+}
|
|
if (LoIdx < 0) or (LoIdx > HiIdx) or (HiIdx >= C) then
|
|
RaiseIndexError(HiIdx);
|
|
{$ENDIF}
|
|
Result := ABitArray(CreateInstance);
|
|
C := HiIdx - LoIdx + 1;
|
|
Result.Count := C;
|
|
for I := 0 to C - 1 do
|
|
ABitArray(Result)[I] := GetBit(LoIdx + I);
|
|
end;
|
|
|
|
function ABitArray.AppendArray(const V: AArray): Integer;
|
|
var
|
|
I, C : Integer;
|
|
begin
|
|
if V is ABitArray then
|
|
begin
|
|
Result := Count;
|
|
C := ABitArray(V).Count;
|
|
if C = 0 then
|
|
exit;
|
|
SetCount(Result + C);
|
|
for I := 0 to C - 1 do
|
|
SetBit(Result + I, ABitArray(V).GetBit(I));
|
|
end
|
|
else
|
|
raise EBitArray.CreateFmt('%s can not append %s', [ClassName, ObjectClassName(V)]);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ARRAY IMPLEMENTATIONS }
|
|
{ }
|
|
{ }
|
|
|
|
{ }
|
|
{ TInt32Array }
|
|
{ }
|
|
function TInt32Array.GetItem(const Idx: Integer): Int32;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TInt32Array.SetItem(const Idx: Integer; const Value: Int32);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TInt32Array.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Int32;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TInt32Array.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TInt32Array.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TInt32Array.AppendItem(const Value: Int32): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TInt32Array.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TInt32Array.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TInt32Array.GetRange(const LoIdx, HiIdx: Integer): Int32Array;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TInt32Array.SetRange(const LoIdx, HiIdx: Integer; const V: Int32Array);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(Int32));
|
|
end;
|
|
|
|
constructor TInt32Array.Create(const V: Int32Array);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TInt32Array.SetData(const AData: Int32Array);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TInt32Array.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TInt32Array;
|
|
TInt32Array(Result).FCount := C;
|
|
if C > 0 then
|
|
TInt32Array(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TInt32Array.Assign(const V: Int32Array);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TInt32Array.Assign(const V: Array of Int32);
|
|
begin
|
|
FData := AsInt32Array(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TInt32Array.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TInt32Array then
|
|
begin
|
|
FCount := TInt32Array(Source).FCount;
|
|
FData := Copy(TInt32Array(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInt64Array }
|
|
{ }
|
|
function TInt64Array.GetItem(const Idx: Integer): Int64;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TInt64Array.SetItem(const Idx: Integer; const Value: Int64);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TInt64Array.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Int64;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TInt64Array.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TInt64Array.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TInt64Array.AppendItem(const Value: Int64): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TInt64Array.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TInt64Array.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TInt64Array.GetRange(const LoIdx, HiIdx: Integer): Int64Array;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TInt64Array.SetRange(const LoIdx, HiIdx: Integer; const V: Int64Array);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(Int64));
|
|
end;
|
|
|
|
constructor TInt64Array.Create(const V: Int64Array);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TInt64Array.SetData(const AData: Int64Array);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TInt64Array.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TInt64Array;
|
|
TInt64Array(Result).FCount := C;
|
|
if C > 0 then
|
|
TInt64Array(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TInt64Array.Assign(const V: Int64Array);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TInt64Array.Assign(const V: Array of Int64);
|
|
begin
|
|
FData := AsInt64Array(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TInt64Array.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TInt64Array then
|
|
begin
|
|
FCount := TInt64Array(Source).FCount;
|
|
FData := Copy(TInt64Array(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongIntArray }
|
|
{ }
|
|
function TLongIntArray.GetItem(const Idx: Integer): LongInt;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TLongIntArray.SetItem(const Idx: Integer; const Value: LongInt);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TLongIntArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : LongInt;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TLongIntArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TLongIntArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TLongIntArray.AppendItem(const Value: LongInt): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TLongIntArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TLongIntArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TLongIntArray.GetRange(const LoIdx, HiIdx: Integer): LongIntArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TLongIntArray.SetRange(const LoIdx, HiIdx: Integer; const V: LongIntArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(LongInt));
|
|
end;
|
|
|
|
constructor TLongIntArray.Create(const V: LongIntArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TLongIntArray.SetData(const AData: LongIntArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TLongIntArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TLongIntArray;
|
|
TLongIntArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TLongIntArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TLongIntArray.Assign(const V: LongIntArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TLongIntArray.Assign(const V: Array of LongInt);
|
|
begin
|
|
FData := AsLongIntArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TLongIntArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TLongIntArray then
|
|
begin
|
|
FCount := TLongIntArray(Source).FCount;
|
|
FData := Copy(TLongIntArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TWord32Array }
|
|
{ }
|
|
function TWord32Array.GetItem(const Idx: Integer): Word32;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TWord32Array.SetItem(const Idx: Integer; const Value: Word32);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TWord32Array.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Word32;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TWord32Array.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TWord32Array.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TWord32Array.AppendItem(const Value: Word32): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TWord32Array.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TWord32Array.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TWord32Array.GetRange(const LoIdx, HiIdx: Integer): Word32Array;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TWord32Array.SetRange(const LoIdx, HiIdx: Integer; const V: Word32Array);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(Word32));
|
|
end;
|
|
|
|
constructor TWord32Array.Create(const V: Word32Array);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TWord32Array.SetData(const AData: Word32Array);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TWord32Array.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TWord32Array;
|
|
TWord32Array(Result).FCount := C;
|
|
if C > 0 then
|
|
TWord32Array(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TWord32Array.Assign(const V: Word32Array);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TWord32Array.Assign(const V: Array of Word32);
|
|
begin
|
|
FData := AsWord32Array(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TWord32Array.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TWord32Array then
|
|
begin
|
|
FCount := TWord32Array(Source).FCount;
|
|
FData := Copy(TWord32Array(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TWord64Array }
|
|
{ }
|
|
function TWord64Array.GetItem(const Idx: Integer): Word64;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TWord64Array.SetItem(const Idx: Integer; const Value: Word64);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TWord64Array.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Word64;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TWord64Array.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TWord64Array.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TWord64Array.AppendItem(const Value: Word64): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TWord64Array.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TWord64Array.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TWord64Array.GetRange(const LoIdx, HiIdx: Integer): Word64Array;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TWord64Array.SetRange(const LoIdx, HiIdx: Integer; const V: Word64Array);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(Word64));
|
|
end;
|
|
|
|
constructor TWord64Array.Create(const V: Word64Array);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TWord64Array.SetData(const AData: Word64Array);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TWord64Array.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TWord64Array;
|
|
TWord64Array(Result).FCount := C;
|
|
if C > 0 then
|
|
TWord64Array(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TWord64Array.Assign(const V: Word64Array);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TWord64Array.Assign(const V: Array of Word64);
|
|
begin
|
|
FData := AsWord64Array(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TWord64Array.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TWord64Array then
|
|
begin
|
|
FCount := TWord64Array(Source).FCount;
|
|
FData := Copy(TWord64Array(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongWordArray }
|
|
{ }
|
|
function TLongWordArray.GetItem(const Idx: Integer): LongWord;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TLongWordArray.SetItem(const Idx: Integer; const Value: LongWord);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TLongWordArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : LongWord;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TLongWordArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TLongWordArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TLongWordArray.AppendItem(const Value: LongWord): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TLongWordArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TLongWordArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TLongWordArray.GetRange(const LoIdx, HiIdx: Integer): LongWordArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TLongWordArray.SetRange(const LoIdx, HiIdx: Integer; const V: LongWordArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(LongWord));
|
|
end;
|
|
|
|
constructor TLongWordArray.Create(const V: LongWordArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TLongWordArray.SetData(const AData: LongWordArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TLongWordArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TLongWordArray;
|
|
TLongWordArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TLongWordArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TLongWordArray.Assign(const V: LongWordArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TLongWordArray.Assign(const V: Array of LongWord);
|
|
begin
|
|
FData := AsLongWordArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TLongWordArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TLongWordArray then
|
|
begin
|
|
FCount := TLongWordArray(Source).FCount;
|
|
FData := Copy(TLongWordArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TSingleArray }
|
|
{ }
|
|
function TSingleArray.GetItem(const Idx: Integer): Single;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TSingleArray.SetItem(const Idx: Integer; const Value: Single);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TSingleArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Single;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TSingleArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TSingleArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TSingleArray.AppendItem(const Value: Single): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TSingleArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TSingleArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TSingleArray.GetRange(const LoIdx, HiIdx: Integer): SingleArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TSingleArray.SetRange(const LoIdx, HiIdx: Integer; const V: SingleArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(Single));
|
|
end;
|
|
|
|
constructor TSingleArray.Create(const V: SingleArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TSingleArray.SetData(const AData: SingleArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TSingleArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TSingleArray;
|
|
TSingleArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TSingleArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TSingleArray.Assign(const V: SingleArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TSingleArray.Assign(const V: Array of Single);
|
|
begin
|
|
FData := AsSingleArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TSingleArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TSingleArray then
|
|
begin
|
|
FCount := TSingleArray(Source).FCount;
|
|
FData := Copy(TSingleArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoubleArray }
|
|
{ }
|
|
function TDoubleArray.GetItem(const Idx: Integer): Double;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TDoubleArray.SetItem(const Idx: Integer; const Value: Double);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TDoubleArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Double;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TDoubleArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TDoubleArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TDoubleArray.AppendItem(const Value: Double): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TDoubleArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TDoubleArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TDoubleArray.GetRange(const LoIdx, HiIdx: Integer): DoubleArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TDoubleArray.SetRange(const LoIdx, HiIdx: Integer; const V: DoubleArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(Double));
|
|
end;
|
|
|
|
constructor TDoubleArray.Create(const V: DoubleArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TDoubleArray.SetData(const AData: DoubleArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TDoubleArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TDoubleArray;
|
|
TDoubleArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TDoubleArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TDoubleArray.Assign(const V: DoubleArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TDoubleArray.Assign(const V: Array of Double);
|
|
begin
|
|
FData := AsDoubleArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TDoubleArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TDoubleArray then
|
|
begin
|
|
FCount := TDoubleArray(Source).FCount;
|
|
FData := Copy(TDoubleArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TExtendedArray }
|
|
{ }
|
|
function TExtendedArray.GetItem(const Idx: Integer): Extended;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TExtendedArray.SetItem(const Idx: Integer; const Value: Extended);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TExtendedArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Extended;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TExtendedArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TExtendedArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TExtendedArray.AppendItem(const Value: Extended): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TExtendedArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TExtendedArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TExtendedArray.GetRange(const LoIdx, HiIdx: Integer): ExtendedArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TExtendedArray.SetRange(const LoIdx, HiIdx: Integer; const V: ExtendedArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(Extended));
|
|
end;
|
|
|
|
constructor TExtendedArray.Create(const V: ExtendedArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TExtendedArray.SetData(const AData: ExtendedArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TExtendedArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TExtendedArray;
|
|
TExtendedArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TExtendedArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TExtendedArray.Assign(const V: ExtendedArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TExtendedArray.Assign(const V: Array of Extended);
|
|
begin
|
|
FData := AsExtendedArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TExtendedArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TExtendedArray then
|
|
begin
|
|
FCount := TExtendedArray(Source).FCount;
|
|
FData := Copy(TExtendedArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TAnsiStringArray }
|
|
{ }
|
|
function TAnsiStringArray.GetItem(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TAnsiStringArray.SetItem(const Idx: Integer; const Value: AnsiString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TAnsiStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TAnsiStringArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TAnsiStringArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLength(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TAnsiStringArray.AppendItem(const Value: AnsiString): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TAnsiStringArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemoveA(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TAnsiStringArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsertA(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TAnsiStringArray.GetRange(const LoIdx, HiIdx: Integer): AnsiStringArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TAnsiStringArray.SetRange(const LoIdx, HiIdx: Integer; const V: AnsiStringArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(AnsiString));
|
|
end;
|
|
|
|
constructor TAnsiStringArray.Create(const V: AnsiStringArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TAnsiStringArray.SetData(const AData: AnsiStringArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TAnsiStringArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TAnsiStringArray;
|
|
TAnsiStringArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TAnsiStringArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TAnsiStringArray.Assign(const V: AnsiStringArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TAnsiStringArray.Assign(const V: Array of AnsiString);
|
|
begin
|
|
FData := AsAnsiStringArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TAnsiStringArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TAnsiStringArray then
|
|
begin
|
|
FCount := TAnsiStringArray(Source).FCount;
|
|
FData := Copy(TAnsiStringArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TRawByteStringArray }
|
|
{ }
|
|
function TRawByteStringArray.GetItem(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TRawByteStringArray.SetItem(const Idx: Integer; const Value: RawByteString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TRawByteStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TRawByteStringArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TRawByteStringArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLength(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TRawByteStringArray.AppendItem(const Value: RawByteString): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TRawByteStringArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemoveB(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TRawByteStringArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsertB(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TRawByteStringArray.GetRange(const LoIdx, HiIdx: Integer): RawByteStringArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TRawByteStringArray.SetRange(const LoIdx, HiIdx: Integer; const V: RawByteStringArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(RawByteString));
|
|
end;
|
|
|
|
constructor TRawByteStringArray.Create(const V: RawByteStringArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TRawByteStringArray.SetData(const AData: RawByteStringArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TRawByteStringArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TRawByteStringArray;
|
|
TRawByteStringArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TRawByteStringArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TRawByteStringArray.Assign(const V: RawByteStringArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TRawByteStringArray.Assign(const V: Array of RawByteString);
|
|
begin
|
|
FData := AsRawByteStringArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TRawByteStringArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TRawByteStringArray then
|
|
begin
|
|
FCount := TRawByteStringArray(Source).FCount;
|
|
FData := Copy(TRawByteStringArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TUnicodeStringArray }
|
|
{ }
|
|
function TUnicodeStringArray.GetItem(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TUnicodeStringArray.SetItem(const Idx: Integer; const Value: UnicodeString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TUnicodeStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TUnicodeStringArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TUnicodeStringArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLength(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TUnicodeStringArray.AppendItem(const Value: UnicodeString): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TUnicodeStringArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemoveU(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TUnicodeStringArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsertU(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TUnicodeStringArray.GetRange(const LoIdx, HiIdx: Integer): UnicodeStringArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TUnicodeStringArray.SetRange(const LoIdx, HiIdx: Integer; const V: UnicodeStringArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(UnicodeString));
|
|
end;
|
|
|
|
constructor TUnicodeStringArray.Create(const V: UnicodeStringArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TUnicodeStringArray.SetData(const AData: UnicodeStringArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TUnicodeStringArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TUnicodeStringArray;
|
|
TUnicodeStringArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TUnicodeStringArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TUnicodeStringArray.Assign(const V: UnicodeStringArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TUnicodeStringArray.Assign(const V: Array of UnicodeString);
|
|
begin
|
|
FData := AsUnicodeStringArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TUnicodeStringArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TUnicodeStringArray then
|
|
begin
|
|
FCount := TUnicodeStringArray(Source).FCount;
|
|
FData := Copy(TUnicodeStringArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TStringArray }
|
|
{ }
|
|
function TStringArray.GetItem(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TStringArray.SetItem(const Idx: Integer; const Value: String);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TStringArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TStringArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLength(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TStringArray.AppendItem(const Value: String): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TStringArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TStringArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TStringArray.GetRange(const LoIdx, HiIdx: Integer): StringArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TStringArray.SetRange(const LoIdx, HiIdx: Integer; const V: StringArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(String));
|
|
end;
|
|
|
|
constructor TStringArray.Create(const V: StringArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TStringArray.SetData(const AData: StringArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TStringArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TStringArray;
|
|
TStringArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TStringArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TStringArray.Assign(const V: StringArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TStringArray.Assign(const V: Array of String);
|
|
begin
|
|
FData := AsStringArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TStringArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TStringArray then
|
|
begin
|
|
FCount := TStringArray(Source).FCount;
|
|
FData := Copy(TStringArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TPointerArray }
|
|
{ }
|
|
function TPointerArray.GetItem(const Idx: Integer): Pointer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TPointerArray.SetItem(const Idx: Integer; const Value: Pointer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TPointerArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : Pointer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TPointerArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TPointerArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TPointerArray.AppendItem(const Value: Pointer): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TPointerArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TPointerArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TPointerArray.GetRange(const LoIdx, HiIdx: Integer): PointerArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TPointerArray.SetRange(const LoIdx, HiIdx: Integer; const V: PointerArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(Pointer));
|
|
end;
|
|
|
|
constructor TPointerArray.Create(const V: PointerArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TPointerArray.SetData(const AData: PointerArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TPointerArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TPointerArray;
|
|
TPointerArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TPointerArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TPointerArray.Assign(const V: PointerArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TPointerArray.Assign(const V: Array of Pointer);
|
|
begin
|
|
FData := AsPointerArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TPointerArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TPointerArray then
|
|
begin
|
|
FCount := TPointerArray(Source).FCount;
|
|
FData := Copy(TPointerArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TObjectArray }
|
|
{ }
|
|
constructor TObjectArray.Create(const V: ObjectArray; const AIsItemOwner: Boolean);
|
|
begin
|
|
inherited Create;
|
|
FData := V;
|
|
FIsItemOwner := AIsItemOwner;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
destructor TObjectArray.Destroy;
|
|
begin
|
|
if FIsItemOwner then
|
|
FreeItems;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TObjectArray.Init;
|
|
begin
|
|
inherited Init;
|
|
FIsItemOwner := False;
|
|
end;
|
|
|
|
procedure TObjectArray.FreeItems;
|
|
begin
|
|
FreeObjectArray(FData);
|
|
FData := nil;
|
|
FCapacity := 0;
|
|
FCount := 0;
|
|
end;
|
|
|
|
procedure TObjectArray.ReleaseItems;
|
|
begin
|
|
FData := nil;
|
|
FCapacity := 0;
|
|
FCount := 0;
|
|
end;
|
|
|
|
function TObjectArray.GetIsItemOwner: Boolean;
|
|
begin
|
|
Result := FIsItemOwner;
|
|
end;
|
|
|
|
procedure TObjectArray.SetIsItemOwner(const AIsItemOwner: Boolean);
|
|
begin
|
|
FIsItemOwner := AIsItemOwner;
|
|
end;
|
|
|
|
function TObjectArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
procedure TObjectArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if N = FCount then
|
|
exit;
|
|
if (N < FCount) and FIsItemOwner then
|
|
FreeObjectArray(FData, N, FCount - 1);
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else
|
|
if N > L shr 1 then
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLengthAndZero(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TObjectArray.GetItem(const Idx: Integer): TObject;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TObjectArray.SetItem(const Idx: Integer; const Value: TObject);
|
|
var P : ^TObject;
|
|
V : TObject;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
P := Pointer(FData);
|
|
Inc(P, Idx);
|
|
if FIsItemOwner then
|
|
begin
|
|
V := P^;
|
|
if V = Value then
|
|
exit;
|
|
V.Free;
|
|
end;
|
|
P^ := Value;
|
|
end;
|
|
|
|
function TObjectArray.AppendItem(const Value: TObject): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
function TObjectArray.ReleaseItem(const Idx: Integer): TObject;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
if Assigned(Result) and FIsItemOwner then
|
|
FData[Idx] := nil;
|
|
end;
|
|
|
|
function TObjectArray.GetRange(const LoIdx, HiIdx: Integer): ObjectArray;
|
|
begin
|
|
Result := Copy(FData, LoIdx, MinInt(HiIdx, FCount - 1) - LoIdx + 1);
|
|
end;
|
|
|
|
procedure TObjectArray.SetData(const AData: ObjectArray);
|
|
begin
|
|
if FIsItemOwner then
|
|
FreeItems;
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TObjectArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var I : Integer;
|
|
V : TObject;
|
|
begin
|
|
Result := CreateInstance as TObjectArray;
|
|
for I := LoIdx to MinInt(HiIdx, FCount - 1) do
|
|
begin
|
|
V := FData[I];
|
|
if V is AType then
|
|
V := AType(V).Duplicate;
|
|
TObjectArray(Result).AppendItem(V);
|
|
end;
|
|
end;
|
|
|
|
procedure TObjectArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount, FIsItemOwner);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TObjectArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInterfaceArray }
|
|
{ }
|
|
function TInterfaceArray.GetItem(const Idx: Integer): IInterface;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := FData[Idx];
|
|
end;
|
|
|
|
procedure TInterfaceArray.SetItem(const Idx: Integer; const Value: IInterface);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
FData[Idx] := Value;
|
|
end;
|
|
|
|
procedure TInterfaceArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var I : IInterface;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx1 < 0) or (Idx1 >= FCount) then
|
|
RaiseIndexError(Idx1);
|
|
if (Idx2 < 0) or (Idx2 >= FCount) then
|
|
RaiseIndexError(Idx2);
|
|
{$ENDIF}
|
|
I := FData[Idx1];
|
|
FData[Idx1] := FData[Idx2];
|
|
FData[Idx2] := I;
|
|
end;
|
|
|
|
function TInterfaceArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
{ Memory allocation strategy to reduce memory copies: }
|
|
{ * For first allocation: allocate the exact size. }
|
|
{ * For change to < 16: allocate 16 entries. }
|
|
{ * For growing to >= 16: pre-allocate 1/8th of NewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TInterfaceArray.SetCount(const NewCount: Integer);
|
|
var L, N : Integer;
|
|
begin
|
|
N := NewCount;
|
|
if FCount = N then
|
|
exit;
|
|
FCount := N;
|
|
L := FCapacity;
|
|
if L > 0 then
|
|
if N < 16 then // pre-allocate first 16 entries
|
|
N := 16 else
|
|
if N > L then
|
|
N := N + N shr 3 else // pre-allocate 1/8th extra if growing
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
if N <> L then
|
|
begin
|
|
SetLength(FData, N);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TInterfaceArray.AppendItem(const Value: IInterface): Integer;
|
|
begin
|
|
Result := FCount;
|
|
if Result >= FCapacity then
|
|
SetCount(Result + 1)
|
|
else
|
|
FCount := Result + 1;
|
|
FData[Result] := Value;
|
|
end;
|
|
|
|
procedure TInterfaceArray.Delete(const Idx: Integer; const ACount: Integer = 1);
|
|
var N : Integer;
|
|
begin
|
|
N := DynArrayRemove(FData, Idx, ACount);
|
|
Dec(FCapacity, N);
|
|
Dec(FCount, N);
|
|
end;
|
|
|
|
procedure TInterfaceArray.Insert(const Idx: Integer; const ACount: Integer = 1);
|
|
var I : Integer;
|
|
begin
|
|
I := DynArrayInsert(FData, Idx, ACount);
|
|
if I >= 0 then
|
|
begin
|
|
Inc(FCapacity, ACount);
|
|
Inc(FCount, ACount);
|
|
end;
|
|
end;
|
|
|
|
function TInterfaceArray.GetRange(const LoIdx, HiIdx: Integer): InterfaceArray;
|
|
var L, H : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1) else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TInterfaceArray.SetRange(const LoIdx, HiIdx: Integer; const V: InterfaceArray);
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(MinInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(IInterface));
|
|
end;
|
|
|
|
constructor TInterfaceArray.Create(const V: InterfaceArray);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure TInterfaceArray.SetData(const AData: InterfaceArray);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
function TInterfaceArray.DuplicateRange(const LoIdx, HiIdx: Integer): AArray;
|
|
var L, H, C : Integer;
|
|
begin
|
|
L := MaxInt(0, LoIdx);
|
|
H := MinInt(HiIdx, FCount);
|
|
C := MaxInt(0, H - L + 1);
|
|
Result := CreateInstance as TInterfaceArray;
|
|
TInterfaceArray(Result).FCount := C;
|
|
if C > 0 then
|
|
TInterfaceArray(Result).FData := Copy(FData, L, C);
|
|
end;
|
|
|
|
procedure TInterfaceArray.Assign(const V: InterfaceArray);
|
|
begin
|
|
FData := Copy(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TInterfaceArray.Assign(const V: Array of IInterface);
|
|
begin
|
|
FData := AsInterfaceArray(V);
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TInterfaceArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is TInterfaceArray then
|
|
begin
|
|
FCount := TInterfaceArray(Source).FCount;
|
|
FData := Copy(TInterfaceArray(Source).FData, 0, FCount);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TBitArray }
|
|
{ }
|
|
function Word32IsBitSet(const A: Word32; const B: Integer): Boolean;
|
|
begin
|
|
if (B < 0) or (B > 31) then
|
|
Result := False
|
|
else
|
|
Result := (A and (1 shl B) <> 0);
|
|
end;
|
|
|
|
function Word32SetBitF(const A: Word32; const B: Integer): Word32;
|
|
begin
|
|
if (B < 0) or (B > 31) then
|
|
Result := A
|
|
else
|
|
Result := A or (1 shl B);
|
|
end;
|
|
|
|
function Word32ClearBitF(const A: Word32; const B: Integer): Word32;
|
|
begin
|
|
if (B < 0) or (B > 31) then
|
|
Result := A
|
|
else
|
|
Result := A and not (1 shl B);
|
|
end;
|
|
|
|
function LowBitMask32(const HighBitIndex: Word32): Word32;
|
|
begin
|
|
if HighBitIndex >= 32 then
|
|
Result := 0
|
|
else
|
|
Result := BitMaskTable32[HighBitIndex] - 1;
|
|
end;
|
|
|
|
function HighBitMask32(const LowBitIndex: Word32): Word32;
|
|
begin
|
|
if LowBitIndex >= 32 then
|
|
Result := 0
|
|
else
|
|
Result := not BitMaskTable32[LowBitIndex] + 1;
|
|
end;
|
|
|
|
function RangeBitMask32(const LowBitIndex, HighBitIndex: Word32): Word32;
|
|
begin
|
|
if (LowBitIndex >= 32) and (HighBitIndex >= 32) then
|
|
begin
|
|
Result := 0;
|
|
exit;
|
|
end;
|
|
Result := $FFFFFFFF;
|
|
if LowBitIndex > 0 then
|
|
Result := Result xor (BitMaskTable32[LowBitIndex] - 1);
|
|
if HighBitIndex < 31 then
|
|
Result := Result xor (not BitMaskTable32[HighBitIndex + 1] + 1);
|
|
end;
|
|
|
|
const
|
|
TrueWord32 : Word32 = $FFFFFFFF;
|
|
FalseWord32 : Word32 = $00000000;
|
|
|
|
function TBitArray.GetBit(const Idx: Integer): Boolean;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
Result := Word32IsBitSet(FData[Idx shr 5], Idx and 31);
|
|
end;
|
|
|
|
procedure TBitArray.SetBit(const Idx: Integer; const Value: Boolean);
|
|
var
|
|
L : PWord32;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
L := @FData[Idx shr 5];
|
|
if Value then
|
|
L^ := Word32SetBitF(L^, Idx and 31)
|
|
else
|
|
L^ := Word32ClearBitF(L^, Idx and 31);
|
|
end;
|
|
|
|
function TBitArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
procedure TBitArray.SetCount(const NewCount: Integer);
|
|
begin
|
|
if NewCount = FCount then
|
|
exit;
|
|
SetLengthAndZero(FData, (NewCount + 31) div 32);
|
|
FCount := NewCount;
|
|
end;
|
|
|
|
function TBitArray.GetRangeL(const Idx: Integer): Word32;
|
|
var
|
|
F : Byte;
|
|
I : Integer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
F := Idx and 31;
|
|
I := Idx shr 5;
|
|
if F = 0 then
|
|
Result := FData[I]
|
|
else
|
|
begin
|
|
Result := FData[I] shr F;
|
|
if I + 1 < Length(FData) then
|
|
Result := Result or (FData[I + 1] shl (32 - F));
|
|
end;
|
|
end;
|
|
|
|
procedure TBitArray.SetRangeL(const Idx: Integer; const Value: Word32);
|
|
var
|
|
F : Byte;
|
|
I : Integer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
F := Idx and 31;
|
|
I := Idx shr 5;
|
|
if F = 0 then
|
|
FData[I] := Value
|
|
else
|
|
begin
|
|
FData[I] := (FData[I] and LowBitMask32(F))
|
|
or (Value shl F);
|
|
if I + 1 < Length(FData) then
|
|
FData[I + 1] := (FData[I + 1] and HighBitMask32(F))
|
|
or (Value shr (32 - F));
|
|
end;
|
|
end;
|
|
|
|
function TBitArray.IsRange(const LoIdx, HiIdx: Integer; const Value: Boolean): Boolean;
|
|
var B, I : Word32;
|
|
IL, IH : Integer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (LoIdx < 0) or (LoIdx > HiIdx) or (HiIdx >= FCount) then
|
|
RaiseIndexError(HiIdx);
|
|
{$ENDIF}
|
|
// Check bits in FData[IL]
|
|
IL := LoIdx shr 5;
|
|
IH := HiIdx shr 5;
|
|
B := HighBitMask32(LoIdx and 31);
|
|
I := FData[IL];
|
|
if Value then
|
|
Result := I or B = I
|
|
else
|
|
Result := I and not B = I;
|
|
if not Result or (IL = IH) then
|
|
exit;
|
|
// Check bits in FData[IH]
|
|
B := LowBitMask32(HiIdx and 31);
|
|
I := FData[IH];
|
|
if Value then
|
|
Result := I or B = I
|
|
else
|
|
Result := I and not B = I;
|
|
if not Result or (IH = IL + 1) then
|
|
exit;
|
|
// Check bits in FStore[IL + 1..IR - 1]
|
|
for I := IL + 1 to IH - 1 do
|
|
if (Value and (FData[I] <> TrueWord32)) or
|
|
(not Value and (FData[I] <> FalseWord32)) then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TBitArray.Fill(const LoIdx, HiIdx: Integer; const Value: Boolean);
|
|
var
|
|
B, I : Word32;
|
|
IL, IH : Integer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (LoIdx < 0) or (LoIdx > HiIdx) or (HiIdx >= FCount) then
|
|
RaiseIndexError(HiIdx);
|
|
{$ENDIF}
|
|
IL := LoIdx shr 5;
|
|
IH := HiIdx shr 5;
|
|
// Set bits in FData[IL]
|
|
if IH = IL then
|
|
B := RangeBitMask32(LoIdx and 31, HiIdx and 31) else
|
|
B := HighBitMask32(LoIdx and 31);
|
|
I := FData[IL];
|
|
if Value then
|
|
FData[IL] := I or B
|
|
else
|
|
FData[IL] := I and not B;
|
|
if IH = IL then
|
|
exit;
|
|
// Set bits in FData[IH]
|
|
B := LowBitMask32(HiIdx and 31);
|
|
I := FData[IH];
|
|
if Value then
|
|
FData[IH] := I or B
|
|
else
|
|
FData[IH] := I and not B;
|
|
if IH = IL + 1 then
|
|
exit;
|
|
// Set bits in FData[IL + 1..IR - 1]
|
|
for I := IL + 1 to IH - 1 do
|
|
if Value then
|
|
FData[I] := TrueWord32
|
|
else
|
|
FData[I] := FalseWord32;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Hashed Array helper function }
|
|
{ }
|
|
const
|
|
ArrayAverageHashChainSize = 4;
|
|
|
|
function ArrayRehashSize(const Count: Integer): Integer;
|
|
var L : Integer;
|
|
begin
|
|
L := Count div ArrayAverageHashChainSize; // Number of slots
|
|
if L <= 16 then // Rehash in powers of 16
|
|
Result := 16 else
|
|
if L <= 256 then
|
|
Result := 256 else
|
|
if L <= 4096 then
|
|
Result := 4096 else
|
|
if L <= 65536 then
|
|
Result := 65536 else
|
|
if L <= 1048576 then
|
|
Result := 1048576 else
|
|
if L <= 16777216 then
|
|
Result := 16777216 else
|
|
Result := 268435456;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ THashedAnsiStringArray }
|
|
{ }
|
|
constructor THashedAnsiStringArray.Create(const ACaseSensitive: Boolean);
|
|
begin
|
|
inherited Create(nil);
|
|
FCaseSensitive := ACaseSensitive;
|
|
end;
|
|
|
|
procedure THashedAnsiStringArray.Init;
|
|
begin
|
|
inherited Init;
|
|
FCaseSensitive := True;
|
|
end;
|
|
|
|
procedure THashedAnsiStringArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is THashedAnsiStringArray then
|
|
begin
|
|
// Assign array data
|
|
inherited Assign(Source);
|
|
// Assign hash lookup
|
|
FLookup := Copy(THashedAnsiStringArray(Source).FLookup);
|
|
FCaseSensitive := THashedAnsiStringArray(Source).FCaseSensitive;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure THashedAnsiStringArray.Clear;
|
|
begin
|
|
inherited Clear;
|
|
Rehash;
|
|
end;
|
|
|
|
function THashedAnsiStringArray.LocateItemHash(const Value: AnsiString;
|
|
var LookupList, LookupIdx: Integer): Boolean;
|
|
var I: Integer;
|
|
begin
|
|
// Hash value
|
|
LookupList := HashStrA(Value, 1, -1, FCaseSensitive, Length(FLookup));
|
|
// Locate value in hash lookup
|
|
for I := 0 to Length(FLookup[LookupList]) - 1 do
|
|
if StrEqualA(Value, FData[FLookup[LookupList][I]], FCaseSensitive) then
|
|
begin
|
|
LookupIdx := I;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
// Not found
|
|
LookupIdx := -1;
|
|
Result := False;
|
|
end;
|
|
|
|
procedure THashedAnsiStringArray.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FCount;
|
|
L := ArrayRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FData[I], 1, -1, FCaseSensitive, L)], I);
|
|
end;
|
|
|
|
procedure THashedAnsiStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var L1, L2, I1, I2: Integer;
|
|
begin
|
|
// Swap lookup
|
|
if LocateItemHash(FData[Idx1], L1, I1) and
|
|
LocateItemHash(FData[Idx2], L2, I2) then
|
|
Swap(FLookup[L1][I1], FLookup[L2][I2]);
|
|
// Swap array items
|
|
inherited ExchangeItems(Idx1, Idx2);
|
|
end;
|
|
|
|
procedure THashedAnsiStringArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, L, V : Integer;
|
|
P : PInteger;
|
|
begin
|
|
// Delete lookup
|
|
for I := MaxInt(0, Idx) to MinInt(FCount, Idx + ACount - 1) do
|
|
if LocateItemHash(FData[I], L, V) then
|
|
DynArrayRemove(FLookup[L], V, 1);
|
|
// Delete array
|
|
inherited Delete(Idx, ACount);
|
|
// Reindex
|
|
for I := 0 to Length(FLookup) - 1 do
|
|
for V := 0 to Length(FLookup[I]) - 1 do
|
|
begin
|
|
P := @FLookup[I][V];
|
|
if P^ >= Idx then
|
|
Dec(P^);
|
|
end;
|
|
end;
|
|
|
|
procedure THashedAnsiStringArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
begin
|
|
// Insert array
|
|
inherited Insert(Idx, ACount);
|
|
// Rebuild hash table
|
|
Rehash;
|
|
end;
|
|
|
|
procedure THashedAnsiStringArray.SetData(const AData: AnsiStringArray);
|
|
begin
|
|
inherited SetData(AData);
|
|
Rehash;
|
|
end;
|
|
|
|
procedure THashedAnsiStringArray.SetItem(const Idx: Integer; const Value: AnsiString);
|
|
var S : AnsiString;
|
|
I, J : Integer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
// Remove old hash
|
|
S := FData[Idx];
|
|
if LocateItemHash(S, I, J) then
|
|
DynArrayRemove(FLookup[I], J, 1);
|
|
// Set array value
|
|
FData[Idx] := Value;
|
|
// Add new hash
|
|
DynArrayAppend(FLookup[HashStrA(Value, 1, -1, FCaseSensitive, Length(FLookup))], Idx);
|
|
end;
|
|
|
|
function THashedAnsiStringArray.AppendItem(const Value: AnsiString): Integer;
|
|
var L : Integer;
|
|
begin
|
|
// add to array
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
FData[Result] := Value;
|
|
// add lookup
|
|
L := Length(FLookup);
|
|
DynArrayAppend(FLookup[HashStrA(Value, 1, -1, FCaseSensitive, L)], Result);
|
|
if (Result + 1) div ArrayAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
function THashedAnsiStringArray.PosNext(const Find: AnsiString; const PrevPos: Integer): Integer;
|
|
var I, J, F, L, P : Integer;
|
|
begin
|
|
// locate first
|
|
if not LocateItemHash(Find, I, J) then
|
|
begin
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
if PrevPos < 0 then
|
|
begin
|
|
Result := FLookup[I][J];
|
|
exit;
|
|
end;
|
|
// locate previous
|
|
L := Length(FLookup[I]);
|
|
P := -1;
|
|
for F := J to L - 1 do
|
|
if FLookup[I][F] = PrevPos then
|
|
begin
|
|
P := F;
|
|
break;
|
|
end;
|
|
if P = -1 then
|
|
begin
|
|
Result := 1;
|
|
exit;
|
|
end;
|
|
// locate next
|
|
for F := P + 1 to L - 1 do
|
|
begin
|
|
Result := FLookup[I][F];
|
|
if StrEqualA(Find, FData[Result], FCaseSensitive) then
|
|
// found
|
|
exit;
|
|
end;
|
|
// not found
|
|
Result := 1;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ THashedRawByteStringArray }
|
|
{ }
|
|
constructor THashedRawByteStringArray.Create(const ACaseSensitive: Boolean);
|
|
begin
|
|
inherited Create(nil);
|
|
FCaseSensitive := ACaseSensitive;
|
|
end;
|
|
|
|
procedure THashedRawByteStringArray.Init;
|
|
begin
|
|
inherited Init;
|
|
FCaseSensitive := True;
|
|
end;
|
|
|
|
procedure THashedRawByteStringArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is THashedRawByteStringArray then
|
|
begin
|
|
// Assign array data
|
|
inherited Assign(Source);
|
|
// Assign hash lookup
|
|
FLookup := Copy(THashedRawByteStringArray(Source).FLookup);
|
|
FCaseSensitive := THashedRawByteStringArray(Source).FCaseSensitive;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure THashedRawByteStringArray.Clear;
|
|
begin
|
|
inherited Clear;
|
|
Rehash;
|
|
end;
|
|
|
|
function THashedRawByteStringArray.LocateItemHash(const Value: RawByteString;
|
|
var LookupList, LookupIdx: Integer): Boolean;
|
|
var I: Integer;
|
|
begin
|
|
// Hash value
|
|
LookupList := HashStrB(Value, 1, -1, FCaseSensitive, Length(FLookup));
|
|
// Locate value in hash lookup
|
|
for I := 0 to Length(FLookup[LookupList]) - 1 do
|
|
if StrEqualB(Value, FData[FLookup[LookupList][I]], FCaseSensitive) then
|
|
begin
|
|
LookupIdx := I;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
// Not found
|
|
LookupIdx := -1;
|
|
Result := False;
|
|
end;
|
|
|
|
procedure THashedRawByteStringArray.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FCount;
|
|
L := ArrayRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrB(FData[I], 1, -1, FCaseSensitive, L)], I);
|
|
end;
|
|
|
|
procedure THashedRawByteStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var L1, L2, I1, I2: Integer;
|
|
begin
|
|
// Swap lookup
|
|
if LocateItemHash(FData[Idx1], L1, I1) and
|
|
LocateItemHash(FData[Idx2], L2, I2) then
|
|
SwapInt(FLookup[L1][I1], FLookup[L2][I2]);
|
|
// Swap array items
|
|
inherited ExchangeItems(Idx1, Idx2);
|
|
end;
|
|
|
|
procedure THashedRawByteStringArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, L, V : Integer;
|
|
P : PInteger;
|
|
begin
|
|
// Delete lookup
|
|
for I := MaxInt(0, Idx) to MinInt(FCount, Idx + ACount - 1) do
|
|
if LocateItemHash(FData[I], L, V) then
|
|
DynArrayRemove(FLookup[L], V, 1);
|
|
// Delete array
|
|
inherited Delete(Idx, ACount);
|
|
// Reindex
|
|
for I := 0 to Length(FLookup) - 1 do
|
|
for V := 0 to Length(FLookup[I]) - 1 do
|
|
begin
|
|
P := @FLookup[I][V];
|
|
if P^ >= Idx then
|
|
Dec(P^);
|
|
end;
|
|
end;
|
|
|
|
procedure THashedRawByteStringArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
begin
|
|
// Insert array
|
|
inherited Insert(Idx, ACount);
|
|
// Rebuild hash table
|
|
Rehash;
|
|
end;
|
|
|
|
procedure THashedRawByteStringArray.SetData(const AData: RawByteStringArray);
|
|
begin
|
|
inherited SetData(AData);
|
|
Rehash;
|
|
end;
|
|
|
|
procedure THashedRawByteStringArray.SetItem(const Idx: Integer; const Value: RawByteString);
|
|
var S : RawByteString;
|
|
I, J : Integer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
// Remove old hash
|
|
S := FData[Idx];
|
|
if LocateItemHash(S, I, J) then
|
|
DynArrayRemove(FLookup[I], J, 1);
|
|
// Set array value
|
|
FData[Idx] := Value;
|
|
// Add new hash
|
|
DynArrayAppend(FLookup[HashStrB(Value, 1, -1, FCaseSensitive, Length(FLookup))], Idx);
|
|
end;
|
|
|
|
function THashedRawByteStringArray.AppendItem(const Value: RawByteString): Integer;
|
|
var L : Integer;
|
|
begin
|
|
// add to array
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
FData[Result] := Value;
|
|
// add lookup
|
|
L := Length(FLookup);
|
|
DynArrayAppend(FLookup[HashStrB(Value, 1, -1, FCaseSensitive, L)], Result);
|
|
if (Result + 1) div ArrayAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
function THashedRawByteStringArray.PosNext(const Find: RawByteString; const PrevPos: Integer): Integer;
|
|
var I, J, F, L, P : Integer;
|
|
begin
|
|
// locate first
|
|
if not LocateItemHash(Find, I, J) then
|
|
begin
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
if PrevPos < 0 then
|
|
begin
|
|
Result := FLookup[I][J];
|
|
exit;
|
|
end;
|
|
// locate previous
|
|
L := Length(FLookup[I]);
|
|
P := -1;
|
|
for F := J to L - 1 do
|
|
if FLookup[I][F] = PrevPos then
|
|
begin
|
|
P := F;
|
|
break;
|
|
end;
|
|
if P = -1 then
|
|
begin
|
|
Result := 1;
|
|
exit;
|
|
end;
|
|
// locate next
|
|
for F := P + 1 to L - 1 do
|
|
begin
|
|
Result := FLookup[I][F];
|
|
if StrEqualB(Find, FData[Result], FCaseSensitive) then
|
|
// found
|
|
exit;
|
|
end;
|
|
// not found
|
|
Result := 1;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ THashedUnicodeStringArray }
|
|
{ }
|
|
constructor THashedUnicodeStringArray.Create(const ACaseSensitive: Boolean);
|
|
begin
|
|
inherited Create(nil);
|
|
FCaseSensitive := ACaseSensitive;
|
|
end;
|
|
|
|
procedure THashedUnicodeStringArray.Init;
|
|
begin
|
|
inherited Init;
|
|
FCaseSensitive := True;
|
|
end;
|
|
|
|
procedure THashedUnicodeStringArray.Assign(const Source: TObject);
|
|
begin
|
|
if Source is THashedUnicodeStringArray then
|
|
begin
|
|
// Assign array data
|
|
inherited Assign(Source);
|
|
// Assign hash lookup
|
|
FLookup := Copy(THashedUnicodeStringArray(Source).FLookup);
|
|
FCaseSensitive := THashedUnicodeStringArray(Source).FCaseSensitive;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure THashedUnicodeStringArray.Clear;
|
|
begin
|
|
inherited Clear;
|
|
Rehash;
|
|
end;
|
|
|
|
function THashedUnicodeStringArray.LocateItemHash(const Value: UnicodeString;
|
|
var LookupList, LookupIdx: Integer): Boolean;
|
|
var I: Integer;
|
|
begin
|
|
// Hash value
|
|
LookupList := HashStrU(Value, 1, -1, FCaseSensitive, Length(FLookup));
|
|
// Locate value in hash lookup
|
|
for I := 0 to Length(FLookup[LookupList]) - 1 do
|
|
if StrEqualU(Value, FData[FLookup[LookupList][I]], FCaseSensitive) then
|
|
begin
|
|
LookupIdx := I;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
// Not found
|
|
LookupIdx := -1;
|
|
Result := False;
|
|
end;
|
|
|
|
procedure THashedUnicodeStringArray.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FCount;
|
|
L := ArrayRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FData[I], 1, -1, FCaseSensitive, L)], I);
|
|
end;
|
|
|
|
procedure THashedUnicodeStringArray.ExchangeItems(const Idx1, Idx2: Integer);
|
|
var L1, L2, I1, I2: Integer;
|
|
begin
|
|
// Swap lookup
|
|
if LocateItemHash(FData[Idx1], L1, I1) and
|
|
LocateItemHash(FData[Idx2], L2, I2) then
|
|
SwapInt(FLookup[L1][I1], FLookup[L2][I2]);
|
|
// Swap array items
|
|
inherited ExchangeItems(Idx1, Idx2);
|
|
end;
|
|
|
|
procedure THashedUnicodeStringArray.Delete(const Idx: Integer; const ACount: Integer);
|
|
var I, L, V : Integer;
|
|
P : PInteger;
|
|
begin
|
|
// Delete lookup
|
|
for I := MaxInt(0, Idx) to MinInt(FCount, Idx + ACount - 1) do
|
|
if LocateItemHash(FData[I], L, V) then
|
|
DynArrayRemove(FLookup[L], V, 1);
|
|
// Delete array
|
|
inherited Delete(Idx, ACount);
|
|
// Reindex
|
|
for I := 0 to Length(FLookup) - 1 do
|
|
for V := 0 to Length(FLookup[I]) - 1 do
|
|
begin
|
|
P := @FLookup[I][V];
|
|
if P^ >= Idx then
|
|
Dec(P^);
|
|
end;
|
|
end;
|
|
|
|
procedure THashedUnicodeStringArray.Insert(const Idx: Integer; const ACount: Integer);
|
|
begin
|
|
// Insert array
|
|
inherited Insert(Idx, ACount);
|
|
// Rebuild hash table
|
|
Rehash;
|
|
end;
|
|
|
|
procedure THashedUnicodeStringArray.SetData(const AData: UnicodeStringArray);
|
|
begin
|
|
inherited SetData(AData);
|
|
Rehash;
|
|
end;
|
|
|
|
procedure THashedUnicodeStringArray.SetItem(const Idx: Integer; const Value: UnicodeString);
|
|
var S : UnicodeString;
|
|
I, J : Integer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FCount) then
|
|
RaiseIndexError(Idx);
|
|
{$ENDIF}
|
|
// Remove old hash
|
|
S := FData[Idx];
|
|
if LocateItemHash(S, I, J) then
|
|
DynArrayRemove(FLookup[I], J, 1);
|
|
// Set array value
|
|
FData[Idx] := Value;
|
|
// Add new hash
|
|
DynArrayAppend(FLookup[HashStrU(Value, 1, -1, FCaseSensitive, Length(FLookup))], Idx);
|
|
end;
|
|
|
|
function THashedUnicodeStringArray.AppendItem(const Value: UnicodeString): Integer;
|
|
var L : Integer;
|
|
begin
|
|
// add to array
|
|
Result := Count;
|
|
Count := Result + 1;
|
|
FData[Result] := Value;
|
|
// add lookup
|
|
L := Length(FLookup);
|
|
DynArrayAppend(FLookup[HashStrU(Value, 1, -1, FCaseSensitive, L)], Result);
|
|
if (Result + 1) div ArrayAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
function THashedUnicodeStringArray.PosNext(const Find: UnicodeString; const PrevPos: Integer): Integer;
|
|
var I, J, F, L, P : Integer;
|
|
begin
|
|
// locate first
|
|
if not LocateItemHash(Find, I, J) then
|
|
begin
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
if PrevPos < 0 then
|
|
begin
|
|
Result := FLookup[I][J];
|
|
exit;
|
|
end;
|
|
// locate previous
|
|
L := Length(FLookup[I]);
|
|
P := -1;
|
|
for F := J to L - 1 do
|
|
if FLookup[I][F] = PrevPos then
|
|
begin
|
|
P := F;
|
|
break;
|
|
end;
|
|
if P = -1 then
|
|
begin
|
|
Result := 1;
|
|
exit;
|
|
end;
|
|
// locate next
|
|
for F := P + 1 to L - 1 do
|
|
begin
|
|
Result := FLookup[I][F];
|
|
if StrEqualU(Find, FData[Result], FCaseSensitive) then
|
|
// found
|
|
exit;
|
|
end;
|
|
// not found
|
|
Result := 1;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ DICTIONARY BASE CLASSES }
|
|
{ }
|
|
|
|
|
|
|
|
{ }
|
|
{ ADictionaryBase }
|
|
{ }
|
|
function ADictionaryBase.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
raise EDictionary.CreateFmt('Method %s.GetItemStrByIndex not implemented', [ClassName]);
|
|
end;
|
|
|
|
function ADictionaryBase.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ADictionaryA }
|
|
{ }
|
|
procedure ADictionaryA.RaiseKeyNotFoundError(const Key: AnsiString);
|
|
begin
|
|
raise EDictionary.CreateFmt('Key not found: %s', [Key]);
|
|
end;
|
|
|
|
procedure ADictionaryA.RaiseDuplicateKeyError(const Key: AnsiString);
|
|
begin
|
|
raise EDictionary.CreateFmt('Duplicate key: %s', [Key]);
|
|
end;
|
|
|
|
function ADictionaryA.GetKeyStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringA(GetKeyByIndex(Idx));
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ ADictionaryB }
|
|
{ }
|
|
procedure ADictionaryB.RaiseKeyNotFoundError(const Key: RawByteString);
|
|
begin
|
|
raise EDictionary.CreateFmt('Key not found: %s', [Key]);
|
|
end;
|
|
|
|
procedure ADictionaryB.RaiseDuplicateKeyError(const Key: RawByteString);
|
|
begin
|
|
raise EDictionary.CreateFmt('Duplicate key: %s', [Key]);
|
|
end;
|
|
|
|
function ADictionaryB.GetKeyStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringB(GetKeyByIndex(Idx));
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ADictionaryU }
|
|
{ }
|
|
procedure ADictionaryU.RaiseKeyNotFoundError(const Key: UnicodeString);
|
|
begin
|
|
raise EDictionary.CreateFmt('Key not found: %s', [Key]);
|
|
end;
|
|
|
|
procedure ADictionaryU.RaiseDuplicateKeyError(const Key: UnicodeString);
|
|
begin
|
|
raise EDictionary.CreateFmt('Duplicate key: %s', [Key]);
|
|
end;
|
|
|
|
function ADictionaryU.GetKeyStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringU(GetKeyByIndex(Idx));
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ADictionary }
|
|
{ }
|
|
procedure ADictionary.RaiseKeyNotFoundError(const Key: String);
|
|
begin
|
|
raise EDictionary.CreateFmt('Key not found: %s', [Key]);
|
|
end;
|
|
|
|
procedure ADictionary.RaiseDuplicateKeyError(const Key: String);
|
|
begin
|
|
raise EDictionary.CreateFmt('Duplicate key: %s', [Key]);
|
|
end;
|
|
|
|
function ADictionary.GetKeyStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := GetKeyByIndex(Idx);
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ALongIntDictionaryA }
|
|
{ }
|
|
function ALongIntDictionaryA.GetItem(const Key: AnsiString): LongInt;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ALongIntDictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ALongIntDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ALongIntDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ALongIntDictionaryA(Source).Count - 1 do
|
|
Add(ALongIntDictionaryA(Source).GetKeyByIndex(I),
|
|
ALongIntDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ALongIntDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ALongIntDictionaryB }
|
|
{ }
|
|
function ALongIntDictionaryB.GetItem(const Key: RawByteString): LongInt;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ALongIntDictionaryB.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ALongIntDictionaryB.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ALongIntDictionaryB then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ALongIntDictionaryB(Source).Count - 1 do
|
|
Add(ALongIntDictionaryB(Source).GetKeyByIndex(I),
|
|
ALongIntDictionaryB(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ALongIntDictionaryB.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ALongIntDictionaryU }
|
|
{ }
|
|
function ALongIntDictionaryU.GetItem(const Key: UnicodeString): LongInt;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ALongIntDictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ALongIntDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ALongIntDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ALongIntDictionaryU(Source).Count - 1 do
|
|
Add(ALongIntDictionaryU(Source).GetKeyByIndex(I),
|
|
ALongIntDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ALongIntDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ALongIntDictionary }
|
|
{ }
|
|
function ALongIntDictionary.GetItem(const Key: String): LongInt;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ALongIntDictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ALongIntDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ALongIntDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ALongIntDictionary(Source).Count - 1 do
|
|
Add(ALongIntDictionary(Source).GetKeyByIndex(I),
|
|
ALongIntDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ALongIntDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ALongWordDictionaryA }
|
|
{ }
|
|
function ALongWordDictionaryA.GetItem(const Key: AnsiString): LongWord;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ALongWordDictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ALongWordDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ALongWordDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ALongWordDictionaryA(Source).Count - 1 do
|
|
Add(ALongWordDictionaryA(Source).GetKeyByIndex(I),
|
|
ALongWordDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ALongWordDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ALongWordDictionaryB }
|
|
{ }
|
|
function ALongWordDictionaryB.GetItem(const Key: RawByteString): LongWord;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ALongWordDictionaryB.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ALongWordDictionaryB.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ALongWordDictionaryB then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ALongWordDictionaryB(Source).Count - 1 do
|
|
Add(ALongWordDictionaryB(Source).GetKeyByIndex(I),
|
|
ALongWordDictionaryB(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ALongWordDictionaryB.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ALongWordDictionaryU }
|
|
{ }
|
|
function ALongWordDictionaryU.GetItem(const Key: UnicodeString): LongWord;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ALongWordDictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ALongWordDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ALongWordDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ALongWordDictionaryU(Source).Count - 1 do
|
|
Add(ALongWordDictionaryU(Source).GetKeyByIndex(I),
|
|
ALongWordDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ALongWordDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ALongWordDictionary }
|
|
{ }
|
|
function ALongWordDictionary.GetItem(const Key: String): LongWord;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ALongWordDictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ALongWordDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ALongWordDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ALongWordDictionary(Source).Count - 1 do
|
|
Add(ALongWordDictionary(Source).GetKeyByIndex(I),
|
|
ALongWordDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ALongWordDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AInt64DictionaryA }
|
|
{ }
|
|
function AInt64DictionaryA.GetItem(const Key: AnsiString): Int64;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AInt64DictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AInt64DictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AInt64DictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AInt64DictionaryA(Source).Count - 1 do
|
|
Add(AInt64DictionaryA(Source).GetKeyByIndex(I),
|
|
AInt64DictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AInt64DictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AInt64DictionaryB }
|
|
{ }
|
|
function AInt64DictionaryB.GetItem(const Key: RawByteString): Int64;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AInt64DictionaryB.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AInt64DictionaryB.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AInt64DictionaryB then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AInt64DictionaryB(Source).Count - 1 do
|
|
Add(AInt64DictionaryB(Source).GetKeyByIndex(I),
|
|
AInt64DictionaryB(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AInt64DictionaryB.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AInt64DictionaryU }
|
|
{ }
|
|
function AInt64DictionaryU.GetItem(const Key: UnicodeString): Int64;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AInt64DictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AInt64DictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AInt64DictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AInt64DictionaryU(Source).Count - 1 do
|
|
Add(AInt64DictionaryU(Source).GetKeyByIndex(I),
|
|
AInt64DictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AInt64DictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AInt64Dictionary }
|
|
{ }
|
|
function AInt64Dictionary.GetItem(const Key: String): Int64;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AInt64Dictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := IntToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AInt64Dictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AInt64Dictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AInt64Dictionary(Source).Count - 1 do
|
|
Add(AInt64Dictionary(Source).GetKeyByIndex(I),
|
|
AInt64Dictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AInt64Dictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ASingleDictionaryA }
|
|
{ }
|
|
function ASingleDictionaryA.GetItem(const Key: AnsiString): Single;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ASingleDictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ASingleDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ASingleDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ASingleDictionaryA(Source).Count - 1 do
|
|
Add(ASingleDictionaryA(Source).GetKeyByIndex(I),
|
|
ASingleDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ASingleDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ASingleDictionaryB }
|
|
{ }
|
|
function ASingleDictionaryB.GetItem(const Key: RawByteString): Single;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ASingleDictionaryB.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ASingleDictionaryB.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ASingleDictionaryB then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ASingleDictionaryB(Source).Count - 1 do
|
|
Add(ASingleDictionaryB(Source).GetKeyByIndex(I),
|
|
ASingleDictionaryB(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ASingleDictionaryB.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ASingleDictionaryU }
|
|
{ }
|
|
function ASingleDictionaryU.GetItem(const Key: UnicodeString): Single;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ASingleDictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ASingleDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ASingleDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ASingleDictionaryU(Source).Count - 1 do
|
|
Add(ASingleDictionaryU(Source).GetKeyByIndex(I),
|
|
ASingleDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ASingleDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ASingleDictionary }
|
|
{ }
|
|
function ASingleDictionary.GetItem(const Key: String): Single;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ASingleDictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ASingleDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ASingleDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ASingleDictionary(Source).Count - 1 do
|
|
Add(ASingleDictionary(Source).GetKeyByIndex(I),
|
|
ASingleDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ASingleDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ADoubleDictionaryA }
|
|
{ }
|
|
function ADoubleDictionaryA.GetItem(const Key: AnsiString): Double;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ADoubleDictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ADoubleDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ADoubleDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ADoubleDictionaryA(Source).Count - 1 do
|
|
Add(ADoubleDictionaryA(Source).GetKeyByIndex(I),
|
|
ADoubleDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ADoubleDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ADoubleDictionaryB }
|
|
{ }
|
|
function ADoubleDictionaryB.GetItem(const Key: RawByteString): Double;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ADoubleDictionaryB.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ADoubleDictionaryB.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ADoubleDictionaryB then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ADoubleDictionaryB(Source).Count - 1 do
|
|
Add(ADoubleDictionaryB(Source).GetKeyByIndex(I),
|
|
ADoubleDictionaryB(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ADoubleDictionaryB.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ADoubleDictionaryU }
|
|
{ }
|
|
function ADoubleDictionaryU.GetItem(const Key: UnicodeString): Double;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ADoubleDictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ADoubleDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ADoubleDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ADoubleDictionaryU(Source).Count - 1 do
|
|
Add(ADoubleDictionaryU(Source).GetKeyByIndex(I),
|
|
ADoubleDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ADoubleDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ADoubleDictionary }
|
|
{ }
|
|
function ADoubleDictionary.GetItem(const Key: String): Double;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ADoubleDictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ADoubleDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ADoubleDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ADoubleDictionary(Source).Count - 1 do
|
|
Add(ADoubleDictionary(Source).GetKeyByIndex(I),
|
|
ADoubleDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ADoubleDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AExtendedDictionaryA }
|
|
{ }
|
|
function AExtendedDictionaryA.GetItem(const Key: AnsiString): Extended;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AExtendedDictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AExtendedDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AExtendedDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AExtendedDictionaryA(Source).Count - 1 do
|
|
Add(AExtendedDictionaryA(Source).GetKeyByIndex(I),
|
|
AExtendedDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AExtendedDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AExtendedDictionaryB }
|
|
{ }
|
|
function AExtendedDictionaryB.GetItem(const Key: RawByteString): Extended;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AExtendedDictionaryB.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AExtendedDictionaryB.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AExtendedDictionaryB then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AExtendedDictionaryB(Source).Count - 1 do
|
|
Add(AExtendedDictionaryB(Source).GetKeyByIndex(I),
|
|
AExtendedDictionaryB(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AExtendedDictionaryB.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AExtendedDictionaryU }
|
|
{ }
|
|
function AExtendedDictionaryU.GetItem(const Key: UnicodeString): Extended;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AExtendedDictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AExtendedDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AExtendedDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AExtendedDictionaryU(Source).Count - 1 do
|
|
Add(AExtendedDictionaryU(Source).GetKeyByIndex(I),
|
|
AExtendedDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AExtendedDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AExtendedDictionary }
|
|
{ }
|
|
function AExtendedDictionary.GetItem(const Key: String): Extended;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AExtendedDictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := FloatToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AExtendedDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AExtendedDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AExtendedDictionary(Source).Count - 1 do
|
|
Add(AExtendedDictionary(Source).GetKeyByIndex(I),
|
|
AExtendedDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AExtendedDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AAnsiStringDictionaryA }
|
|
{ }
|
|
function AAnsiStringDictionaryA.GetItem(const Key: AnsiString): AnsiString;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AAnsiStringDictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringA(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AAnsiStringDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AAnsiStringDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AAnsiStringDictionaryA(Source).Count - 1 do
|
|
Add(AAnsiStringDictionaryA(Source).GetKeyByIndex(I),
|
|
AAnsiStringDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AAnsiStringDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function AAnsiStringDictionaryA.GetItemLength(const Key: AnsiString): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function AAnsiStringDictionaryA.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AAnsiStringDictionaryU }
|
|
{ }
|
|
function AAnsiStringDictionaryU.GetItem(const Key: UnicodeString): AnsiString;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AAnsiStringDictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringA(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AAnsiStringDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AAnsiStringDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AAnsiStringDictionaryU(Source).Count - 1 do
|
|
Add(AAnsiStringDictionaryU(Source).GetKeyByIndex(I),
|
|
AAnsiStringDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AAnsiStringDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function AAnsiStringDictionaryU.GetItemLength(const Key: UnicodeString): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function AAnsiStringDictionaryU.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AAnsiStringDictionary }
|
|
{ }
|
|
function AAnsiStringDictionary.GetItem(const Key: String): AnsiString;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AAnsiStringDictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringA(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AAnsiStringDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AAnsiStringDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AAnsiStringDictionary(Source).Count - 1 do
|
|
Add(AAnsiStringDictionary(Source).GetKeyByIndex(I),
|
|
AAnsiStringDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AAnsiStringDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function AAnsiStringDictionary.GetItemLength(const Key: String): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function AAnsiStringDictionary.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ ARawByteStringDictionaryA }
|
|
{ }
|
|
function ARawByteStringDictionaryA.GetItem(const Key: AnsiString): RawByteString;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ARawByteStringDictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringB(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ARawByteStringDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ARawByteStringDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ARawByteStringDictionaryA(Source).Count - 1 do
|
|
Add(ARawByteStringDictionaryA(Source).GetKeyByIndex(I),
|
|
ARawByteStringDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ARawByteStringDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function ARawByteStringDictionaryA.GetItemLength(const Key: AnsiString): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function ARawByteStringDictionaryA.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ ARawByteStringDictionaryB }
|
|
{ }
|
|
function ARawByteStringDictionaryB.GetItem(const Key: RawByteString): RawByteString;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ARawByteStringDictionaryB.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringB(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ARawByteStringDictionaryB.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ARawByteStringDictionaryB then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ARawByteStringDictionaryB(Source).Count - 1 do
|
|
Add(ARawByteStringDictionaryB(Source).GetKeyByIndex(I),
|
|
ARawByteStringDictionaryB(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ARawByteStringDictionaryB.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function ARawByteStringDictionaryB.GetItemLength(const Key: RawByteString): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function ARawByteStringDictionaryB.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ARawByteStringDictionaryU }
|
|
{ }
|
|
function ARawByteStringDictionaryU.GetItem(const Key: UnicodeString): RawByteString;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ARawByteStringDictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringB(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ARawByteStringDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ARawByteStringDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ARawByteStringDictionaryU(Source).Count - 1 do
|
|
Add(ARawByteStringDictionaryU(Source).GetKeyByIndex(I),
|
|
ARawByteStringDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ARawByteStringDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function ARawByteStringDictionaryU.GetItemLength(const Key: UnicodeString): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function ARawByteStringDictionaryU.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ARawByteStringDictionary }
|
|
{ }
|
|
function ARawByteStringDictionary.GetItem(const Key: String): RawByteString;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function ARawByteStringDictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringB(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure ARawByteStringDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is ARawByteStringDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to ARawByteStringDictionary(Source).Count - 1 do
|
|
Add(ARawByteStringDictionary(Source).GetKeyByIndex(I),
|
|
ARawByteStringDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function ARawByteStringDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function ARawByteStringDictionary.GetItemLength(const Key: String): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function ARawByteStringDictionary.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AUnicodeStringDictionaryA }
|
|
{ }
|
|
function AUnicodeStringDictionaryA.GetItem(const Key: AnsiString): UnicodeString;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AUnicodeStringDictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringU(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AUnicodeStringDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AUnicodeStringDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AUnicodeStringDictionaryA(Source).Count - 1 do
|
|
Add(AUnicodeStringDictionaryA(Source).GetKeyByIndex(I),
|
|
AUnicodeStringDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AUnicodeStringDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function AUnicodeStringDictionaryA.GetItemLength(const Key: AnsiString): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function AUnicodeStringDictionaryA.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AUnicodeStringDictionaryU }
|
|
{ }
|
|
function AUnicodeStringDictionaryU.GetItem(const Key: UnicodeString): UnicodeString;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AUnicodeStringDictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringU(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AUnicodeStringDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AUnicodeStringDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AUnicodeStringDictionaryU(Source).Count - 1 do
|
|
Add(AUnicodeStringDictionaryU(Source).GetKeyByIndex(I),
|
|
AUnicodeStringDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AUnicodeStringDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function AUnicodeStringDictionaryU.GetItemLength(const Key: UnicodeString): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function AUnicodeStringDictionaryU.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AUnicodeStringDictionary }
|
|
{ }
|
|
function AUnicodeStringDictionary.GetItem(const Key: String): UnicodeString;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AUnicodeStringDictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ToStringU(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AUnicodeStringDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AUnicodeStringDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AUnicodeStringDictionary(Source).Count - 1 do
|
|
Add(AUnicodeStringDictionary(Source).GetKeyByIndex(I),
|
|
AUnicodeStringDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AUnicodeStringDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function AUnicodeStringDictionary.GetItemLength(const Key: String): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function AUnicodeStringDictionary.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AStringDictionaryA }
|
|
{ }
|
|
function AStringDictionaryA.GetItem(const Key: AnsiString): String;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure AStringDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AStringDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AStringDictionaryA(Source).Count - 1 do
|
|
Add(AStringDictionaryA(Source).GetKeyByIndex(I),
|
|
AStringDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AStringDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function AStringDictionaryA.GetItemLength(const Key: AnsiString): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function AStringDictionaryA.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AStringDictionaryU }
|
|
{ }
|
|
function AStringDictionaryU.GetItem(const Key: UnicodeString): String;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure AStringDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AStringDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AStringDictionaryU(Source).Count - 1 do
|
|
Add(AStringDictionaryU(Source).GetKeyByIndex(I),
|
|
AStringDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AStringDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function AStringDictionaryU.GetItemLength(const Key: UnicodeString): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function AStringDictionaryU.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AStringDictionary }
|
|
{ }
|
|
function AStringDictionary.GetItem(const Key: String): String;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure AStringDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AStringDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AStringDictionary(Source).Count - 1 do
|
|
Add(AStringDictionary(Source).GetKeyByIndex(I),
|
|
AStringDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AStringDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
function AStringDictionary.GetItemLength(const Key: String): Integer;
|
|
begin
|
|
Result := Length(GetItem(Key));
|
|
end;
|
|
|
|
function AStringDictionary.GetTotalLength: Int64;
|
|
var I : Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 0 to Count - 1 do
|
|
Inc(Result, Length(GetItemByIndex(I)));
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ APointerDictionaryA }
|
|
{ }
|
|
function APointerDictionaryA.GetItem(const Key: AnsiString): Pointer;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function APointerDictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := PointerToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure APointerDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is APointerDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to APointerDictionaryA(Source).Count - 1 do
|
|
Add(APointerDictionaryA(Source).GetKeyByIndex(I),
|
|
APointerDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function APointerDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ APointerDictionaryB }
|
|
{ }
|
|
function APointerDictionaryB.GetItem(const Key: RawByteString): Pointer;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function APointerDictionaryB.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := PointerToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure APointerDictionaryB.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is APointerDictionaryB then
|
|
begin
|
|
Clear;
|
|
for I := 0 to APointerDictionaryB(Source).Count - 1 do
|
|
Add(APointerDictionaryB(Source).GetKeyByIndex(I),
|
|
APointerDictionaryB(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function APointerDictionaryB.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ APointerDictionaryU }
|
|
{ }
|
|
function APointerDictionaryU.GetItem(const Key: UnicodeString): Pointer;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function APointerDictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := PointerToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure APointerDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is APointerDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to APointerDictionaryU(Source).Count - 1 do
|
|
Add(APointerDictionaryU(Source).GetKeyByIndex(I),
|
|
APointerDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function APointerDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ APointerDictionary }
|
|
{ }
|
|
function APointerDictionary.GetItem(const Key: String): Pointer;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function APointerDictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := PointerToStr(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure APointerDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is APointerDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to APointerDictionary(Source).Count - 1 do
|
|
Add(APointerDictionary(Source).GetKeyByIndex(I),
|
|
APointerDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function APointerDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AInterfaceDictionaryA }
|
|
{ }
|
|
function AInterfaceDictionaryA.GetItem(const Key: AnsiString): IInterface;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure AInterfaceDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AInterfaceDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AInterfaceDictionaryA(Source).Count - 1 do
|
|
Add(AInterfaceDictionaryA(Source).GetKeyByIndex(I),
|
|
AInterfaceDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AInterfaceDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AInterfaceDictionaryU }
|
|
{ }
|
|
function AInterfaceDictionaryU.GetItem(const Key: UnicodeString): IInterface;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure AInterfaceDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AInterfaceDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AInterfaceDictionaryU(Source).Count - 1 do
|
|
Add(AInterfaceDictionaryU(Source).GetKeyByIndex(I),
|
|
AInterfaceDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AInterfaceDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AInterfaceDictionary }
|
|
{ }
|
|
function AInterfaceDictionary.GetItem(const Key: String): IInterface;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure AInterfaceDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AInterfaceDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AInterfaceDictionary(Source).Count - 1 do
|
|
Add(AInterfaceDictionary(Source).GetKeyByIndex(I),
|
|
AInterfaceDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AInterfaceDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ AObjectDictionaryA }
|
|
{ }
|
|
function AObjectDictionaryA.GetItem(const Key: AnsiString): TObject;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AObjectDictionaryA.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ObjectClassName(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AObjectDictionaryA.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AObjectDictionaryA then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AObjectDictionaryA(Source).Count - 1 do
|
|
Add(AObjectDictionaryA(Source).GetKeyByIndex(I),
|
|
AObjectDictionaryA(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AObjectDictionaryA.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
procedure AObjectDictionaryA.Clear;
|
|
begin
|
|
if IsItemOwner then
|
|
FreeItems else
|
|
ReleaseItems;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ AObjectDictionaryB }
|
|
{ }
|
|
function AObjectDictionaryB.GetItem(const Key: RawByteString): TObject;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AObjectDictionaryB.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ObjectClassName(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AObjectDictionaryB.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AObjectDictionaryB then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AObjectDictionaryB(Source).Count - 1 do
|
|
Add(AObjectDictionaryB(Source).GetKeyByIndex(I),
|
|
AObjectDictionaryB(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AObjectDictionaryB.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
procedure AObjectDictionaryB.Clear;
|
|
begin
|
|
if IsItemOwner then
|
|
FreeItems else
|
|
ReleaseItems;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AObjectDictionaryU }
|
|
{ }
|
|
function AObjectDictionaryU.GetItem(const Key: UnicodeString): TObject;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AObjectDictionaryU.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ObjectClassName(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AObjectDictionaryU.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AObjectDictionaryU then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AObjectDictionaryU(Source).Count - 1 do
|
|
Add(AObjectDictionaryU(Source).GetKeyByIndex(I),
|
|
AObjectDictionaryU(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AObjectDictionaryU.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
procedure AObjectDictionaryU.Clear;
|
|
begin
|
|
if IsItemOwner then
|
|
FreeItems else
|
|
ReleaseItems;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ AObjectDictionary }
|
|
{ }
|
|
function AObjectDictionary.GetItem(const Key: String): TObject;
|
|
begin
|
|
if LocateItem(Key, Result) < 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
function AObjectDictionary.GetItemStrByIndex(const Idx: Integer): String;
|
|
begin
|
|
Result := ObjectClassName(GetItemByIndex(Idx));
|
|
end;
|
|
|
|
procedure AObjectDictionary.Assign(const Source: TObject);
|
|
var I : Integer;
|
|
begin
|
|
if Source is AObjectDictionary then
|
|
begin
|
|
Clear;
|
|
for I := 0 to AObjectDictionary(Source).Count - 1 do
|
|
Add(AObjectDictionary(Source).GetKeyByIndex(I),
|
|
AObjectDictionary(Source).GetItemByIndex(I));
|
|
end else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
function AObjectDictionary.GetAsString: String;
|
|
var I, L : Integer;
|
|
begin
|
|
L := Count - 1;
|
|
for I := 0 to L do
|
|
begin
|
|
Result := Result + GetKeyStrByIndex(I) + ':' + GetItemStrByIndex(I);
|
|
if I < L then
|
|
Result := Result + ',';
|
|
end;
|
|
end;
|
|
|
|
procedure AObjectDictionary.Clear;
|
|
begin
|
|
if IsItemOwner then
|
|
FreeItems else
|
|
ReleaseItems;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ DICTIONARY IMPLEMENTATIONS }
|
|
{ }
|
|
|
|
|
|
|
|
{ Dictionary helper functions }
|
|
function DictionaryRehashSize(const Count: Integer): Integer;
|
|
var L : Integer;
|
|
begin
|
|
L := Count div DictionaryAverageHashChainSize; // Number of "slots"
|
|
if L <= $10 then // Rehash in powers of 16
|
|
Result := $10 else
|
|
if L <= $100 then
|
|
Result := $100 else
|
|
if L <= $1000 then
|
|
Result := $1000 else
|
|
if L <= $10000 then
|
|
Result := $10000 else
|
|
if L <= $100000 then
|
|
Result := $100000 else
|
|
if L <= $1000000 then
|
|
Result := $1000000 else
|
|
Result := $10000000;
|
|
end;
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralLongIntDictionaryA }
|
|
{ }
|
|
constructor TGeneralLongIntDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TLongIntArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralLongIntDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TLongIntArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TLongIntArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TLongIntDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TLongIntArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralLongIntDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.Add(const Key: AnsiString; const Value: LongInt);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.LocateItem(const Key: AnsiString; var Value: LongInt): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: LongInt): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.SetItem(const Key: AnsiString; const Value: LongInt);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryA.GetItemByIndex(const Idx: Integer): LongInt;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.SetItemByIndex(const Idx: Integer; const Value: LongInt);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongIntDictionaryA }
|
|
{ }
|
|
function TLongIntDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TLongIntDictionaryA.GetItem(const Key: AnsiString): LongInt;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TLongIntArray(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLongIntDictionaryA.LocateItem(const Key: AnsiString; var Value: LongInt): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TLongIntArray(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralLongIntDictionaryB }
|
|
{ }
|
|
constructor TGeneralLongIntDictionaryB.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TRawByteStringArray.Create;
|
|
FValues := TLongIntArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralLongIntDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TLongIntArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TRawByteStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TLongIntArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TLongIntDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TLongIntArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralLongIntDictionaryB.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrB(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.Add(const Key: RawByteString; const Value: LongInt);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrB(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.Delete(const Key: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.HasKey(const Key: RawByteString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.Rename(const Key, NewKey: RawByteString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrB(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.LocateItem(const Key: RawByteString; var Value: LongInt): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.LocateNext(const Key: RawByteString; const Idx: Integer; var Value: LongInt): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.SetItem(const Key: RawByteString; const Value: LongInt);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.GetKeyByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryB.GetItemByIndex(const Idx: Integer): LongInt;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.SetItemByIndex(const Idx: Integer; const Value: LongInt);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryB.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongIntDictionaryB }
|
|
{ }
|
|
function TLongIntDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualB(Key, TRawByteStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TLongIntDictionaryB.GetItem(const Key: RawByteString): LongInt;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TLongIntArray(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLongIntDictionaryB.LocateItem(const Key: RawByteString; var Value: LongInt): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TLongIntArray(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralLongIntDictionaryU }
|
|
{ }
|
|
constructor TGeneralLongIntDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TLongIntArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralLongIntDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TLongIntArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TLongIntArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TLongIntDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TLongIntArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralLongIntDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.Add(const Key: UnicodeString; const Value: LongInt);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.LocateItem(const Key: UnicodeString; var Value: LongInt): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: LongInt): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.SetItem(const Key: UnicodeString; const Value: LongInt);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionaryU.GetItemByIndex(const Idx: Integer): LongInt;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.SetItemByIndex(const Idx: Integer; const Value: LongInt);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongIntDictionaryU }
|
|
{ }
|
|
function TLongIntDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TLongIntDictionaryU.GetItem(const Key: UnicodeString): LongInt;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TLongIntArray(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLongIntDictionaryU.LocateItem(const Key: UnicodeString; var Value: LongInt): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TLongIntArray(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralLongIntDictionary }
|
|
{ }
|
|
constructor TGeneralLongIntDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TLongIntArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralLongIntDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TLongIntArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TLongIntArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TLongIntDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TLongIntArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralLongIntDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.Add(const Key: String; const Value: LongInt);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.LocateItem(const Key: String; var Value: LongInt): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: LongInt): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.SetItem(const Key: String; const Value: LongInt);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralLongIntDictionary.GetItemByIndex(const Idx: Integer): LongInt;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.SetItemByIndex(const Idx: Integer; const Value: LongInt);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralLongIntDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongIntDictionary }
|
|
{ }
|
|
function TLongIntDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TLongIntDictionary.GetItem(const Key: String): LongInt;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TLongIntArray(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLongIntDictionary.LocateItem(const Key: String; var Value: LongInt): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TLongIntArray(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralLongWordDictionaryA }
|
|
{ }
|
|
constructor TGeneralLongWordDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TLongWordArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralLongWordDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TLongWordArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TLongWordArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TLongWordDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TLongWordArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralLongWordDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.Add(const Key: AnsiString; const Value: LongWord);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.LocateItem(const Key: AnsiString; var Value: LongWord): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: LongWord): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.SetItem(const Key: AnsiString; const Value: LongWord);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryA.GetItemByIndex(const Idx: Integer): LongWord;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.SetItemByIndex(const Idx: Integer; const Value: LongWord);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongWordDictionaryA }
|
|
{ }
|
|
function TLongWordDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TLongWordDictionaryA.GetItem(const Key: AnsiString): LongWord;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TLongWordArray(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLongWordDictionaryA.LocateItem(const Key: AnsiString; var Value: LongWord): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TLongWordArray(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralLongWordDictionaryB }
|
|
{ }
|
|
constructor TGeneralLongWordDictionaryB.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TRawByteStringArray.Create;
|
|
FValues := TLongWordArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralLongWordDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TLongWordArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TRawByteStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TLongWordArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TLongWordDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TLongWordArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralLongWordDictionaryB.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrB(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.Add(const Key: RawByteString; const Value: LongWord);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrB(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.Delete(const Key: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.HasKey(const Key: RawByteString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.Rename(const Key, NewKey: RawByteString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrB(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.LocateItem(const Key: RawByteString; var Value: LongWord): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.LocateNext(const Key: RawByteString; const Idx: Integer; var Value: LongWord): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.SetItem(const Key: RawByteString; const Value: LongWord);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.GetKeyByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryB.GetItemByIndex(const Idx: Integer): LongWord;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.SetItemByIndex(const Idx: Integer; const Value: LongWord);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryB.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongWordDictionaryB }
|
|
{ }
|
|
function TLongWordDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualB(Key, TRawByteStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TLongWordDictionaryB.GetItem(const Key: RawByteString): LongWord;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TLongWordArray(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLongWordDictionaryB.LocateItem(const Key: RawByteString; var Value: LongWord): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TLongWordArray(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralLongWordDictionaryU }
|
|
{ }
|
|
constructor TGeneralLongWordDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TLongWordArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralLongWordDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TLongWordArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TLongWordArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TLongWordDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TLongWordArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralLongWordDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.Add(const Key: UnicodeString; const Value: LongWord);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.LocateItem(const Key: UnicodeString; var Value: LongWord): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: LongWord): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.SetItem(const Key: UnicodeString; const Value: LongWord);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionaryU.GetItemByIndex(const Idx: Integer): LongWord;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.SetItemByIndex(const Idx: Integer; const Value: LongWord);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongWordDictionaryU }
|
|
{ }
|
|
function TLongWordDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TLongWordDictionaryU.GetItem(const Key: UnicodeString): LongWord;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TLongWordArray(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLongWordDictionaryU.LocateItem(const Key: UnicodeString; var Value: LongWord): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TLongWordArray(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralLongWordDictionary }
|
|
{ }
|
|
constructor TGeneralLongWordDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TLongWordArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralLongWordDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TLongWordArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TLongWordArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TLongWordDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TLongWordArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralLongWordDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.Add(const Key: String; const Value: LongWord);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.LocateItem(const Key: String; var Value: LongWord): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: LongWord): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.SetItem(const Key: String; const Value: LongWord);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralLongWordDictionary.GetItemByIndex(const Idx: Integer): LongWord;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.SetItemByIndex(const Idx: Integer; const Value: LongWord);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralLongWordDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TLongWordDictionary }
|
|
{ }
|
|
function TLongWordDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TLongWordDictionary.GetItem(const Key: String): LongWord;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TLongWordArray(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLongWordDictionary.LocateItem(const Key: String; var Value: LongWord): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TLongWordArray(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralInt64DictionaryA }
|
|
{ }
|
|
constructor TGeneralInt64DictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TInt64Array.Create;
|
|
end;
|
|
|
|
constructor TGeneralInt64DictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TInt64Array; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TInt64Array.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TInt64DictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TInt64Array; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralInt64DictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.Add(const Key: AnsiString; const Value: Int64);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.LocateItem(const Key: AnsiString; var Value: Int64): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: Int64): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.SetItem(const Key: AnsiString; const Value: Int64);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryA.GetItemByIndex(const Idx: Integer): Int64;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.SetItemByIndex(const Idx: Integer; const Value: Int64);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInt64DictionaryA }
|
|
{ }
|
|
function TInt64DictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TInt64DictionaryA.GetItem(const Key: AnsiString): Int64;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TInt64Array(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TInt64DictionaryA.LocateItem(const Key: AnsiString; var Value: Int64): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TInt64Array(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralInt64DictionaryB }
|
|
{ }
|
|
constructor TGeneralInt64DictionaryB.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TRawByteStringArray.Create;
|
|
FValues := TInt64Array.Create;
|
|
end;
|
|
|
|
constructor TGeneralInt64DictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TInt64Array; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TRawByteStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TInt64Array.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TInt64DictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TInt64Array; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralInt64DictionaryB.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrB(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.Add(const Key: RawByteString; const Value: Int64);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrB(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.Delete(const Key: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.HasKey(const Key: RawByteString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.Rename(const Key, NewKey: RawByteString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrB(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.LocateItem(const Key: RawByteString; var Value: Int64): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.LocateNext(const Key: RawByteString; const Idx: Integer; var Value: Int64): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.SetItem(const Key: RawByteString; const Value: Int64);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.GetKeyByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryB.GetItemByIndex(const Idx: Integer): Int64;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.SetItemByIndex(const Idx: Integer; const Value: Int64);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryB.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInt64DictionaryB }
|
|
{ }
|
|
function TInt64DictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualB(Key, TRawByteStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TInt64DictionaryB.GetItem(const Key: RawByteString): Int64;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TInt64Array(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TInt64DictionaryB.LocateItem(const Key: RawByteString; var Value: Int64): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TInt64Array(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralInt64DictionaryU }
|
|
{ }
|
|
constructor TGeneralInt64DictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TInt64Array.Create;
|
|
end;
|
|
|
|
constructor TGeneralInt64DictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TInt64Array; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TInt64Array.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TInt64DictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TInt64Array; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralInt64DictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.Add(const Key: UnicodeString; const Value: Int64);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.LocateItem(const Key: UnicodeString; var Value: Int64): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: Int64): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.SetItem(const Key: UnicodeString; const Value: Int64);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralInt64DictionaryU.GetItemByIndex(const Idx: Integer): Int64;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.SetItemByIndex(const Idx: Integer; const Value: Int64);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralInt64DictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInt64DictionaryU }
|
|
{ }
|
|
function TInt64DictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TInt64DictionaryU.GetItem(const Key: UnicodeString): Int64;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TInt64Array(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TInt64DictionaryU.LocateItem(const Key: UnicodeString; var Value: Int64): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TInt64Array(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralInt64Dictionary }
|
|
{ }
|
|
constructor TGeneralInt64Dictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TInt64Array.Create;
|
|
end;
|
|
|
|
constructor TGeneralInt64Dictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TInt64Array; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TInt64Array.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TInt64Dictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TInt64Array; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralInt64Dictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.Add(const Key: String; const Value: Int64);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.LocateItem(const Key: String; var Value: Int64): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.LocateNext(const Key: String; const Idx: Integer; var Value: Int64): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.SetItem(const Key: String; const Value: Int64);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralInt64Dictionary.GetItemByIndex(const Idx: Integer): Int64;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.SetItemByIndex(const Idx: Integer; const Value: Int64);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralInt64Dictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInt64Dictionary }
|
|
{ }
|
|
function TInt64Dictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TInt64Dictionary.GetItem(const Key: String): Int64;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TInt64Array(FValues).Data[I]
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TInt64Dictionary.LocateItem(const Key: String; var Value: Int64): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TInt64Array(FValues).Data[Result]
|
|
else
|
|
Value := 0;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralSingleDictionaryA }
|
|
{ }
|
|
constructor TGeneralSingleDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TSingleArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralSingleDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TSingleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TSingleArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TSingleDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TSingleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralSingleDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.Add(const Key: AnsiString; const Value: Single);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.LocateItem(const Key: AnsiString; var Value: Single): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: Single): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.SetItem(const Key: AnsiString; const Value: Single);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryA.GetItemByIndex(const Idx: Integer): Single;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.SetItemByIndex(const Idx: Integer; const Value: Single);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TSingleDictionaryA }
|
|
{ }
|
|
function TSingleDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TSingleDictionaryA.GetItem(const Key: AnsiString): Single;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TSingleArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TSingleDictionaryA.LocateItem(const Key: AnsiString; var Value: Single): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TSingleArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralSingleDictionaryB }
|
|
{ }
|
|
constructor TGeneralSingleDictionaryB.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TRawByteStringArray.Create;
|
|
FValues := TSingleArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralSingleDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TSingleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TRawByteStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TSingleArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TSingleDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TSingleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralSingleDictionaryB.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrB(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.Add(const Key: RawByteString; const Value: Single);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrB(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.Delete(const Key: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.HasKey(const Key: RawByteString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.Rename(const Key, NewKey: RawByteString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrB(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.LocateItem(const Key: RawByteString; var Value: Single): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.LocateNext(const Key: RawByteString; const Idx: Integer; var Value: Single): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.SetItem(const Key: RawByteString; const Value: Single);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.GetKeyByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryB.GetItemByIndex(const Idx: Integer): Single;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.SetItemByIndex(const Idx: Integer; const Value: Single);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryB.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TSingleDictionaryB }
|
|
{ }
|
|
function TSingleDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualB(Key, TRawByteStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TSingleDictionaryB.GetItem(const Key: RawByteString): Single;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TSingleArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TSingleDictionaryB.LocateItem(const Key: RawByteString; var Value: Single): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TSingleArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralSingleDictionaryU }
|
|
{ }
|
|
constructor TGeneralSingleDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TSingleArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralSingleDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TSingleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TSingleArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TSingleDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TSingleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralSingleDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.Add(const Key: UnicodeString; const Value: Single);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.LocateItem(const Key: UnicodeString; var Value: Single): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: Single): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.SetItem(const Key: UnicodeString; const Value: Single);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralSingleDictionaryU.GetItemByIndex(const Idx: Integer): Single;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.SetItemByIndex(const Idx: Integer; const Value: Single);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TSingleDictionaryU }
|
|
{ }
|
|
function TSingleDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TSingleDictionaryU.GetItem(const Key: UnicodeString): Single;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TSingleArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TSingleDictionaryU.LocateItem(const Key: UnicodeString; var Value: Single): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TSingleArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralSingleDictionary }
|
|
{ }
|
|
constructor TGeneralSingleDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TSingleArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralSingleDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TSingleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TSingleArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TSingleDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TSingleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralSingleDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.Add(const Key: String; const Value: Single);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.LocateItem(const Key: String; var Value: Single): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: Single): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.SetItem(const Key: String; const Value: Single);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralSingleDictionary.GetItemByIndex(const Idx: Integer): Single;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.SetItemByIndex(const Idx: Integer; const Value: Single);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralSingleDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TSingleDictionary }
|
|
{ }
|
|
function TSingleDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TSingleDictionary.GetItem(const Key: String): Single;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TSingleArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TSingleDictionary.LocateItem(const Key: String; var Value: Single): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TSingleArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralDoubleDictionaryA }
|
|
{ }
|
|
constructor TGeneralDoubleDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TDoubleArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralDoubleDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TDoubleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TDoubleArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TDoubleDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TDoubleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralDoubleDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.Add(const Key: AnsiString; const Value: Double);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.LocateItem(const Key: AnsiString; var Value: Double): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: Double): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.SetItem(const Key: AnsiString; const Value: Double);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryA.GetItemByIndex(const Idx: Integer): Double;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.SetItemByIndex(const Idx: Integer; const Value: Double);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoubleDictionaryA }
|
|
{ }
|
|
function TDoubleDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TDoubleDictionaryA.GetItem(const Key: AnsiString): Double;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TDoubleArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TDoubleDictionaryA.LocateItem(const Key: AnsiString; var Value: Double): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TDoubleArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralDoubleDictionaryB }
|
|
{ }
|
|
constructor TGeneralDoubleDictionaryB.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TRawByteStringArray.Create;
|
|
FValues := TDoubleArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralDoubleDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TDoubleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TRawByteStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TDoubleArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TDoubleDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TDoubleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralDoubleDictionaryB.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrB(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.Add(const Key: RawByteString; const Value: Double);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrB(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.Delete(const Key: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.HasKey(const Key: RawByteString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.Rename(const Key, NewKey: RawByteString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrB(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.LocateItem(const Key: RawByteString; var Value: Double): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.LocateNext(const Key: RawByteString; const Idx: Integer; var Value: Double): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.SetItem(const Key: RawByteString; const Value: Double);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.GetKeyByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryB.GetItemByIndex(const Idx: Integer): Double;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.SetItemByIndex(const Idx: Integer; const Value: Double);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryB.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoubleDictionaryB }
|
|
{ }
|
|
function TDoubleDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualB(Key, TRawByteStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TDoubleDictionaryB.GetItem(const Key: RawByteString): Double;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TDoubleArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TDoubleDictionaryB.LocateItem(const Key: RawByteString; var Value: Double): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TDoubleArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralDoubleDictionaryU }
|
|
{ }
|
|
constructor TGeneralDoubleDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TDoubleArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralDoubleDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TDoubleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TDoubleArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TDoubleDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TDoubleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralDoubleDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.Add(const Key: UnicodeString; const Value: Double);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.LocateItem(const Key: UnicodeString; var Value: Double): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: Double): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.SetItem(const Key: UnicodeString; const Value: Double);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionaryU.GetItemByIndex(const Idx: Integer): Double;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.SetItemByIndex(const Idx: Integer; const Value: Double);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoubleDictionaryU }
|
|
{ }
|
|
function TDoubleDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TDoubleDictionaryU.GetItem(const Key: UnicodeString): Double;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TDoubleArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TDoubleDictionaryU.LocateItem(const Key: UnicodeString; var Value: Double): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TDoubleArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralDoubleDictionary }
|
|
{ }
|
|
constructor TGeneralDoubleDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TDoubleArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralDoubleDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TDoubleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TDoubleArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TDoubleDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TDoubleArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralDoubleDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.Add(const Key: String; const Value: Double);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.LocateItem(const Key: String; var Value: Double): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: Double): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.SetItem(const Key: String; const Value: Double);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralDoubleDictionary.GetItemByIndex(const Idx: Integer): Double;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.SetItemByIndex(const Idx: Integer; const Value: Double);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralDoubleDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoubleDictionary }
|
|
{ }
|
|
function TDoubleDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TDoubleDictionary.GetItem(const Key: String): Double;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TDoubleArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TDoubleDictionary.LocateItem(const Key: String; var Value: Double): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TDoubleArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralExtendedDictionaryA }
|
|
{ }
|
|
constructor TGeneralExtendedDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TExtendedArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralExtendedDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TExtendedArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TExtendedArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TExtendedDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TExtendedArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralExtendedDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.Add(const Key: AnsiString; const Value: Extended);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.LocateItem(const Key: AnsiString; var Value: Extended): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: Extended): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.SetItem(const Key: AnsiString; const Value: Extended);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryA.GetItemByIndex(const Idx: Integer): Extended;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.SetItemByIndex(const Idx: Integer; const Value: Extended);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TExtendedDictionaryA }
|
|
{ }
|
|
function TExtendedDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TExtendedDictionaryA.GetItem(const Key: AnsiString): Extended;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TExtendedArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TExtendedDictionaryA.LocateItem(const Key: AnsiString; var Value: Extended): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TExtendedArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralExtendedDictionaryB }
|
|
{ }
|
|
constructor TGeneralExtendedDictionaryB.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TRawByteStringArray.Create;
|
|
FValues := TExtendedArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralExtendedDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TExtendedArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TRawByteStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TExtendedArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TExtendedDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TExtendedArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralExtendedDictionaryB.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrB(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.Add(const Key: RawByteString; const Value: Extended);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrB(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.Delete(const Key: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.HasKey(const Key: RawByteString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.Rename(const Key, NewKey: RawByteString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrB(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.LocateItem(const Key: RawByteString; var Value: Extended): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.LocateNext(const Key: RawByteString; const Idx: Integer; var Value: Extended): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.SetItem(const Key: RawByteString; const Value: Extended);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.GetKeyByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryB.GetItemByIndex(const Idx: Integer): Extended;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.SetItemByIndex(const Idx: Integer; const Value: Extended);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryB.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TExtendedDictionaryB }
|
|
{ }
|
|
function TExtendedDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualB(Key, TRawByteStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TExtendedDictionaryB.GetItem(const Key: RawByteString): Extended;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TExtendedArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TExtendedDictionaryB.LocateItem(const Key: RawByteString; var Value: Extended): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TExtendedArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralExtendedDictionaryU }
|
|
{ }
|
|
constructor TGeneralExtendedDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TExtendedArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralExtendedDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TExtendedArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TExtendedArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TExtendedDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TExtendedArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralExtendedDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.Add(const Key: UnicodeString; const Value: Extended);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.LocateItem(const Key: UnicodeString; var Value: Extended): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: Extended): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.SetItem(const Key: UnicodeString; const Value: Extended);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionaryU.GetItemByIndex(const Idx: Integer): Extended;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.SetItemByIndex(const Idx: Integer; const Value: Extended);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TExtendedDictionaryU }
|
|
{ }
|
|
function TExtendedDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TExtendedDictionaryU.GetItem(const Key: UnicodeString): Extended;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TExtendedArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TExtendedDictionaryU.LocateItem(const Key: UnicodeString; var Value: Extended): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TExtendedArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralExtendedDictionary }
|
|
{ }
|
|
constructor TGeneralExtendedDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TExtendedArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralExtendedDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TExtendedArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TExtendedArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TExtendedDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TExtendedArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralExtendedDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.Add(const Key: String; const Value: Extended);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.LocateItem(const Key: String; var Value: Extended): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: Extended): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.SetItem(const Key: String; const Value: Extended);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralExtendedDictionary.GetItemByIndex(const Idx: Integer): Extended;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.SetItemByIndex(const Idx: Integer; const Value: Extended);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralExtendedDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TExtendedDictionary }
|
|
{ }
|
|
function TExtendedDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TExtendedDictionary.GetItem(const Key: String): Extended;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TExtendedArray(FValues).Data[I]
|
|
else
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TExtendedDictionary.LocateItem(const Key: String; var Value: Extended): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TExtendedArray(FValues).Data[Result]
|
|
else
|
|
Value := 0.0;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralAnsiStringDictionaryA }
|
|
{ }
|
|
constructor TGeneralAnsiStringDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TAnsiStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralAnsiStringDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TAnsiStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TAnsiStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TAnsiStringDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TAnsiStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralAnsiStringDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.Add(const Key: AnsiString; const Value: AnsiString);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.LocateItem(const Key: AnsiString; var Value: AnsiString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: AnsiString): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.SetItem(const Key: AnsiString; const Value: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryA.GetItemByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.SetItemByIndex(const Idx: Integer; const Value: AnsiString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TAnsiStringDictionaryA }
|
|
{ }
|
|
function TAnsiStringDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TAnsiStringDictionaryA.GetItem(const Key: AnsiString): AnsiString;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TAnsiStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TAnsiStringDictionaryA.LocateItem(const Key: AnsiString; var Value: AnsiString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TAnsiStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralAnsiStringDictionaryU }
|
|
{ }
|
|
constructor TGeneralAnsiStringDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TAnsiStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralAnsiStringDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TAnsiStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TAnsiStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TAnsiStringDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TAnsiStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralAnsiStringDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.Add(const Key: UnicodeString; const Value: AnsiString);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.LocateItem(const Key: UnicodeString; var Value: AnsiString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: AnsiString): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.SetItem(const Key: UnicodeString; const Value: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionaryU.GetItemByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.SetItemByIndex(const Idx: Integer; const Value: AnsiString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TAnsiStringDictionaryU }
|
|
{ }
|
|
function TAnsiStringDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TAnsiStringDictionaryU.GetItem(const Key: UnicodeString): AnsiString;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TAnsiStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TAnsiStringDictionaryU.LocateItem(const Key: UnicodeString; var Value: AnsiString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TAnsiStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralAnsiStringDictionary }
|
|
{ }
|
|
constructor TGeneralAnsiStringDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TAnsiStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralAnsiStringDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TAnsiStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TAnsiStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TAnsiStringDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TAnsiStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralAnsiStringDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.Add(const Key: String; const Value: AnsiString);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.LocateItem(const Key: String; var Value: AnsiString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: AnsiString): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.SetItem(const Key: String; const Value: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralAnsiStringDictionary.GetItemByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.SetItemByIndex(const Idx: Integer; const Value: AnsiString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralAnsiStringDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TAnsiStringDictionary }
|
|
{ }
|
|
function TAnsiStringDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TAnsiStringDictionary.GetItem(const Key: String): AnsiString;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TAnsiStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TAnsiStringDictionary.LocateItem(const Key: String; var Value: AnsiString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TAnsiStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralRawByteStringDictionaryA }
|
|
{ }
|
|
constructor TGeneralRawByteStringDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TRawByteStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralRawByteStringDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TRawByteStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TRawByteStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TRawByteStringDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TRawByteStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralRawByteStringDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.Add(const Key: AnsiString; const Value: RawByteString);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.LocateItem(const Key: AnsiString; var Value: RawByteString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: RawByteString): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.SetItem(const Key: AnsiString; const Value: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryA.GetItemByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.SetItemByIndex(const Idx: Integer; const Value: RawByteString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TRawByteStringDictionaryA }
|
|
{ }
|
|
function TRawByteStringDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TRawByteStringDictionaryA.GetItem(const Key: AnsiString): RawByteString;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TRawByteStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TRawByteStringDictionaryA.LocateItem(const Key: AnsiString; var Value: RawByteString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TRawByteStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralRawByteStringDictionaryB }
|
|
{ }
|
|
constructor TGeneralRawByteStringDictionaryB.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TRawByteStringArray.Create;
|
|
FValues := TRawByteStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralRawByteStringDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TRawByteStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TRawByteStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TRawByteStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TRawByteStringDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TRawByteStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralRawByteStringDictionaryB.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrB(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.Add(const Key: RawByteString; const Value: RawByteString);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrB(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.Delete(const Key: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.HasKey(const Key: RawByteString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.Rename(const Key, NewKey: RawByteString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrB(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.LocateItem(const Key: RawByteString; var Value: RawByteString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.LocateNext(const Key: RawByteString; const Idx: Integer; var Value: RawByteString): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.SetItem(const Key: RawByteString; const Value: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.GetKeyByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryB.GetItemByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.SetItemByIndex(const Idx: Integer; const Value: RawByteString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryB.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TRawByteStringDictionaryB }
|
|
{ }
|
|
function TRawByteStringDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualB(Key, TRawByteStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TRawByteStringDictionaryB.GetItem(const Key: RawByteString): RawByteString;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TRawByteStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TRawByteStringDictionaryB.LocateItem(const Key: RawByteString; var Value: RawByteString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TRawByteStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralRawByteStringDictionaryU }
|
|
{ }
|
|
constructor TGeneralRawByteStringDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TRawByteStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralRawByteStringDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TRawByteStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TRawByteStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TRawByteStringDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TRawByteStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralRawByteStringDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.Add(const Key: UnicodeString; const Value: RawByteString);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.LocateItem(const Key: UnicodeString; var Value: RawByteString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: RawByteString): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.SetItem(const Key: UnicodeString; const Value: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionaryU.GetItemByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.SetItemByIndex(const Idx: Integer; const Value: RawByteString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TRawByteStringDictionaryU }
|
|
{ }
|
|
function TRawByteStringDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TRawByteStringDictionaryU.GetItem(const Key: UnicodeString): RawByteString;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TRawByteStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TRawByteStringDictionaryU.LocateItem(const Key: UnicodeString; var Value: RawByteString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TRawByteStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralRawByteStringDictionary }
|
|
{ }
|
|
constructor TGeneralRawByteStringDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TRawByteStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralRawByteStringDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TRawByteStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TRawByteStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TRawByteStringDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TRawByteStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralRawByteStringDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.Add(const Key: String; const Value: RawByteString);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.LocateItem(const Key: String; var Value: RawByteString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: RawByteString): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.SetItem(const Key: String; const Value: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralRawByteStringDictionary.GetItemByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.SetItemByIndex(const Idx: Integer; const Value: RawByteString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralRawByteStringDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TRawByteStringDictionary }
|
|
{ }
|
|
function TRawByteStringDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TRawByteStringDictionary.GetItem(const Key: String): RawByteString;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TRawByteStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TRawByteStringDictionary.LocateItem(const Key: String; var Value: RawByteString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TRawByteStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralUnicodeStringDictionaryA }
|
|
{ }
|
|
constructor TGeneralUnicodeStringDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TUnicodeStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralUnicodeStringDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TUnicodeStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TUnicodeStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TUnicodeStringDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TUnicodeStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralUnicodeStringDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.Add(const Key: AnsiString; const Value: UnicodeString);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.LocateItem(const Key: AnsiString; var Value: UnicodeString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: UnicodeString): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.SetItem(const Key: AnsiString; const Value: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryA.GetItemByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.SetItemByIndex(const Idx: Integer; const Value: UnicodeString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TUnicodeStringDictionaryA }
|
|
{ }
|
|
function TUnicodeStringDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TUnicodeStringDictionaryA.GetItem(const Key: AnsiString): UnicodeString;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TUnicodeStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TUnicodeStringDictionaryA.LocateItem(const Key: AnsiString; var Value: UnicodeString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TUnicodeStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralUnicodeStringDictionaryU }
|
|
{ }
|
|
constructor TGeneralUnicodeStringDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TUnicodeStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralUnicodeStringDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TUnicodeStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TUnicodeStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TUnicodeStringDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TUnicodeStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralUnicodeStringDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.Add(const Key: UnicodeString; const Value: UnicodeString);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.LocateItem(const Key: UnicodeString; var Value: UnicodeString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: UnicodeString): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.SetItem(const Key: UnicodeString; const Value: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionaryU.GetItemByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.SetItemByIndex(const Idx: Integer; const Value: UnicodeString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TUnicodeStringDictionaryU }
|
|
{ }
|
|
function TUnicodeStringDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TUnicodeStringDictionaryU.GetItem(const Key: UnicodeString): UnicodeString;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TUnicodeStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TUnicodeStringDictionaryU.LocateItem(const Key: UnicodeString; var Value: UnicodeString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TUnicodeStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralUnicodeStringDictionary }
|
|
{ }
|
|
constructor TGeneralUnicodeStringDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TUnicodeStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralUnicodeStringDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TUnicodeStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TUnicodeStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TUnicodeStringDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TUnicodeStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralUnicodeStringDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.Add(const Key: String; const Value: UnicodeString);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.LocateItem(const Key: String; var Value: UnicodeString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: UnicodeString): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.SetItem(const Key: String; const Value: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralUnicodeStringDictionary.GetItemByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.SetItemByIndex(const Idx: Integer; const Value: UnicodeString);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralUnicodeStringDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TUnicodeStringDictionary }
|
|
{ }
|
|
function TUnicodeStringDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TUnicodeStringDictionary.GetItem(const Key: String): UnicodeString;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TUnicodeStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TUnicodeStringDictionary.LocateItem(const Key: String; var Value: UnicodeString): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TUnicodeStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralStringDictionaryA }
|
|
{ }
|
|
constructor TGeneralStringDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralStringDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TStringDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralStringDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.Add(const Key: AnsiString; const Value: String);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.LocateItem(const Key: AnsiString; var Value: String): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: String): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.SetItem(const Key: AnsiString; const Value: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralStringDictionaryA.GetItemByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.SetItemByIndex(const Idx: Integer; const Value: String);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TStringDictionaryA }
|
|
{ }
|
|
function TStringDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TStringDictionaryA.GetItem(const Key: AnsiString): String;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TStringDictionaryA.LocateItem(const Key: AnsiString; var Value: String): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralStringDictionaryU }
|
|
{ }
|
|
constructor TGeneralStringDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralStringDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TStringDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralStringDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.Add(const Key: UnicodeString; const Value: String);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.LocateItem(const Key: UnicodeString; var Value: String): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: String): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.SetItem(const Key: UnicodeString; const Value: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralStringDictionaryU.GetItemByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.SetItemByIndex(const Idx: Integer; const Value: String);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TStringDictionaryU }
|
|
{ }
|
|
function TStringDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TStringDictionaryU.GetItem(const Key: UnicodeString): String;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TStringDictionaryU.LocateItem(const Key: UnicodeString; var Value: String): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralStringDictionary }
|
|
{ }
|
|
constructor TGeneralStringDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TStringArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralStringDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TStringArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TStringDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TStringArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralStringDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralStringDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralStringDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralStringDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralStringDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.Add(const Key: String; const Value: String);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralStringDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralStringDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralStringDictionary.LocateItem(const Key: String; var Value: String): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
function TGeneralStringDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: String): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.SetItem(const Key: String; const Value: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralStringDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralStringDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralStringDictionary.GetItemByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.SetItemByIndex(const Idx: Integer; const Value: String);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralStringDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TStringDictionary }
|
|
{ }
|
|
function TStringDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TStringDictionary.GetItem(const Key: String): String;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TStringArray(FValues).Data[I]
|
|
else
|
|
Result := '';
|
|
end;
|
|
|
|
function TStringDictionary.LocateItem(const Key: String; var Value: String): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TStringArray(FValues).Data[Result]
|
|
else
|
|
Value := '';
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralPointerDictionaryA }
|
|
{ }
|
|
constructor TGeneralPointerDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TPointerArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralPointerDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TPointerArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TPointerArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TPointerDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TPointerArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralPointerDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.Add(const Key: AnsiString; const Value: Pointer);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.LocateItem(const Key: AnsiString; var Value: Pointer): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: Pointer): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.SetItem(const Key: AnsiString; const Value: Pointer);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryA.GetItemByIndex(const Idx: Integer): Pointer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.SetItemByIndex(const Idx: Integer; const Value: Pointer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TPointerDictionaryA }
|
|
{ }
|
|
function TPointerDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TPointerDictionaryA.GetItem(const Key: AnsiString): Pointer;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TPointerArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TPointerDictionaryA.LocateItem(const Key: AnsiString; var Value: Pointer): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TPointerArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralPointerDictionaryB }
|
|
{ }
|
|
constructor TGeneralPointerDictionaryB.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TRawByteStringArray.Create;
|
|
FValues := TPointerArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralPointerDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TPointerArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TRawByteStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TPointerArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TPointerDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TPointerArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralPointerDictionaryB.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrB(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.Add(const Key: RawByteString; const Value: Pointer);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrB(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.Delete(const Key: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.HasKey(const Key: RawByteString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.Rename(const Key, NewKey: RawByteString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrB(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.LocateItem(const Key: RawByteString; var Value: Pointer): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.LocateNext(const Key: RawByteString; const Idx: Integer; var Value: Pointer): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.SetItem(const Key: RawByteString; const Value: Pointer);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.GetKeyByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryB.GetItemByIndex(const Idx: Integer): Pointer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.SetItemByIndex(const Idx: Integer; const Value: Pointer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryB.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TPointerDictionaryB }
|
|
{ }
|
|
function TPointerDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualB(Key, TRawByteStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TPointerDictionaryB.GetItem(const Key: RawByteString): Pointer;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TPointerArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TPointerDictionaryB.LocateItem(const Key: RawByteString; var Value: Pointer): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TPointerArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralPointerDictionaryU }
|
|
{ }
|
|
constructor TGeneralPointerDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TPointerArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralPointerDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TPointerArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TPointerArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TPointerDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TPointerArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralPointerDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.Add(const Key: UnicodeString; const Value: Pointer);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.LocateItem(const Key: UnicodeString; var Value: Pointer): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: Pointer): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.SetItem(const Key: UnicodeString; const Value: Pointer);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralPointerDictionaryU.GetItemByIndex(const Idx: Integer): Pointer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.SetItemByIndex(const Idx: Integer; const Value: Pointer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TPointerDictionaryU }
|
|
{ }
|
|
function TPointerDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TPointerDictionaryU.GetItem(const Key: UnicodeString): Pointer;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TPointerArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TPointerDictionaryU.LocateItem(const Key: UnicodeString; var Value: Pointer): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TPointerArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralPointerDictionary }
|
|
{ }
|
|
constructor TGeneralPointerDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TPointerArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralPointerDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TPointerArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TPointerArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TPointerDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TPointerArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralPointerDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.Add(const Key: String; const Value: Pointer);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.LocateItem(const Key: String; var Value: Pointer): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: Pointer): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.SetItem(const Key: String; const Value: Pointer);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralPointerDictionary.GetItemByIndex(const Idx: Integer): Pointer;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.SetItemByIndex(const Idx: Integer; const Value: Pointer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralPointerDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TPointerDictionary }
|
|
{ }
|
|
function TPointerDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TPointerDictionary.GetItem(const Key: String): Pointer;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TPointerArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TPointerDictionary.LocateItem(const Key: String; var Value: Pointer): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TPointerArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralInterfaceDictionaryA }
|
|
{ }
|
|
constructor TGeneralInterfaceDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TInterfaceArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralInterfaceDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TInterfaceArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TInterfaceArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TInterfaceDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TInterfaceArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralInterfaceDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.Add(const Key: AnsiString; const Value: IInterface);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.LocateItem(const Key: AnsiString; var Value: IInterface): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: IInterface): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.SetItem(const Key: AnsiString; const Value: IInterface);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryA.GetItemByIndex(const Idx: Integer): IInterface;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.SetItemByIndex(const Idx: Integer; const Value: IInterface);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInterfaceDictionaryA }
|
|
{ }
|
|
function TInterfaceDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TInterfaceDictionaryA.GetItem(const Key: AnsiString): IInterface;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TInterfaceArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TInterfaceDictionaryA.LocateItem(const Key: AnsiString; var Value: IInterface): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TInterfaceArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralInterfaceDictionaryU }
|
|
{ }
|
|
constructor TGeneralInterfaceDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TInterfaceArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralInterfaceDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TInterfaceArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TInterfaceArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TInterfaceDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TInterfaceArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralInterfaceDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.Add(const Key: UnicodeString; const Value: IInterface);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.LocateItem(const Key: UnicodeString; var Value: IInterface): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: IInterface): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.SetItem(const Key: UnicodeString; const Value: IInterface);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionaryU.GetItemByIndex(const Idx: Integer): IInterface;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.SetItemByIndex(const Idx: Integer; const Value: IInterface);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInterfaceDictionaryU }
|
|
{ }
|
|
function TInterfaceDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TInterfaceDictionaryU.GetItem(const Key: UnicodeString): IInterface;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TInterfaceArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TInterfaceDictionaryU.LocateItem(const Key: UnicodeString; var Value: IInterface): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TInterfaceArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralInterfaceDictionary }
|
|
{ }
|
|
constructor TGeneralInterfaceDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TInterfaceArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralInterfaceDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TInterfaceArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TInterfaceArray.Create;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TInterfaceDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TInterfaceArray; const AKeysCaseSensitive: Boolean;
|
|
const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralInterfaceDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.Add(const Key: String; const Value: IInterface);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.LocateItem(const Key: String; var Value: IInterface): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: IInterface): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.SetItem(const Key: String; const Value: IInterface);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralInterfaceDictionary.GetItemByIndex(const Idx: Integer): IInterface;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.SetItemByIndex(const Idx: Integer; const Value: IInterface);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
procedure TGeneralInterfaceDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TInterfaceDictionary }
|
|
{ }
|
|
function TInterfaceDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TInterfaceDictionary.GetItem(const Key: String): IInterface;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TInterfaceArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TInterfaceDictionary.LocateItem(const Key: String; var Value: IInterface): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TInterfaceArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TGeneralObjectDictionaryA }
|
|
{ }
|
|
constructor TGeneralObjectDictionaryA.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TAnsiStringArray.Create;
|
|
FValues := TObjectArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralObjectDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TObjectArray; const AIsItemOwner: Boolean;
|
|
const AKeysCaseSensitive: Boolean; const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TAnsiStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TObjectArray.Create;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FValues.IsItemOwner := AIsItemOwner;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TObjectDictionaryA.CreateEx(
|
|
const AKeys: TAnsiStringArray;
|
|
const AValues: TObjectArray; const AIsItemOwner: Boolean;
|
|
const AKeysCaseSensitive: Boolean; const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AIsItemOwner, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralObjectDictionaryA.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.GetIsItemOwner: Boolean;
|
|
begin
|
|
Result := FValues.IsItemOwner;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.SetIsItemOwner(const AIsItemOwner: Boolean);
|
|
begin
|
|
FValues.IsItemOwner := AIsItemOwner;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrA(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.Add(const Key: AnsiString; const Value: TObject);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrA(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.Delete(const Key: AnsiString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.HasKey(const Key: AnsiString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.Rename(const Key, NewKey: AnsiString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrA(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.LocateItem(const Key: AnsiString; var Value: TObject): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.LocateNext(const Key: AnsiString; const Idx: Integer; var Value: TObject): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualA(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.SetItem(const Key: AnsiString; const Value: TObject);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.GetKeyByIndex(const Idx: Integer): AnsiString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.GetItemByIndex(const Idx: Integer): TObject;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.SetItemByIndex(const Idx: Integer; const Value: TObject);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryA.ReleaseItem(const Key: AnsiString): TObject;
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
Result := FValues.ReleaseItem(I);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.ReleaseItems;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.ReleaseItems;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.FreeItems;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.FreeItems;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryA.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TObjectDictionaryA }
|
|
{ }
|
|
function TObjectDictionaryA.LocateKey(const Key: AnsiString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrA(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualA(Key, TAnsiStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TObjectDictionaryA.GetItem(const Key: AnsiString): TObject;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TObjectArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TObjectDictionaryA.LocateItem(const Key: AnsiString; var Value: TObject): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TObjectArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TGeneralObjectDictionaryB }
|
|
{ }
|
|
constructor TGeneralObjectDictionaryB.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TRawByteStringArray.Create;
|
|
FValues := TObjectArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralObjectDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TObjectArray; const AIsItemOwner: Boolean;
|
|
const AKeysCaseSensitive: Boolean; const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TRawByteStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TObjectArray.Create;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FValues.IsItemOwner := AIsItemOwner;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TObjectDictionaryB.CreateEx(
|
|
const AKeys: TRawByteStringArray;
|
|
const AValues: TObjectArray; const AIsItemOwner: Boolean;
|
|
const AKeysCaseSensitive: Boolean; const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AIsItemOwner, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralObjectDictionaryB.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.GetIsItemOwner: Boolean;
|
|
begin
|
|
Result := FValues.IsItemOwner;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.SetIsItemOwner(const AIsItemOwner: Boolean);
|
|
begin
|
|
FValues.IsItemOwner := AIsItemOwner;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrB(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.Add(const Key: RawByteString; const Value: TObject);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrB(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.Delete(const Key: RawByteString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.HasKey(const Key: RawByteString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.Rename(const Key, NewKey: RawByteString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrB(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.LocateItem(const Key: RawByteString; var Value: TObject): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.LocateNext(const Key: RawByteString; const Idx: Integer; var Value: TObject): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualB(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.SetItem(const Key: RawByteString; const Value: TObject);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.GetKeyByIndex(const Idx: Integer): RawByteString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.GetItemByIndex(const Idx: Integer): TObject;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.SetItemByIndex(const Idx: Integer; const Value: TObject);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryB.ReleaseItem(const Key: RawByteString): TObject;
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
Result := FValues.ReleaseItem(I);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.ReleaseItems;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.ReleaseItems;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.FreeItems;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.FreeItems;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryB.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TObjectDictionaryB }
|
|
{ }
|
|
function TObjectDictionaryB.LocateKey(const Key: RawByteString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrB(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualB(Key, TRawByteStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TObjectDictionaryB.GetItem(const Key: RawByteString): TObject;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TObjectArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TObjectDictionaryB.LocateItem(const Key: RawByteString; var Value: TObject): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TObjectArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralObjectDictionaryU }
|
|
{ }
|
|
constructor TGeneralObjectDictionaryU.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TUnicodeStringArray.Create;
|
|
FValues := TObjectArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralObjectDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TObjectArray; const AIsItemOwner: Boolean;
|
|
const AKeysCaseSensitive: Boolean; const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TUnicodeStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TObjectArray.Create;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FValues.IsItemOwner := AIsItemOwner;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TObjectDictionaryU.CreateEx(
|
|
const AKeys: TUnicodeStringArray;
|
|
const AValues: TObjectArray; const AIsItemOwner: Boolean;
|
|
const AKeysCaseSensitive: Boolean; const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AIsItemOwner, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralObjectDictionaryU.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.GetIsItemOwner: Boolean;
|
|
begin
|
|
Result := FValues.IsItemOwner;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.SetIsItemOwner(const AIsItemOwner: Boolean);
|
|
begin
|
|
FValues.IsItemOwner := AIsItemOwner;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStrU(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.Add(const Key: UnicodeString; const Value: TObject);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStrU(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.Delete(const Key: UnicodeString);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.HasKey(const Key: UnicodeString): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.Rename(const Key, NewKey: UnicodeString);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStrU(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.LocateItem(const Key: UnicodeString; var Value: TObject): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.LocateNext(const Key: UnicodeString; const Idx: Integer; var Value: TObject): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqualU(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.SetItem(const Key: UnicodeString; const Value: TObject);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.GetKeyByIndex(const Idx: Integer): UnicodeString;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.GetItemByIndex(const Idx: Integer): TObject;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.SetItemByIndex(const Idx: Integer; const Value: TObject);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
function TGeneralObjectDictionaryU.ReleaseItem(const Key: UnicodeString): TObject;
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
Result := FValues.ReleaseItem(I);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.ReleaseItems;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.ReleaseItems;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.FreeItems;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.FreeItems;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionaryU.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TObjectDictionaryU }
|
|
{ }
|
|
function TObjectDictionaryU.LocateKey(const Key: UnicodeString; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStrU(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqualU(Key, TUnicodeStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TObjectDictionaryU.GetItem(const Key: UnicodeString): TObject;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TObjectArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TObjectDictionaryU.LocateItem(const Key: UnicodeString; var Value: TObject): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TObjectArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TGeneralObjectDictionary }
|
|
{ }
|
|
constructor TGeneralObjectDictionary.Create;
|
|
begin
|
|
inherited Create;
|
|
FCaseSensitive := True;
|
|
FDuplicatesAction := ddAccept;
|
|
FAddOnSet := True;
|
|
FKeys := TStringArray.Create;
|
|
FValues := TObjectArray.Create;
|
|
end;
|
|
|
|
constructor TGeneralObjectDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TObjectArray; const AIsItemOwner: Boolean;
|
|
const AKeysCaseSensitive: Boolean; const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
var L : Integer;
|
|
begin
|
|
inherited Create;
|
|
if Assigned(AKeys) then
|
|
begin
|
|
FKeys := AKeys;
|
|
L := FKeys.Count;
|
|
end
|
|
else
|
|
begin
|
|
FKeys := TStringArray.Create;
|
|
L := 0;
|
|
end;
|
|
if Assigned(AValues) then
|
|
FValues := AValues
|
|
else
|
|
FValues := TObjectArray.Create;
|
|
FValues.Count := L;
|
|
FAddOnSet := AAddOnSet;
|
|
FValues.IsItemOwner := AIsItemOwner;
|
|
FCaseSensitive := AKeysCaseSensitive;
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
if L > 0 then
|
|
Rehash;
|
|
end;
|
|
|
|
constructor TObjectDictionary.CreateEx(
|
|
const AKeys: TStringArray;
|
|
const AValues: TObjectArray; const AIsItemOwner: Boolean;
|
|
const AKeysCaseSensitive: Boolean; const AAddOnSet: Boolean;
|
|
const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
inherited CreateEx(AKeys, AValues, AIsItemOwner, AKeysCaseSensitive, AAddOnSet,
|
|
ADuplicatesAction);
|
|
end;
|
|
|
|
destructor TGeneralObjectDictionary.Destroy;
|
|
begin
|
|
FreeAndNil(FValues);
|
|
FreeAndNil(FKeys);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.GetKeysCaseSensitive: Boolean;
|
|
begin
|
|
Result := FCaseSensitive;
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.GetAddOnSet: Boolean;
|
|
begin
|
|
Result := FAddOnSet;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.SetAddOnSet(const AAddOnSet: Boolean);
|
|
begin
|
|
FAddOnSet := AAddOnSet;
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.GetHashTableSize: Integer;
|
|
begin
|
|
Result := Length(FLookup);
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.GetIsItemOwner: Boolean;
|
|
begin
|
|
Result := FValues.IsItemOwner;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.SetIsItemOwner(const AIsItemOwner: Boolean);
|
|
begin
|
|
FValues.IsItemOwner := AIsItemOwner;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.Rehash;
|
|
var I, C, L : Integer;
|
|
begin
|
|
C := FKeys.Count;
|
|
L := DictionaryRehashSize(C);
|
|
FLookup := nil;
|
|
SetLength(FLookup, L);
|
|
FHashSize := L;
|
|
Assert(L > 0);
|
|
Dec(L);
|
|
for I := 0 to C - 1 do
|
|
DynArrayAppend(FLookup[HashStr(FKeys[I], 1, -1, FCaseSensitive, 0) and L], I);
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, J, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.Add(const Key: String; const Value: TObject);
|
|
var H : Word32;
|
|
L, I : Integer;
|
|
begin
|
|
if FDuplicatesAction in [ddIgnore, ddError] then
|
|
if LocateKey(Key, H, False) >= 0 then
|
|
if FDuplicatesAction = ddIgnore then
|
|
exit
|
|
else
|
|
RaiseDuplicateKeyError(Key);
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
H := Integer(HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1));
|
|
I := FKeys.AppendItem(Key);
|
|
DynArrayAppend(FLookup[H], I);
|
|
FValues.AppendItem(Value);
|
|
if (I + 1) div DictionaryAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.DeleteByIndex(const Idx: Integer; const Hash: Integer);
|
|
var I, J, H : Integer;
|
|
begin
|
|
if Hash = -1 then
|
|
H := HashStr(FKeys[Idx], 1, -1, FCaseSensitive, 0) and (FHashSize - 1)
|
|
else
|
|
H := Hash;
|
|
FKeys.Delete(Idx);
|
|
FValues.Delete(Idx);
|
|
J := DynArrayPosNext(Idx, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
|
|
for I := 0 to FHashSize - 1 do
|
|
for J := 0 to Length(FLookup[I]) - 1 do
|
|
if FLookup[I][J] > Idx then
|
|
Dec(FLookup[I][J]);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.Delete(const Key: String);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
DeleteByIndex(I, H);
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.HasKey(const Key: String): Boolean;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False) >= 0;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.Rename(const Key, NewKey: String);
|
|
var I, J : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
FKeys[I] := NewKey;
|
|
J := DynArrayPosNext(I, FLookup[H]);
|
|
Assert(J >= 0, 'Invalid hash value/lookup table');
|
|
DynArrayRemove(FLookup[H], J, 1);
|
|
DynArrayAppend(FLookup[HashStr(NewKey, 1, -1, FCaseSensitive, 0) and (FHashSize - 1)], I);
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.GetDuplicatesAction: TDictionaryDuplicatesAction;
|
|
begin
|
|
Result := FDuplicatesAction;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.SetDuplicatesAction(const ADuplicatesAction: TDictionaryDuplicatesAction);
|
|
begin
|
|
FDuplicatesAction := ADuplicatesAction;
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.LocateItem(const Key: String; var Value: TObject): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := FValues[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.LocateNext(const Key: String; const Idx: Integer; var Value: TObject): Integer;
|
|
var L, H, I, J, K : Integer;
|
|
begin
|
|
Result := -1;
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
RaiseKeyNotFoundError(Key);
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, I];
|
|
if J = Idx then
|
|
begin
|
|
if not StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
RaiseKeyNotFoundError(Key);
|
|
for K := I + 1 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
J := FLookup[H, K];
|
|
if StrEqual(Key, FKeys[J], FCaseSensitive) then
|
|
begin
|
|
Value := FValues[J];
|
|
Result := J;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := -1;
|
|
exit;
|
|
end;
|
|
end;
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.SetItem(const Key: String; const Value: TObject);
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
FValues[I] := Value else
|
|
if AddOnSet then
|
|
Add(Key, Value) else
|
|
RaiseKeyNotFoundError(Key);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.RaiseIndexError;
|
|
begin
|
|
raise EDictionary.Create('Index out of range');
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.Count: Integer;
|
|
begin
|
|
Result := FKeys.Count;
|
|
Assert(FValues.Count = Result, 'Key/Value count mismatch');
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.GetKeyByIndex(const Idx: Integer): String;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FKeys.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FKeys[Idx];
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.DeleteItemByIndex(const Idx: Integer);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
DeleteByIndex(Idx, -1);
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.GetItemByIndex(const Idx: Integer): TObject;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
Result := FValues[Idx];
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.SetItemByIndex(const Idx: Integer; const Value: TObject);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (Idx < 0) or (Idx >= FValues.Count) then
|
|
RaiseIndexError;
|
|
{$ENDIF}
|
|
FValues[Idx] := Value;
|
|
end;
|
|
|
|
function TGeneralObjectDictionary.ReleaseItem(const Key: String): TObject;
|
|
var I : Integer;
|
|
H : Word32;
|
|
begin
|
|
I := LocateKey(Key, H, True);
|
|
Result := FValues.ReleaseItem(I);
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.ReleaseItems;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.ReleaseItems;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.FreeItems;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.FreeItems;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
procedure TGeneralObjectDictionary.Clear;
|
|
begin
|
|
FKeys.Clear;
|
|
FValues.Clear;
|
|
FHashSize := 0;
|
|
FLookup := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TObjectDictionary }
|
|
{ }
|
|
function TObjectDictionary.LocateKey(const Key: String; var LookupIdx: Word32;
|
|
const ErrorIfNotFound: Boolean): Integer;
|
|
var H : Word32;
|
|
I, L : Integer;
|
|
begin
|
|
L := FHashSize;
|
|
if L > 0 then
|
|
begin
|
|
H := HashStr(Key, 1, -1, FCaseSensitive, 0) and (L - 1);
|
|
LookupIdx := H;
|
|
for I := 0 to Length(FLookup[H]) - 1 do
|
|
begin
|
|
Result := FLookup[H][I];
|
|
if StrEqual(Key, TStringArray(FKeys).Data[Result],
|
|
FCaseSensitive) then
|
|
exit;
|
|
end;
|
|
end;
|
|
if ErrorIfNotFound then
|
|
RaiseKeyNotFoundError(Key);
|
|
Result := -1;
|
|
end;
|
|
|
|
function TObjectDictionary.GetItem(const Key: String): TObject;
|
|
var H : Word32;
|
|
I : Integer;
|
|
begin
|
|
I := LocateKey(Key, H, False);
|
|
if I >= 0 then
|
|
Result := TObjectArray(FValues).Data[I]
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TObjectDictionary.LocateItem(const Key: String; var Value: TObject): Integer;
|
|
var H : Word32;
|
|
begin
|
|
Result := LocateKey(Key, H, False);
|
|
if Result >= 0 then
|
|
Value := TObjectArray(FValues).Data[Result]
|
|
else
|
|
Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Sparse array functions }
|
|
{ }
|
|
const
|
|
SparseArrayAverageHashChainSize = 4;
|
|
|
|
function SparseArrayRehashSize(const Count: Integer): Integer;
|
|
var L : Integer;
|
|
begin
|
|
L := Count div SparseArrayAverageHashChainSize; // Number of "slots"
|
|
if L <= $10 then // Rehash in powers of 16
|
|
Result := $10 else
|
|
if L <= $100 then
|
|
Result := $100 else
|
|
if L <= $1000 then
|
|
Result := $1000 else
|
|
if L <= $10000 then
|
|
Result := $10000 else
|
|
if L <= $100000 then
|
|
Result := $100000 else
|
|
if L <= $1000000 then
|
|
Result := $1000000
|
|
else
|
|
Result := $10000000;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ ASparseArray }
|
|
{ }
|
|
procedure ASparseArray.IndexError;
|
|
begin
|
|
raise ESparseArray.Create('Index not found');
|
|
end;
|
|
|
|
function ASparseArray.IsEmpty: Boolean;
|
|
begin
|
|
Result := GetCount = 0;
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TSparseAnsiStringArray }
|
|
{ }
|
|
procedure TSparseAnsiStringArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is TSparseAnsiStringArray then
|
|
begin
|
|
Clear;
|
|
L := Length(TSparseAnsiStringArray(Source).FHashList);
|
|
SetLength(FHashList, L);
|
|
for I := 0 to L - 1 do
|
|
FHashList[I] := Copy(TSparseAnsiStringArray(Source).FHashList[I]);
|
|
FHashSize := TSparseAnsiStringArray(Source).FHashSize;
|
|
FCount := TSparseAnsiStringArray(Source).FCount;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TSparseAnsiStringArray.Clear;
|
|
begin
|
|
FHashList := nil;
|
|
FHashSize := 0;
|
|
FCount := 0;
|
|
end;
|
|
|
|
function TSparseAnsiStringArray.IsEqual(const V: TObject): Boolean;
|
|
var I, J : Integer;
|
|
F, G : Integer;
|
|
P, Q : PSparseAnsiStringRecord;
|
|
begin
|
|
if V is TSparseAnsiStringArray then
|
|
begin
|
|
if FCount <> TSparseAnsiStringArray(V).FCount then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
for J := 0 to Length(FHashList[I]) - 1 do
|
|
begin
|
|
Q := @FHashList[I][J];
|
|
P := TSparseAnsiStringArray(V).LocateItemRecord(Q^.Idx, F, G);
|
|
if not Assigned(P) or (P^.Value <> Q^.Value) then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function TSparseAnsiStringArray.LocateItemRecord(const Idx: Integer;
|
|
var LookupIdx, ChainIdx: Integer): PSparseAnsiStringRecord;
|
|
var H, I, J, L : Integer;
|
|
P : TSparseAnsiStringRecordArray;
|
|
begin
|
|
I := FHashSize;
|
|
if (I = 0) or (FCount = 0) then
|
|
begin
|
|
LookupIdx := -1;
|
|
ChainIdx := -1;
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
H := Integer(HashInteger(Idx) and (I - 1));
|
|
LookupIdx := H;
|
|
P := FHashList[H];
|
|
L := Length(P);
|
|
if L > 0 then
|
|
begin
|
|
Result := @P[0];
|
|
J := Idx;
|
|
for I := 0 to L - 1 do
|
|
if Result^.Idx = J then
|
|
begin
|
|
ChainIdx := I;
|
|
exit;
|
|
end
|
|
else
|
|
Inc(Result);
|
|
end;
|
|
Result := nil;
|
|
ChainIdx := -1;
|
|
end;
|
|
|
|
procedure TSparseAnsiStringArray.Rehash;
|
|
var I, J, R, F, H : Integer;
|
|
N : TSparseAnsiStringArrayHashList;
|
|
P, Q : PSparseAnsiStringRecord;
|
|
begin
|
|
R := SparseArrayRehashSize(FCount);
|
|
SetLength(N, R);
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
for J := 0 to Length(FHashList[I]) - 1 do
|
|
begin
|
|
P := @FHashList[I][J];
|
|
H := Integer(HashInteger(P^.Idx) and (R - 1));
|
|
F := Length(N[H]);
|
|
SetLength(N[H], F + 1);
|
|
Q := @N[H][F];
|
|
Q^.Idx := P^.Idx;
|
|
Q^.Value := P^.Value;
|
|
end;
|
|
FHashList := N;
|
|
FHashSize := R;
|
|
end;
|
|
|
|
function TSparseAnsiStringArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
function TSparseAnsiStringArray.GetItem(const Idx: Integer): AnsiString;
|
|
var P : PSparseAnsiStringRecord;
|
|
I, J : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
Result := P^.Value;
|
|
end;
|
|
|
|
function TSparseAnsiStringArray.LocateItem(const Idx: Integer; var Value: AnsiString): Boolean;
|
|
var P : PSparseAnsiStringRecord;
|
|
I, J : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if Assigned(P) then
|
|
begin
|
|
Value := P^.Value;
|
|
Result := True;
|
|
end
|
|
else
|
|
begin
|
|
Value := '';
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TSparseAnsiStringArray.SetItem(const Idx: Integer; const Value: AnsiString);
|
|
var P : PSparseAnsiStringRecord;
|
|
I, J : Integer;
|
|
L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if Assigned(P) then
|
|
P^.Value := Value
|
|
else
|
|
begin
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
I := Integer(HashInteger(Idx) and (L - 1));
|
|
J := Length(FHashList[I]);
|
|
SetLength(FHashList[I], J + 1);
|
|
P := @FHashList[I][J];
|
|
P^.Idx := Idx;
|
|
P^.Value := Value;
|
|
Inc(FCount);
|
|
if (FCount + 1) div SparseArrayAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
end;
|
|
|
|
function TSparseAnsiStringArray.HasItem(const Idx: Integer): Boolean;
|
|
var I, J : Integer;
|
|
begin
|
|
Result := Assigned(LocateItemRecord(Idx, I, J));
|
|
end;
|
|
|
|
function TSparseAnsiStringArray.IsEmpty: Boolean;
|
|
begin
|
|
Result := FCount = 0;
|
|
end;
|
|
|
|
function TSparseAnsiStringArray.FindFirst(var Idx: Integer; var Value: AnsiString): Boolean;
|
|
var I : Integer;
|
|
P : PSparseAnsiStringRecord;
|
|
begin
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
if Length(FHashList[I]) > 0 then
|
|
begin
|
|
P := @FHashList[I][0];
|
|
Idx := P^.Idx;
|
|
Value := P^.Value;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
Idx := -1;
|
|
Value := '';
|
|
Result := False;
|
|
end;
|
|
|
|
function TSparseAnsiStringArray.FindNext(var Idx: Integer; var Value: AnsiString): Boolean;
|
|
var P : PSparseAnsiStringRecord;
|
|
I, J, L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
Inc(J);
|
|
if J >= Length(FHashList[I]) then
|
|
begin
|
|
J := 0;
|
|
L := Length(FHashList);
|
|
Inc(I);
|
|
while I < L do
|
|
if Length(FHashList[I]) > 0 then
|
|
break
|
|
else
|
|
Inc(I);
|
|
if I >= L then
|
|
begin
|
|
Idx := -1;
|
|
Value := '';
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
P := @FHashList[I][J];
|
|
Idx := P^.Idx;
|
|
Value := P^.Value;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TSparseAnsiStringArray.Delete(const Idx: Integer);
|
|
var P : PSparseAnsiStringRecord;
|
|
I, J : Integer;
|
|
L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
P^.Value := '';
|
|
L := Length(FHashList[I]);
|
|
if J < L - 1 then
|
|
begin
|
|
Move(FHashList[I][J + 1], FHashList[I][J], (L - J - 1) * Sizeof(TSparseAnsiStringRecord));
|
|
ZeroMem(FHashList[I][L - 1], Sizeof(TSparseAnsiStringRecord));
|
|
end;
|
|
SetLength(FHashList[I], L - 1);
|
|
Dec(FCount);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ TSparseInt64Array }
|
|
{ }
|
|
procedure TSparseInt64Array.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is TSparseInt64Array then
|
|
begin
|
|
Clear;
|
|
L := Length(TSparseInt64Array(Source).FHashList);
|
|
SetLength(FHashList, L);
|
|
for I := 0 to L - 1 do
|
|
FHashList[I] := Copy(TSparseInt64Array(Source).FHashList[I]);
|
|
FHashSize := TSparseInt64Array(Source).FHashSize;
|
|
FCount := TSparseInt64Array(Source).FCount;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TSparseInt64Array.Clear;
|
|
begin
|
|
FHashList := nil;
|
|
FHashSize := 0;
|
|
FCount := 0;
|
|
end;
|
|
|
|
function TSparseInt64Array.IsEqual(const V: TObject): Boolean;
|
|
var I, J : Integer;
|
|
F, G : Integer;
|
|
P, Q : PSparseInt64Record;
|
|
begin
|
|
if V is TSparseInt64Array then
|
|
begin
|
|
if FCount <> TSparseInt64Array(V).FCount then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
for J := 0 to Length(FHashList[I]) - 1 do
|
|
begin
|
|
Q := @FHashList[I][J];
|
|
P := TSparseInt64Array(V).LocateItemRecord(Q^.Idx, F, G);
|
|
if not Assigned(P) or (P^.Value <> Q^.Value) then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function TSparseInt64Array.LocateItemRecord(const Idx: Integer;
|
|
var LookupIdx, ChainIdx: Integer): PSparseInt64Record;
|
|
var H, I, J, L : Integer;
|
|
P : TSparseInt64RecordArray;
|
|
begin
|
|
I := FHashSize;
|
|
if (I = 0) or (FCount = 0) then
|
|
begin
|
|
LookupIdx := -1;
|
|
ChainIdx := -1;
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
H := Integer(HashInteger(Idx) and (I - 1));
|
|
LookupIdx := H;
|
|
P := FHashList[H];
|
|
L := Length(P);
|
|
if L > 0 then
|
|
begin
|
|
Result := @P[0];
|
|
J := Idx;
|
|
for I := 0 to L - 1 do
|
|
if Result^.Idx = J then
|
|
begin
|
|
ChainIdx := I;
|
|
exit;
|
|
end
|
|
else
|
|
Inc(Result);
|
|
end;
|
|
Result := nil;
|
|
ChainIdx := -1;
|
|
end;
|
|
|
|
procedure TSparseInt64Array.Rehash;
|
|
var I, J, R, F, H : Integer;
|
|
N : TSparseInt64ArrayHashList;
|
|
P, Q : PSparseInt64Record;
|
|
begin
|
|
R := SparseArrayRehashSize(FCount);
|
|
SetLength(N, R);
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
for J := 0 to Length(FHashList[I]) - 1 do
|
|
begin
|
|
P := @FHashList[I][J];
|
|
H := Integer(HashInteger(P^.Idx) and (R - 1));
|
|
F := Length(N[H]);
|
|
SetLength(N[H], F + 1);
|
|
Q := @N[H][F];
|
|
Q^.Idx := P^.Idx;
|
|
Q^.Value := P^.Value;
|
|
end;
|
|
FHashList := N;
|
|
FHashSize := R;
|
|
end;
|
|
|
|
function TSparseInt64Array.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
function TSparseInt64Array.GetItem(const Idx: Integer): Int64;
|
|
var P : PSparseInt64Record;
|
|
I, J : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
Result := P^.Value;
|
|
end;
|
|
|
|
function TSparseInt64Array.LocateItem(const Idx: Integer; var Value: Int64): Boolean;
|
|
var P : PSparseInt64Record;
|
|
I, J : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if Assigned(P) then
|
|
begin
|
|
Value := P^.Value;
|
|
Result := True;
|
|
end
|
|
else
|
|
begin
|
|
Value := 0;
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TSparseInt64Array.SetItem(const Idx: Integer; const Value: Int64);
|
|
var P : PSparseInt64Record;
|
|
I, J : Integer;
|
|
L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if Assigned(P) then
|
|
P^.Value := Value
|
|
else
|
|
begin
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
I := Integer(HashInteger(Idx) and (L - 1));
|
|
J := Length(FHashList[I]);
|
|
SetLength(FHashList[I], J + 1);
|
|
P := @FHashList[I][J];
|
|
P^.Idx := Idx;
|
|
P^.Value := Value;
|
|
Inc(FCount);
|
|
if (FCount + 1) div SparseArrayAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
end;
|
|
|
|
function TSparseInt64Array.HasItem(const Idx: Integer): Boolean;
|
|
var I, J : Integer;
|
|
begin
|
|
Result := Assigned(LocateItemRecord(Idx, I, J));
|
|
end;
|
|
|
|
function TSparseInt64Array.IsEmpty: Boolean;
|
|
begin
|
|
Result := FCount = 0;
|
|
end;
|
|
|
|
function TSparseInt64Array.FindFirst(var Idx: Integer; var Value: Int64): Boolean;
|
|
var I : Integer;
|
|
P : PSparseInt64Record;
|
|
begin
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
if Length(FHashList[I]) > 0 then
|
|
begin
|
|
P := @FHashList[I][0];
|
|
Idx := P^.Idx;
|
|
Value := P^.Value;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
Idx := -1;
|
|
Value := 0;
|
|
Result := False;
|
|
end;
|
|
|
|
function TSparseInt64Array.FindNext(var Idx: Integer; var Value: Int64): Boolean;
|
|
var P : PSparseInt64Record;
|
|
I, J, L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
Inc(J);
|
|
if J >= Length(FHashList[I]) then
|
|
begin
|
|
J := 0;
|
|
L := Length(FHashList);
|
|
Inc(I);
|
|
while I < L do
|
|
if Length(FHashList[I]) > 0 then
|
|
break
|
|
else
|
|
Inc(I);
|
|
if I >= L then
|
|
begin
|
|
Idx := -1;
|
|
Value := 0;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
P := @FHashList[I][J];
|
|
Idx := P^.Idx;
|
|
Value := P^.Value;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TSparseInt64Array.Delete(const Idx: Integer);
|
|
var P : PSparseInt64Record;
|
|
I, J : Integer;
|
|
L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
L := Length(FHashList[I]);
|
|
if J < L - 1 then
|
|
Move(FHashList[I][J + 1], FHashList[I][J], (L - J - 1) * Sizeof(TSparseInt64Record));
|
|
SetLength(FHashList[I], L - 1);
|
|
Dec(FCount);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TSparseExtendedArray }
|
|
{ }
|
|
procedure TSparseExtendedArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is TSparseExtendedArray then
|
|
begin
|
|
Clear;
|
|
L := Length(TSparseExtendedArray(Source).FHashList);
|
|
SetLength(FHashList, L);
|
|
for I := 0 to L - 1 do
|
|
FHashList[I] := Copy(TSparseExtendedArray(Source).FHashList[I]);
|
|
FHashSize := TSparseExtendedArray(Source).FHashSize;
|
|
FCount := TSparseExtendedArray(Source).FCount;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TSparseExtendedArray.Clear;
|
|
begin
|
|
FHashList := nil;
|
|
FHashSize := 0;
|
|
FCount := 0;
|
|
end;
|
|
|
|
function TSparseExtendedArray.IsEqual(const V: TObject): Boolean;
|
|
var I, J : Integer;
|
|
F, G : Integer;
|
|
P, Q : PSparseExtendedRecord;
|
|
begin
|
|
if V is TSparseExtendedArray then
|
|
begin
|
|
if FCount <> TSparseExtendedArray(V).FCount then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
for J := 0 to Length(FHashList[I]) - 1 do
|
|
begin
|
|
Q := @FHashList[I][J];
|
|
P := TSparseExtendedArray(V).LocateItemRecord(Q^.Idx, F, G);
|
|
if not Assigned(P) or (P^.Value <> Q^.Value) then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function TSparseExtendedArray.LocateItemRecord(const Idx: Integer;
|
|
var LookupIdx, ChainIdx: Integer): PSparseExtendedRecord;
|
|
var H, I, J, L : Integer;
|
|
P : TSparseExtendedRecordArray;
|
|
begin
|
|
I := FHashSize;
|
|
if (I = 0) or (FCount = 0) then
|
|
begin
|
|
LookupIdx := -1;
|
|
ChainIdx := -1;
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
H := Integer(HashInteger(Idx) and (I - 1));
|
|
LookupIdx := H;
|
|
P := FHashList[H];
|
|
L := Length(P);
|
|
if L > 0 then
|
|
begin
|
|
Result := @P[0];
|
|
J := Idx;
|
|
for I := 0 to L - 1 do
|
|
if Result^.Idx = J then
|
|
begin
|
|
ChainIdx := I;
|
|
exit;
|
|
end
|
|
else
|
|
Inc(Result);
|
|
end;
|
|
Result := nil;
|
|
ChainIdx := -1;
|
|
end;
|
|
|
|
procedure TSparseExtendedArray.Rehash;
|
|
var I, J, R, F, H : Integer;
|
|
N : TSparseExtendedArrayHashList;
|
|
P, Q : PSparseExtendedRecord;
|
|
begin
|
|
R := SparseArrayRehashSize(FCount);
|
|
SetLength(N, R);
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
for J := 0 to Length(FHashList[I]) - 1 do
|
|
begin
|
|
P := @FHashList[I][J];
|
|
H := Integer(HashInteger(P^.Idx) and (R - 1));
|
|
F := Length(N[H]);
|
|
SetLength(N[H], F + 1);
|
|
Q := @N[H][F];
|
|
Q^.Idx := P^.Idx;
|
|
Q^.Value := P^.Value;
|
|
end;
|
|
FHashList := N;
|
|
FHashSize := R;
|
|
end;
|
|
|
|
function TSparseExtendedArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
function TSparseExtendedArray.GetItem(const Idx: Integer): Extended;
|
|
var P : PSparseExtendedRecord;
|
|
I, J : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
Result := P^.Value;
|
|
end;
|
|
|
|
function TSparseExtendedArray.LocateItem(const Idx: Integer; var Value: Extended): Boolean;
|
|
var P : PSparseExtendedRecord;
|
|
I, J : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if Assigned(P) then
|
|
begin
|
|
Value := P^.Value;
|
|
Result := True;
|
|
end
|
|
else
|
|
begin
|
|
Value := 0.0;
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TSparseExtendedArray.SetItem(const Idx: Integer; const Value: Extended);
|
|
var P : PSparseExtendedRecord;
|
|
I, J : Integer;
|
|
L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if Assigned(P) then
|
|
P^.Value := Value
|
|
else
|
|
begin
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
I := Integer(HashInteger(Idx) and (L - 1));
|
|
J := Length(FHashList[I]);
|
|
SetLength(FHashList[I], J + 1);
|
|
P := @FHashList[I][J];
|
|
P^.Idx := Idx;
|
|
P^.Value := Value;
|
|
Inc(FCount);
|
|
if (FCount + 1) div SparseArrayAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
end;
|
|
|
|
function TSparseExtendedArray.HasItem(const Idx: Integer): Boolean;
|
|
var I, J : Integer;
|
|
begin
|
|
Result := Assigned(LocateItemRecord(Idx, I, J));
|
|
end;
|
|
|
|
function TSparseExtendedArray.IsEmpty: Boolean;
|
|
begin
|
|
Result := FCount = 0;
|
|
end;
|
|
|
|
function TSparseExtendedArray.FindFirst(var Idx: Integer; var Value: Extended): Boolean;
|
|
var I : Integer;
|
|
P : PSparseExtendedRecord;
|
|
begin
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
if Length(FHashList[I]) > 0 then
|
|
begin
|
|
P := @FHashList[I][0];
|
|
Idx := P^.Idx;
|
|
Value := P^.Value;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
Idx := -1;
|
|
Value := 0.0;
|
|
Result := False;
|
|
end;
|
|
|
|
function TSparseExtendedArray.FindNext(var Idx: Integer; var Value: Extended): Boolean;
|
|
var P : PSparseExtendedRecord;
|
|
I, J, L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
Inc(J);
|
|
if J >= Length(FHashList[I]) then
|
|
begin
|
|
J := 0;
|
|
L := Length(FHashList);
|
|
Inc(I);
|
|
while I < L do
|
|
if Length(FHashList[I]) > 0 then
|
|
break
|
|
else
|
|
Inc(I);
|
|
if I >= L then
|
|
begin
|
|
Idx := -1;
|
|
Value := 0.0;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
P := @FHashList[I][J];
|
|
Idx := P^.Idx;
|
|
Value := P^.Value;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TSparseExtendedArray.Delete(const Idx: Integer);
|
|
var P : PSparseExtendedRecord;
|
|
I, J : Integer;
|
|
L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
L := Length(FHashList[I]);
|
|
if J < L - 1 then
|
|
Move(FHashList[I][J + 1], FHashList[I][J], (L - J - 1) * Sizeof(TSparseExtendedRecord));
|
|
SetLength(FHashList[I], L - 1);
|
|
Dec(FCount);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TSparseObjectArray }
|
|
{ }
|
|
constructor TSparseObjectArray.Create(const AIsItemOwner: Boolean);
|
|
begin
|
|
inherited Create;
|
|
FIsItemOwner := AIsItemOwner;
|
|
end;
|
|
|
|
destructor TSparseObjectArray.Destroy;
|
|
begin
|
|
Clear;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TSparseObjectArray.Init;
|
|
begin
|
|
inherited Init;
|
|
FIsItemOwner := False;
|
|
end;
|
|
|
|
procedure TSparseObjectArray.Assign(const Source: TObject);
|
|
var I, L : Integer;
|
|
begin
|
|
if Source is TSparseObjectArray then
|
|
begin
|
|
Clear;
|
|
L := Length(TSparseObjectArray(Source).FHashList);
|
|
SetLength(FHashList, L);
|
|
for I := 0 to L - 1 do
|
|
FHashList[I] := Copy(TSparseObjectArray(Source).FHashList[I]);
|
|
FHashSize := TSparseObjectArray(Source).FHashSize;
|
|
FCount := TSparseObjectArray(Source).FCount;
|
|
FIsItemOwner := False;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TSparseObjectArray.Clear;
|
|
var I, J : Integer;
|
|
begin
|
|
if FIsItemOwner then
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
for J := 0 to Length(FHashList[I]) - 1 do
|
|
FreeAndNil(FHashList[I][J].Value);
|
|
FHashList := nil;
|
|
FHashSize := 0;
|
|
FCount := 0;
|
|
end;
|
|
|
|
function TSparseObjectArray.IsEqual(const V: TObject): Boolean;
|
|
var I, J : Integer;
|
|
F, G : Integer;
|
|
P, Q : PSparseObjectRecord;
|
|
begin
|
|
if V is TSparseObjectArray then
|
|
begin
|
|
if FCount <> TSparseObjectArray(V).FCount then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
for J := 0 to Length(FHashList[I]) - 1 do
|
|
begin
|
|
Q := @FHashList[I][J];
|
|
P := TSparseObjectArray(V).LocateItemRecord(Q^.Idx, F, G);
|
|
if not Assigned(P) or (P^.Value <> Q^.Value) then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end
|
|
else
|
|
Result := inherited IsEqual(V);
|
|
end;
|
|
|
|
function TSparseObjectArray.LocateItemRecord(const Idx: Integer;
|
|
var LookupIdx, ChainIdx: Integer): PSparseObjectRecord;
|
|
var H, I, J, L : Integer;
|
|
P : TSparseObjectRecordArray;
|
|
begin
|
|
I := FHashSize;
|
|
if (I = 0) or (FCount = 0) then
|
|
begin
|
|
LookupIdx := -1;
|
|
ChainIdx := -1;
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
H := Integer(HashInteger(Idx) and (I - 1));
|
|
LookupIdx := H;
|
|
P := FHashList[H];
|
|
L := Length(P);
|
|
if L > 0 then
|
|
begin
|
|
Result := @P[0];
|
|
J := Idx;
|
|
for I := 0 to L - 1 do
|
|
if Result^.Idx = J then
|
|
begin
|
|
ChainIdx := I;
|
|
exit;
|
|
end
|
|
else
|
|
Inc(Result);
|
|
end;
|
|
Result := nil;
|
|
ChainIdx := -1;
|
|
end;
|
|
|
|
procedure TSparseObjectArray.Rehash;
|
|
var I, J, R, F, H : Integer;
|
|
N : TSparseObjectArrayHashList;
|
|
P, Q : PSparseObjectRecord;
|
|
begin
|
|
R := SparseArrayRehashSize(FCount);
|
|
SetLength(N, R);
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
for J := 0 to Length(FHashList[I]) - 1 do
|
|
begin
|
|
P := @FHashList[I][J];
|
|
H := Integer(HashInteger(P^.Idx) and (R - 1));
|
|
F := Length(N[H]);
|
|
SetLength(N[H], F + 1);
|
|
Q := @N[H][F];
|
|
Q^.Idx := P^.Idx;
|
|
Q^.Value := P^.Value;
|
|
end;
|
|
FHashList := N;
|
|
FHashSize := R;
|
|
end;
|
|
|
|
function TSparseObjectArray.GetCount: Integer;
|
|
begin
|
|
Result := FCount;
|
|
end;
|
|
|
|
function TSparseObjectArray.GetItem(const Idx: Integer): TObject;
|
|
var P : PSparseObjectRecord;
|
|
I, J : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
Result := P^.Value;
|
|
end;
|
|
|
|
function TSparseObjectArray.LocateItem(const Idx: Integer; var Value: TObject): Boolean;
|
|
var P : PSparseObjectRecord;
|
|
I, J : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if Assigned(P) then
|
|
begin
|
|
Value := P^.Value;
|
|
Result := True;
|
|
end
|
|
else
|
|
begin
|
|
Value := nil;
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TSparseObjectArray.SetItem(const Idx: Integer; const Value: TObject);
|
|
var P : PSparseObjectRecord;
|
|
I, J : Integer;
|
|
L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if Assigned(P) then
|
|
P^.Value := Value
|
|
else
|
|
begin
|
|
L := FHashSize;
|
|
if L = 0 then
|
|
begin
|
|
Rehash;
|
|
L := FHashSize;
|
|
Assert(L > 0);
|
|
end;
|
|
I := Integer(HashInteger(Idx) and (L - 1));
|
|
J := Length(FHashList[I]);
|
|
SetLength(FHashList[I], J + 1);
|
|
P := @FHashList[I][J];
|
|
P^.Idx := Idx;
|
|
P^.Value := Value;
|
|
Inc(FCount);
|
|
if (FCount + 1) div SparseArrayAverageHashChainSize > L then
|
|
Rehash;
|
|
end;
|
|
end;
|
|
|
|
function TSparseObjectArray.HasItem(const Idx: Integer): Boolean;
|
|
var I, J : Integer;
|
|
begin
|
|
Result := Assigned(LocateItemRecord(Idx, I, J));
|
|
end;
|
|
|
|
function TSparseObjectArray.IsEmpty: Boolean;
|
|
begin
|
|
Result := FCount = 0;
|
|
end;
|
|
|
|
function TSparseObjectArray.FindFirst(var Idx: Integer; var Value: TObject): Boolean;
|
|
var I : Integer;
|
|
P : PSparseObjectRecord;
|
|
begin
|
|
for I := 0 to Length(FHashList) - 1 do
|
|
if Length(FHashList[I]) > 0 then
|
|
begin
|
|
P := @FHashList[I][0];
|
|
Idx := P^.Idx;
|
|
Value := P^.Value;
|
|
Result := True;
|
|
exit;
|
|
end;
|
|
Idx := -1;
|
|
Value := nil;
|
|
Result := False;
|
|
end;
|
|
|
|
function TSparseObjectArray.FindNext(var Idx: Integer; var Value: TObject): Boolean;
|
|
var P : PSparseObjectRecord;
|
|
I, J, L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
Inc(J);
|
|
if J >= Length(FHashList[I]) then
|
|
begin
|
|
J := 0;
|
|
L := Length(FHashList);
|
|
Inc(I);
|
|
while I < L do
|
|
if Length(FHashList[I]) > 0 then
|
|
break
|
|
else
|
|
Inc(I);
|
|
if I >= L then
|
|
begin
|
|
Idx := -1;
|
|
Value := nil;
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
P := @FHashList[I][J];
|
|
Idx := P^.Idx;
|
|
Value := P^.Value;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TSparseObjectArray.Delete(const Idx: Integer);
|
|
var P : PSparseObjectRecord;
|
|
I, J : Integer;
|
|
L : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
if FIsItemOwner then
|
|
FreeAndNil(P^.Value);
|
|
L := Length(FHashList[I]);
|
|
if J < L - 1 then
|
|
Move(FHashList[I][J + 1], FHashList[I][J], (L - J - 1) * Sizeof(TSparseObjectRecord));
|
|
SetLength(FHashList[I], L - 1);
|
|
Dec(FCount);
|
|
end;
|
|
|
|
function TSparseObjectArray.ReleaseItem(const Idx: Integer): TObject;
|
|
var P : PSparseObjectRecord;
|
|
I, J : Integer;
|
|
begin
|
|
P := LocateItemRecord(Idx, I, J);
|
|
if not Assigned(P) then
|
|
IndexError;
|
|
Result := P^.Value;
|
|
P^.Value := nil;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoublyLinkedItem }
|
|
{ }
|
|
function TDoublyLinkedItem.HasNext: Boolean;
|
|
begin
|
|
Result := Assigned(Next);
|
|
end;
|
|
|
|
function TDoublyLinkedItem.Last: TDoublyLinkedItem;
|
|
var P : TDoublyLinkedItem;
|
|
begin
|
|
P := self;
|
|
repeat
|
|
Result := P;
|
|
P := P.Next;
|
|
until not Assigned(P);
|
|
end;
|
|
|
|
function TDoublyLinkedItem.Count: Integer;
|
|
var N : TDoublyLinkedItem;
|
|
begin
|
|
Result := 1;
|
|
N := FNext;
|
|
while Assigned(N) do
|
|
begin
|
|
Inc(Result);
|
|
N := N.Next;
|
|
end;
|
|
end;
|
|
|
|
function TDoublyLinkedItem.HasPrev: Boolean;
|
|
begin
|
|
Result := Assigned(FPrev);
|
|
end;
|
|
|
|
function TDoublyLinkedItem.First: TDoublyLinkedItem;
|
|
var P : TDoublyLinkedItem;
|
|
begin
|
|
P := self;
|
|
repeat
|
|
Result := P;
|
|
P := P.Prev;
|
|
until not Assigned(P);
|
|
end;
|
|
|
|
procedure TDoublyLinkedItem.Delete;
|
|
begin
|
|
Remove;
|
|
Free;
|
|
end;
|
|
|
|
procedure TDoublyLinkedItem.Remove;
|
|
begin
|
|
if Assigned(Next) then
|
|
Next.Prev := FPrev;
|
|
if Assigned(Prev) then
|
|
Prev.Next := FNext;
|
|
end;
|
|
|
|
function TDoublyLinkedItem.RemoveNext: TDoublyLinkedItem;
|
|
begin
|
|
Result := FNext;
|
|
if Assigned(Result) then
|
|
begin
|
|
FNext := Result.Next;
|
|
if Assigned(FNext) then
|
|
FNext.Prev := self;
|
|
end;
|
|
end;
|
|
|
|
procedure TDoublyLinkedItem.DeleteNext;
|
|
begin
|
|
RemoveNext.Free;
|
|
end;
|
|
|
|
function TDoublyLinkedItem.RemovePrev: TDoublyLinkedItem;
|
|
begin
|
|
Result := FPrev;
|
|
if Assigned(Result) then
|
|
begin
|
|
FPrev := Result.Prev;
|
|
if Assigned(FPrev) then
|
|
FPrev.Next := self;
|
|
end;
|
|
end;
|
|
|
|
procedure TDoublyLinkedItem.DeletePrev;
|
|
begin
|
|
RemovePrev.Free;
|
|
end;
|
|
|
|
procedure TDoublyLinkedItem.InsertAfter(const Item: TDoublyLinkedItem);
|
|
begin
|
|
Assert(Assigned(Item));
|
|
Item.Next := FNext;
|
|
Item.Prev := self;
|
|
if Assigned(FNext) then
|
|
FNext.Prev := Item;
|
|
FNext := Item;
|
|
end;
|
|
|
|
procedure TDoublyLinkedItem.InsertBefore(const Item: TDoublyLinkedItem);
|
|
begin
|
|
Assert(Assigned(Item));
|
|
Item.Next := self;
|
|
Item.Prev := FPrev;
|
|
if Assigned(FPrev) then
|
|
FPrev.Next := Item;
|
|
FPrev := Item;
|
|
end;
|
|
|
|
destructor TDoublyLinkedItem.DestroyList;
|
|
var N : TDoublyLinkedItem;
|
|
begin
|
|
while Assigned(FNext) do
|
|
begin
|
|
N := FNext;
|
|
FNext := N.Next;
|
|
N.Free;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoublyLinkedInteger }
|
|
{ }
|
|
constructor TDoublyLinkedInteger.Create(const V: Integer);
|
|
begin
|
|
inherited Create;
|
|
Value := V;
|
|
end;
|
|
|
|
procedure TDoublyLinkedInteger.InsertAfter(const V: Integer);
|
|
begin
|
|
inherited InsertAfter(TDoublyLinkedInteger.Create(V));
|
|
end;
|
|
|
|
procedure TDoublyLinkedInteger.InsertBefore(const V: Integer);
|
|
begin
|
|
inherited InsertBefore(TDoublyLinkedInteger.Create(V));
|
|
end;
|
|
|
|
procedure TDoublyLinkedInteger.InsertFirst(const V: Integer);
|
|
begin
|
|
TDoublyLinkedInteger(First).InsertBefore(V);
|
|
end;
|
|
|
|
procedure TDoublyLinkedInteger.Append(const V: Integer);
|
|
begin
|
|
TDoublyLinkedInteger(Last).InsertAfter(V);
|
|
end;
|
|
|
|
function TDoublyLinkedInteger.FindNext(const Find: Integer): TDoublyLinkedInteger;
|
|
begin
|
|
Result := self;
|
|
repeat
|
|
if Result.Value = Find then
|
|
exit;
|
|
Result := TDoublyLinkedInteger(Result.Next);
|
|
until not Assigned(Result);
|
|
end;
|
|
|
|
function TDoublyLinkedInteger.FindPrev(const Find: Integer): TDoublyLinkedInteger;
|
|
begin
|
|
Result := self;
|
|
repeat
|
|
if Result.Value = Find then
|
|
exit;
|
|
Result := TDoublyLinkedInteger(Result.Prev);
|
|
until not Assigned(Result);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoublyLinkedExtended }
|
|
{ }
|
|
constructor TDoublyLinkedExtended.Create(const V: Extended);
|
|
begin
|
|
inherited Create;
|
|
Value := V;
|
|
end;
|
|
|
|
procedure TDoublyLinkedExtended.InsertAfter(const V: Extended);
|
|
begin
|
|
inherited InsertAfter(TDoublyLinkedExtended.Create(V));
|
|
end;
|
|
|
|
procedure TDoublyLinkedExtended.InsertBefore(const V: Extended);
|
|
begin
|
|
inherited InsertBefore(TDoublyLinkedExtended.Create(V));
|
|
end;
|
|
|
|
procedure TDoublyLinkedExtended.InsertFirst(const V: Extended);
|
|
begin
|
|
TDoublyLinkedExtended(First).InsertBefore(V);
|
|
end;
|
|
|
|
procedure TDoublyLinkedExtended.Append(const V: Extended);
|
|
begin
|
|
TDoublyLinkedExtended(Last).InsertAfter(V);
|
|
end;
|
|
|
|
function TDoublyLinkedExtended.FindNext(const Find: Extended): TDoublyLinkedExtended;
|
|
begin
|
|
Result := self;
|
|
repeat
|
|
if Result.Value = Find then
|
|
exit;
|
|
Result := TDoublyLinkedExtended(Result.Next);
|
|
until not Assigned(Result);
|
|
end;
|
|
|
|
function TDoublyLinkedExtended.FindPrev(const Find: Extended): TDoublyLinkedExtended;
|
|
begin
|
|
Result := self;
|
|
repeat
|
|
if Result.Value = Find then
|
|
exit;
|
|
Result := TDoublyLinkedExtended(Result.Prev);
|
|
until not Assigned(Result);
|
|
end;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{ }
|
|
{ TDoublyLinkedString }
|
|
{ }
|
|
constructor TDoublyLinkedString.Create(const V: AnsiString);
|
|
begin
|
|
inherited Create;
|
|
Value := V;
|
|
end;
|
|
|
|
procedure TDoublyLinkedString.InsertAfter(const V: AnsiString);
|
|
begin
|
|
inherited InsertAfter(TDoublyLinkedString.Create(V));
|
|
end;
|
|
|
|
procedure TDoublyLinkedString.InsertBefore(const V: AnsiString);
|
|
begin
|
|
inherited InsertBefore(TDoublyLinkedString.Create(V));
|
|
end;
|
|
|
|
procedure TDoublyLinkedString.InsertFirst(const V: AnsiString);
|
|
begin
|
|
TDoublyLinkedString(First).InsertBefore(V);
|
|
end;
|
|
|
|
procedure TDoublyLinkedString.Append(const V: AnsiString);
|
|
begin
|
|
TDoublyLinkedString(Last).InsertAfter(V);
|
|
end;
|
|
|
|
function TDoublyLinkedString.FindNext(const Find: AnsiString): TDoublyLinkedString;
|
|
begin
|
|
Result := self;
|
|
repeat
|
|
if Result.Value = Find then
|
|
exit;
|
|
Result := TDoublyLinkedString(Result.Next);
|
|
until not Assigned(Result);
|
|
end;
|
|
|
|
function TDoublyLinkedString.FindPrev(const Find: AnsiString): TDoublyLinkedString;
|
|
begin
|
|
Result := self;
|
|
repeat
|
|
if Result.Value = Find then
|
|
exit;
|
|
Result := TDoublyLinkedString(Result.Prev);
|
|
until not Assigned(Result);
|
|
end;
|
|
|
|
|
|
|
|
{$ENDIF}
|
|
{ }
|
|
{ TDoublyLinkedObject }
|
|
{ }
|
|
constructor TDoublyLinkedObject.Create(const V: TObject);
|
|
begin
|
|
inherited Create;
|
|
Value := V;
|
|
end;
|
|
|
|
procedure TDoublyLinkedObject.InsertAfter(const V: TObject);
|
|
begin
|
|
inherited InsertAfter(TDoublyLinkedObject.Create(V));
|
|
end;
|
|
|
|
procedure TDoublyLinkedObject.InsertBefore(const V: TObject);
|
|
begin
|
|
inherited InsertBefore(TDoublyLinkedObject.Create(V));
|
|
end;
|
|
|
|
procedure TDoublyLinkedObject.InsertFirst(const V: TObject);
|
|
begin
|
|
TDoublyLinkedObject(First).InsertBefore(V);
|
|
end;
|
|
|
|
procedure TDoublyLinkedObject.Append(const V: TObject);
|
|
begin
|
|
TDoublyLinkedObject(Last).InsertAfter(V);
|
|
end;
|
|
|
|
function TDoublyLinkedObject.FindNext(const Find: TObject): TDoublyLinkedObject;
|
|
begin
|
|
Result := self;
|
|
repeat
|
|
if Result.Value = Find then
|
|
exit;
|
|
Result := TDoublyLinkedObject(Result.Next);
|
|
until not Assigned(Result);
|
|
end;
|
|
|
|
function TDoublyLinkedObject.FindPrev(const Find: TObject): TDoublyLinkedObject;
|
|
begin
|
|
Result := self;
|
|
repeat
|
|
if Result.Value = Find then
|
|
exit;
|
|
Result := TDoublyLinkedObject(Result.Prev);
|
|
until not Assigned(Result);
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Open array to Linked list }
|
|
{ }
|
|
function AsDoublyLinkedIntegerList(const V: Array of Integer): TDoublyLinkedInteger;
|
|
var I, L : TDoublyLinkedInteger;
|
|
F : Integer;
|
|
begin
|
|
Result := nil;
|
|
L := nil;
|
|
for F := 0 to High(V) do
|
|
begin
|
|
I := TDoublyLinkedInteger.Create(V [F]);
|
|
if not Assigned(L) then
|
|
begin
|
|
L := I;
|
|
Result := I;
|
|
end else
|
|
begin
|
|
L.InsertAfter(I);
|
|
L := I;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function AsDoublyLinkedExtendedList(const V: Array of Extended): TDoublyLinkedExtended;
|
|
var I, L : TDoublyLinkedExtended;
|
|
F : Integer;
|
|
begin
|
|
Result := nil;
|
|
L := nil;
|
|
for F := 0 to High(V) do
|
|
begin
|
|
I := TDoublyLinkedExtended.Create(V [F]);
|
|
if not Assigned(L) then
|
|
begin
|
|
L := I;
|
|
Result := I;
|
|
end else
|
|
begin
|
|
L.InsertAfter(I);
|
|
L := I;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
function AsDoublyLinkedStringList(const V: Array of AnsiString): TDoublyLinkedString;
|
|
var I, L : TDoublyLinkedString;
|
|
F : Integer;
|
|
begin
|
|
Result := nil;
|
|
L := nil;
|
|
for F := 0 to High(V) do
|
|
begin
|
|
I := TDoublyLinkedString.Create(V [F]);
|
|
if not Assigned(L) then
|
|
begin
|
|
L := I;
|
|
Result := I;
|
|
end else
|
|
begin
|
|
L.InsertAfter(I);
|
|
L := I;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
{ }
|
|
{ TDoublyLinkedList }
|
|
{ }
|
|
Destructor TDoublyLinkedList.Destroy;
|
|
begin
|
|
DeleteList;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TDoublyLinkedList.IsEmpty: Boolean;
|
|
begin
|
|
Result := not Assigned(FFirst);
|
|
end;
|
|
|
|
procedure TDoublyLinkedList.Append(const Item: TDoublyLinkedItem);
|
|
begin
|
|
if not Assigned(Item) then
|
|
exit;
|
|
if not Assigned(FLast) then
|
|
begin
|
|
FFirst := Item;
|
|
FLast := Item;
|
|
Item.Prev := nil;
|
|
Item.Next := nil;
|
|
end else
|
|
begin
|
|
FLast.InsertAfter(Item);
|
|
FLast := Item;
|
|
end;
|
|
Inc(FCount);
|
|
end;
|
|
|
|
procedure TDoublyLinkedList.InsertFront(const Item: TDoublyLinkedItem);
|
|
begin
|
|
if not Assigned(Item) then
|
|
exit;
|
|
if not Assigned(FFirst) then
|
|
begin
|
|
FFirst := Item;
|
|
FLast := Item;
|
|
Item.Prev := nil;
|
|
Item.Next := nil;
|
|
end else
|
|
begin
|
|
FFirst.InsertBefore(Item);
|
|
FFirst := Item;
|
|
end;
|
|
Inc(FCount);
|
|
end;
|
|
|
|
procedure TDoublyLinkedList.Remove(const Item: TDoublyLinkedItem);
|
|
begin
|
|
if not Assigned(Item) then
|
|
exit;
|
|
if FFirst = Item then
|
|
FFirst := Item.Next;
|
|
if FLast = Item then
|
|
FLast := Item.Prev;
|
|
Item.Remove;
|
|
Dec(FCount);
|
|
end;
|
|
|
|
function TDoublyLinkedList.RemoveFirst: TDoublyLinkedItem;
|
|
var N : TDoublyLinkedItem;
|
|
begin
|
|
Result := FFirst;
|
|
if not Assigned(Result) then
|
|
exit;
|
|
if Result = FLast then
|
|
begin
|
|
FFirst := nil;
|
|
FLast := nil;
|
|
end else
|
|
begin
|
|
N := Result.Next;
|
|
Result.Remove;
|
|
FFirst := N;
|
|
end;
|
|
Dec(FCount);
|
|
end;
|
|
|
|
function TDoublyLinkedList.RemoveLast: TDoublyLinkedItem;
|
|
var P : TDoublyLinkedItem;
|
|
begin
|
|
Result := FLast;
|
|
if not Assigned(Result) then
|
|
exit;
|
|
if Result = FFirst then
|
|
begin
|
|
FFirst := nil;
|
|
FLast := nil;
|
|
end
|
|
else
|
|
begin
|
|
P := Result.Prev;
|
|
Result.Remove;
|
|
FLast := P;
|
|
end;
|
|
Dec(FCount);
|
|
end;
|
|
|
|
procedure TDoublyLinkedList.Delete(const Item: TDoublyLinkedItem);
|
|
begin
|
|
Remove(Item);
|
|
Item.Free;
|
|
end;
|
|
|
|
procedure TDoublyLinkedList.DeleteFirst;
|
|
begin
|
|
RemoveFirst.Free;
|
|
end;
|
|
|
|
procedure TDoublyLinkedList.DeleteLast;
|
|
begin
|
|
RemoveLast.Free;
|
|
end;
|
|
|
|
procedure TDoublyLinkedList.DeleteList;
|
|
var F : TDoublyLinkedItem;
|
|
begin
|
|
F := FFirst;
|
|
FFirst := nil;
|
|
FLast := nil;
|
|
if Assigned(F) then
|
|
F.DestroyList;
|
|
FCount := 0;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ Self testing code }
|
|
{ }
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF TEST}
|
|
{$ASSERTIONS ON}
|
|
procedure Test_Array;
|
|
var I : Integer;
|
|
F : TIntegerArray;
|
|
begin
|
|
// TIntegerArray
|
|
F := TIntegerArray.Create;
|
|
for I := 0 to 16384 do
|
|
Assert(F.AppendItem(I) = I, 'Array.AppendItem');
|
|
Assert(F.Count = 16385, 'Array.Count');
|
|
for I := 0 to 16384 do
|
|
Assert(F[I] = I, 'Array.GetItem');
|
|
for I := 0 to 16384 do
|
|
F[I] := I + 1;
|
|
for I := 0 to 16384 do
|
|
Assert(F[I] = I + 1, 'Array.SetItem');
|
|
F.Delete(0, 1);
|
|
Assert(F.Count = 16384, 'Array.Delete');
|
|
for I := 0 to 16383 do
|
|
Assert(F[I] = I + 2, 'Array.Delete');
|
|
F.Insert(0, 2);
|
|
F[0] := 0;
|
|
F[1] := 1;
|
|
for I := 0 to 16384 do
|
|
Assert(F[I] = I, 'Array.Insert');
|
|
|
|
F.Count := 4;
|
|
Assert(F.Count = 4, 'Array.SetCount');
|
|
F[0] := 9;
|
|
F[1] := -2;
|
|
F[2] := 3;
|
|
F[3] := 4;
|
|
F.Sort;
|
|
Assert(F[0] = -2, 'Array.Sort');
|
|
Assert(F[1] = 3, 'Array.Sort');
|
|
Assert(F[2] = 4, 'Array.Sort');
|
|
Assert(F[3] = 9, 'Array.Sort');
|
|
|
|
F.Count := 7;
|
|
F[0] := 3;
|
|
F[1] := 5;
|
|
F[2] := 5;
|
|
F[3] := 2;
|
|
F[4] := 5;
|
|
F[5] := 5;
|
|
F[6] := 1;
|
|
F.Sort;
|
|
Assert(F[0] = 1, 'Array.Sort');
|
|
Assert(F[1] = 2, 'Array.Sort');
|
|
Assert(F[2] = 3, 'Array.Sort');
|
|
Assert(F[3] = 5, 'Array.Sort');
|
|
Assert(F[4] = 5, 'Array.Sort');
|
|
Assert(F[5] = 5, 'Array.Sort');
|
|
Assert(F[6] = 5, 'Array.Sort');
|
|
|
|
F.Count := 7;
|
|
F[0] := 1;
|
|
F[1] := 5;
|
|
F[2] := 5;
|
|
F[3] := 1;
|
|
F[4] := 5;
|
|
F[5] := 2;
|
|
F[6] := 1;
|
|
F.RemoveDuplicates(False);
|
|
Assert(F.Count = 3, 'Array.RemoveDuplicates');
|
|
Assert(F[0] = 1, 'Array.RemoveDuplicates');
|
|
Assert(F[1] = 5, 'Array.RemoveDuplicates');
|
|
Assert(F[2] = 2, 'Array.RemoveDuplicates');
|
|
|
|
F.Count := 7;
|
|
F[0] := 1;
|
|
F[1] := 1;
|
|
F[2] := 1;
|
|
F[3] := 2;
|
|
F[4] := 5;
|
|
F[5] := 5;
|
|
F[6] := 5;
|
|
F.RemoveDuplicates(True);
|
|
Assert(F.Count = 3, 'Array.RemoveDuplicates');
|
|
Assert(F[0] = 1, 'Array.RemoveDuplicates');
|
|
Assert(F[1] = 2, 'Array.RemoveDuplicates');
|
|
Assert(F[2] = 5, 'Array.RemoveDuplicates');
|
|
|
|
F.Clear;
|
|
Assert(F.Count = 0, 'Array.Clear');
|
|
F.Free;
|
|
end;
|
|
|
|
procedure Test_Dictionary;
|
|
{$IFDEF SupportAnsiString}
|
|
var F : TIntegerDictionaryA;
|
|
G : TStringDictionaryA;
|
|
I : Integer;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF SupportAnsiString}
|
|
F := TIntegerDictionaryA.Create;
|
|
for I := 0 to 16384 do
|
|
F.Add(IntToStringA(I), I);
|
|
Assert(F.Count = 16385, 'Dictionary.Count');
|
|
for I := 0 to 16384 do
|
|
Assert(F.GetKeyByIndex(I) = IntToStringA(I), 'Dictionary.GetKeyByIndex');
|
|
for I := 0 to 16384 do
|
|
Assert(F[IntToStringA(I)] = I, 'Dictionary.GetItem');
|
|
Assert(F['0'] = 0, 'Dictionary.GetItem');
|
|
Assert(F['4001'] = 4001, 'Dictionary.GetItem');
|
|
Assert(F['16384'] = 16384, 'Dictionary.GetItem');
|
|
for I := 0 to 16384 do
|
|
Assert(F.GetItemByIndex(I) = I, 'Dictionary.GetItemByIndex');
|
|
Assert(F.HasKey('5'), 'Dictionary.HasKey');
|
|
Assert(not F.HasKey('X'), 'Dictionary.HasKey');
|
|
F.Rename('5', 'X');
|
|
Assert(not F.HasKey('5'), 'Dictionary.Rename');
|
|
Assert(F.HasKey('X'), 'Dictionary.Rename');
|
|
Assert(F['X'] = 5, 'Dictionary.Rename');
|
|
F.Delete('X');
|
|
Assert(not F.HasKey('X'), 'Dictionary.Delete');
|
|
Assert(F.Count = 16384, 'Dictionary.Delete');
|
|
F.Delete('0');
|
|
Assert(not F.HasKey('0'), 'Dictionary.Delete');
|
|
Assert(F.Count = 16383, 'Dictionary.Delete');
|
|
F.DeleteItemByIndex(0);
|
|
Assert(not F.HasKey('1'), 'Dictionary.DeleteItemByIndex');
|
|
Assert(F.Count = 16382, 'Dictionary.DeleteItemByIndex');
|
|
F.Free;
|
|
|
|
G := TStringDictionaryA.Create;
|
|
for I := 0 to 16384 do
|
|
G.Add(IntToStringA(I), IntToStr(I));
|
|
Assert(G.Count = 16385, 'Dictionary.Count');
|
|
for I := 0 to 16384 do
|
|
Assert(G.GetKeyByIndex(I) = IntToStringA(I), 'Dictionary.GetKeyByIndex');
|
|
Assert(G['0'] = '0', 'Dictionary.GetItem');
|
|
Assert(G['5'] = '5', 'Dictionary.GetItem');
|
|
Assert(G['16384'] = '16384', 'Dictionary.GetItem');
|
|
for I := 0 to 16384 do
|
|
Assert(G.GetItemByIndex(I) = IntToStr(I), 'Dictionary.GetItemByIndex');
|
|
Assert(G.HasKey('5'), 'Dictionary.HasKey');
|
|
Assert(not G.HasKey('X'), 'Dictionary.HasKey');
|
|
G.Rename('5', 'X');
|
|
Assert(not G.HasKey('5'), 'Dictionary.Rename');
|
|
Assert(G.HasKey('X'), 'Dictionary.Rename');
|
|
Assert(G['X'] = '5', 'Dictionary.Rename');
|
|
G.Delete('X');
|
|
Assert(not G.HasKey('X'), 'Dictionary.Delete');
|
|
Assert(G.Count = 16384, 'Dictionary.Delete');
|
|
G.Delete('0');
|
|
Assert(not G.HasKey('0'), 'Dictionary.Delete');
|
|
Assert(G.Count = 16383, 'Dictionary.Delete');
|
|
G.DeleteItemByIndex(0);
|
|
Assert(not G.HasKey('1'), 'Dictionary.DeleteItemByIndex');
|
|
Assert(G.Count = 16382, 'Dictionary.DeleteItemByIndex');
|
|
G.Free;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure Test_SparseArray;
|
|
var A, D : TSparseObjectArray;
|
|
B : Array[0..2] of TObject;
|
|
I, J : Integer;
|
|
V : TObject;
|
|
{$IFDEF SupportAnsiString}
|
|
S, T : TSparseAnsiStringArray;
|
|
{$ENDIF}
|
|
begin
|
|
B[0] := TObject.Create;
|
|
B[1] := TObject.Create;
|
|
B[2] := TObject.Create;
|
|
A := TSparseObjectArray.Create;
|
|
try
|
|
Assert(A.Count = 0);
|
|
Assert(A.IsEmpty);
|
|
Assert(not A.FindFirst(I, V));
|
|
Assert(A.IsEqual(A));
|
|
Assert(not A.LocateItem(0, V));
|
|
Assert(not Assigned(V));
|
|
A[100] := B[0];
|
|
Assert(A.Count = 1);
|
|
Assert(not A.IsEmpty);
|
|
Assert(A[100] = B[0]);
|
|
Assert(not A.LocateItem(0, V));
|
|
Assert(A.LocateItem(100, V));
|
|
Assert(V = B[0]);
|
|
Assert(not A.HasItem(1000));
|
|
A[1000] := B[1];
|
|
Assert(A.HasItem(1000));
|
|
Assert(A.Count = 2);
|
|
Assert(A[1000] = B[1]);
|
|
A[-50000] := B[2];
|
|
Assert(A.Count = 3);
|
|
Assert(A[100] = B[0]);
|
|
Assert(A[1000] = B[1]);
|
|
Assert(A[-50000] = B[2]);
|
|
Assert(A.IsEqual(A));
|
|
A[100] := B[1];
|
|
Assert(A[100] = B[1]);
|
|
A.Delete(1000);
|
|
Assert(A.Count = 2);
|
|
Assert(not A.HasItem(1000));
|
|
Assert(A.FindFirst(I, V));
|
|
Assert((I = 100) or (I = -50000));
|
|
J := I;
|
|
Assert(A.FindNext(I, V));
|
|
Assert(((I = 100) or (I = -50000)) and (I <> J));
|
|
Assert(not A.FindNext(I, V));
|
|
A.Clear;
|
|
Assert(A.Count = 0);
|
|
Assert(A.IsEmpty);
|
|
Assert(not A.FindFirst(I, V));
|
|
|
|
A[0] := B[0];
|
|
A[-10] := B[1];
|
|
A[20] := B[2];
|
|
Assert(A.Count = 3);
|
|
Assert((A[0] = B[0]) and (A[-10] = B[1]) and (A[20] = B[2]));
|
|
D := A.Duplicate as TSparseObjectArray;
|
|
Assert(D.Count = 3);
|
|
Assert((D[0] = B[0]) and (D[-10] = B[1]) and (D[20] = B[2]));
|
|
Assert(A.IsEqual(D));
|
|
Assert(D.IsEqual(A));
|
|
D[0] := B[1];
|
|
Assert(not A.IsEqual(D));
|
|
Assert(not D.IsEqual(A));
|
|
D[1] := B[1];
|
|
Assert(not A.IsEqual(D));
|
|
Assert(D.Count = 4);
|
|
Assert((D[0] = B[1]) and (D[1] = B[1]));
|
|
Assert(A.Count = 3);
|
|
Assert((A[0] = B[0]) and (A[-10] = B[1]) and (A[20] = B[2]));
|
|
Assert(not A.HasItem(1));
|
|
D.Delete(1);
|
|
Assert(D.Count = 3);
|
|
Assert(not D.HasItem(1));
|
|
D[0] := B[0];
|
|
Assert(D.IsEqual(A));
|
|
D.Free;
|
|
Assert((A[0] = B[0]) and (A[-10] = B[1]) and (A[20] = B[2]));
|
|
finally
|
|
A.Free;
|
|
B[2].Free;
|
|
B[1].Free;
|
|
B[0].Free;
|
|
end;
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
S := TSparseAnsiStringArray.Create;
|
|
T := TSparseAnsiStringArray.Create;
|
|
try
|
|
Assert(S.IsEmpty);
|
|
Assert(S.Count = 0);
|
|
Assert(S.IsEqual(T));
|
|
for I := 1 to 1000 do
|
|
begin
|
|
S[I * 3] := IntToStringA(I);
|
|
T[I] := IntToStringA(I);
|
|
Assert(S.HasItem(I * 3));
|
|
Assert(not S.HasItem(I * 3 + 1));
|
|
end;
|
|
Assert(S.Count = 1000);
|
|
Assert(T.Count = 1000);
|
|
for I := 1 to 1000 do
|
|
begin
|
|
Assert(S[I * 3] = IntToStringA(I));
|
|
Assert(T[I] = IntToStringA(I));
|
|
end;
|
|
for I := 1 to 1000 do
|
|
begin
|
|
S[I * 3] := IntToStringA(I + 1);
|
|
S[I * 3 - 1] := IntToStringA(I);
|
|
T[1000 + I * 2] := IntToStringA(I);
|
|
end;
|
|
Assert(S.Count = 2000);
|
|
Assert(T.Count = 2000);
|
|
for I := 1 to 1000 do
|
|
begin
|
|
Assert(S[I * 3] = IntToStringA(I + 1));
|
|
Assert(S[I * 3 - 1] = IntToStringA(I));
|
|
Assert(T[I] = IntToStringA(I));
|
|
Assert(T[1000 + I * 2] = IntToStringA(I));
|
|
end;
|
|
Assert(not S.IsEqual(T));
|
|
S.Clear;
|
|
Assert(S.Count = 0);
|
|
finally
|
|
FreeAndNil(T);
|
|
FreeAndNil(S);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure Test_HashedStringArray;
|
|
{$IFDEF SupportAnsiString}
|
|
var A : THashedAnsiStringArray;
|
|
B : THashedRawByteStringArray;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF SupportAnsiString}
|
|
A := THashedAnsiStringArray.Create(True);
|
|
try
|
|
A.AppendItem('abc');
|
|
Assert(A.Count = 1);
|
|
A.Clear;
|
|
Assert(A.Count = 0);
|
|
A.AppendItem('def');
|
|
Assert(A.Count = 1);
|
|
finally
|
|
A.Free;
|
|
end;
|
|
//
|
|
A := THashedAnsiStringArray.Create(False);
|
|
try
|
|
A.AppendItem('123');
|
|
A.AppendItem('267');
|
|
A.AppendItem('328');
|
|
A.AppendItem('423');
|
|
A.AppendItem('523a');
|
|
Assert(A.PosNext('123') = 0);
|
|
Assert(A.PosNext('423') = 3);
|
|
A.Delete(0);
|
|
Assert(A.PosNext('123') = -1);
|
|
Assert(A.PosNext('423') = 2);
|
|
finally
|
|
A.Free;
|
|
end;
|
|
|
|
B := THashedRawByteStringArray.Create(True);
|
|
try
|
|
B.AppendItem('abc');
|
|
Assert(B.Count = 1);
|
|
B.Clear;
|
|
Assert(B.Count = 0);
|
|
B.AppendItem('def');
|
|
Assert(B.Count = 1);
|
|
finally
|
|
B.Free;
|
|
end;
|
|
//
|
|
B := THashedRawByteStringArray.Create(False);
|
|
try
|
|
B.AppendItem('123');
|
|
B.AppendItem('267');
|
|
B.AppendItem('328');
|
|
B.AppendItem('423');
|
|
B.AppendItem('523a');
|
|
Assert(B.PosNext('123') = 0);
|
|
Assert(B.PosNext('423') = 3);
|
|
B.Delete(0);
|
|
Assert(B.PosNext('123') = -1);
|
|
Assert(B.PosNext('423') = 2);
|
|
finally
|
|
B.Free;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure Test;
|
|
begin
|
|
Test_Array;
|
|
Test_Dictionary;
|
|
Test_SparseArray;
|
|
Test_HashedStringArray;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
|
|
|
|
end.
|
|
|