{******************************************************************************} { } { 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.