 | 
|
|
|
{$INCLUDE ..\cDefines.inc}
unit cArrays;
{ }
{ Data structures: Arrays v3.21 }
{ }
{ This unit is copyright © 1999-2004 by David J Butler }
{ }
{ This unit is part of Delphi Fundamentals. }
{ Its original file name is cArrays.pas }
{ It was generated 1 Aug 2004 23:30. }
{ The latest version is available from the Fundamentals home page }
{ http://fundementals.sourceforge.net/ }
{ }
{ I invite you to use this unit, free of charge. }
{ I invite you to distibute this unit, but it must be for free. }
{ I also invite you to contribute to its development, }
{ but do not distribute a modified copy of this file. }
{ }
{ A forum is available on SourceForge for general discussion }
{ http://sourceforge.net/forum/forum.php?forum_id=2117 }
{ }
{ }
{ Revision history: }
{ [ cDataStructs ] }
{ 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/14 1.09 Converted cDataStructs to template. }
{ 2001/07/15 1.10 Changed memory arrays to pre-allocate when growing. }
{ 2001/08/20 2.11 Merged cTypes and cDataStructs to allow object }
{ interface implementation in base classes. }
{ [ cArrays ] }
{ 2002/05/15 3.12 Created cArrays unit from cDataStructs. }
{ Refactored for Fundamentals 3. }
{ 2002/09/30 3.13 Moved stream array classes to unit cStreamArrays. }
{ 2002/12/17 3.14 Added THashedStringArray. }
{ 2003/03/08 3.15 Renamed Add methods to Append. }
{ 2003/05/26 3.16 Added Remove methods to object array. }
{ 2003/09/11 3.17 Added TInterfaceArray. }
{ 2004/01/02 3.18 Bug fixed in TStringArray.SetAsString by Eb. }
{ 2004/01/18 3.19 Added TWideStringArray. }
{ 2004/07/24 3.20 Fixed bug in Sort with duplicate values. Thanks to Eb }
{ and others for reporting it. }
{ 2004/08/01 3.21 Added AArray.RemoveDuplicates. }
{ }
interface
uses
{ Delphi }
SysUtils,
{ Fundamentals }
cUtils,
cTypes;
const
UnitName = 'cArrays';
UnitVersion = '3.21';
UnitDesc = 'Data structures: Arrays';
UnitCopyright = 'Copyright (c) 1999-2004 David J Butler';
{ }
{ ARRAY BASE CLASSES }
{ Classes with the A-prefix are abstract base classes. They define the }
{ interface for the type and must never be instanciated. }
{ Instead, create one of the implementation classes (T-prefix). }
{ }
{ }
{ AArray }
{ Base class for an array. }
{ }
type
AArray = class(AType)
protected
procedure RaiseIndexError(const Idx: Integer); virtual;
function GetCount: Integer; virtual; abstract;
procedure SetCount(const NewCount: Integer); virtual; abstract;
public
{ AType }
procedure Clear; override;
{ AArray }
property Count: Integer read GetCount write SetCount;
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 Count: Integer = 1); virtual; abstract;
procedure Insert(const Idx: Integer; const Count: Integer = 1); virtual; abstract;
function AppendArray(const V: AArray): Integer; overload; virtual; abstract;
end;
EArray = class(EType);
ArrayClass = class of AArray;
{ }
{ ALongIntArray }
{ Base class for an array of LongInt's. }
{ }
type
ALongIntArray = class(AArray)
protected
function GetItem(const Idx: Integer): LongInt; virtual; abstract;
procedure SetItem(const Idx: Integer; const Value: LongInt); virtual; abstract;
function GetRange(const LoIdx, HiIdx: Integer): LongIntArray; virtual;
procedure SetRange(const LoIdx, HiIdx: Integer; const V: LongIntArray); virtual;
function GetAsString: String; override;
procedure SetAsString(const S: String); override;
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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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, Count: 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 = ALongIntArray;
EIntegerArray = ELongIntArray;
{ }
{ ALongWordArray }
{ Base class for an array of LongWord's. }
{ }
type
ALongWordArray = class(AArray)
protected
function GetItem(const Idx: Integer): LongWord; virtual; abstract;
procedure SetItem(const Idx: Integer; const Value: LongWord); virtual; abstract;
function GetRange(const LoIdx, HiIdx: Integer): LongWordArray; virtual;
procedure SetRange(const LoIdx, HiIdx: Integer; const V: LongWordArray); virtual;
function GetAsString: String; override;
procedure SetAsString(const S: String); override;
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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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, Count: 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 = ALongWordArray;
ECardinalArray = ELongWordArray;
{ }
{ AInt64Array }
{ Base class for an array of Int64's. }
{ }
type
AInt64Array = class(AArray)
protected
function GetItem(const Idx: Integer): Int64; virtual; abstract;
procedure SetItem(const Idx: Integer; const Value: Int64); virtual; abstract;
function GetRange(const LoIdx, HiIdx: Integer): Int64Array; virtual;
procedure SetRange(const LoIdx, HiIdx: Integer; const V: Int64Array); virtual;
function GetAsString: String; override;
procedure SetAsString(const S: String); override;
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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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, Count: 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);
{ }
{ ASingleArray }
{ Base class for an array of Single's. }
{ }
type
ASingleArray = class(AArray)
protected
function GetItem(const Idx: Integer): Single; virtual; abstract;
procedure SetItem(const Idx: Integer; const Value: Single); virtual; abstract;
function GetRange(const LoIdx, HiIdx: Integer): SingleArray; virtual;
procedure SetRange(const LoIdx, HiIdx: Integer; const V: SingleArray); virtual;
function GetAsString: String; override;
procedure SetAsString(const S: String); override;
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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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, Count: 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 Double's. }
{ }
type
ADoubleArray = class(AArray)
protected
function GetItem(const Idx: Integer): Double; virtual; abstract;
procedure SetItem(const Idx: Integer; const Value: Double); virtual; abstract;
function GetRange(const LoIdx, HiIdx: Integer): DoubleArray; virtual;
procedure SetRange(const LoIdx, HiIdx: Integer; const V: DoubleArray); virtual;
function GetAsString: String; override;
procedure SetAsString(const S: String); override;
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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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, Count: 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 Extended's. }
{ }
type
AExtendedArray = class(AArray)
protected
function GetItem(const Idx: Integer): Extended; virtual; abstract;
procedure SetItem(const Idx: Integer; const Value: Extended); virtual; abstract;
function GetRange(const LoIdx, HiIdx: Integer): ExtendedArray; virtual;
procedure SetRange(const LoIdx, HiIdx: Integer; const V: ExtendedArray); virtual;
function GetAsString: String; override;
procedure SetAsString(const S: String); override;
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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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, Count: 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);
{ }
{ APointerArray }
{ Base class for an array of Pointer's. }
{ }
type
APointerArray = class(AArray)
protected
function GetItem(const Idx: Integer): Pointer; virtual; abstract;
procedure SetItem(const Idx: Integer; const Value: Pointer); virtual; abstract;
function GetRange(const LoIdx, HiIdx: Integer): PointerArray; virtual;
procedure SetRange(const LoIdx, HiIdx: Integer; const V: PointerArray); virtual;
function GetAsString: String; override;
procedure SetAsString(const S: String); override;
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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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, Count: 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);
{ }
{ AStringArray }
{ Base class for an array of Strings. }
{ }
type
EStringArray = class(EArray);
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;
function GetAsString: String; override;
procedure SetAsString(const S: String); override;
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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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, Count: 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;
{ }
{ AWideStringArray }
{ Base class for an array of WideStrings. }
{ }
type
EWideStringArray = class(EArray);
AWideStringArray = class(AArray)
protected
function GetItem(const Idx: Integer): WideString; virtual; abstract;
procedure SetItem(const Idx: Integer; const Value: WideString); virtual; abstract;
function GetRange(const LoIdx, HiIdx: Integer): WideStringArray; virtual;
procedure SetRange(const LoIdx, HiIdx: Integer; const V: WideStringArray); 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: Integer = 1); override;
{ AWideStringArray interface }
property Item[const Idx: Integer]: WideString read GetItem write SetItem; default;
property Range[const LoIdx, HiIdx: Integer]: WideStringArray read GetRange write SetRange;
procedure Fill(const Idx, Count: Integer; const Value: WideString = ''); virtual;
function AppendItem(const Value: WideString): Integer; virtual;
function AppendArray(const V: WideStringArray): Integer; overload; virtual;
function PosNext(const Find: WideString; const PrevPos: Integer = -1;
const IsSortedAscending: Boolean = False): Integer;
end;
{ }
{ 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 IsItemOwner: 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 Count: 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 Item: TObject; const ClassType: TClass; const PrevPos: Integer = -1): Integer; overload;
function PosNext(var Item: TObject; const ClassName: String; const PrevPos: Integer = -1): Integer; overload;
function Find(const ClassType: TClass; const Count: Integer = 1): TObject; overload;
function Find(const ClassName: String; const Count: Integer = 1): TObject; overload;
function FindAll(const ClassType: TClass): ObjectArray; overload;
function FindAll(const ClassName: String): ObjectArray; overload;
function CountItems(const ClassType: TClass): Integer; overload;
function CountItems(const ClassName: 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;
{ }
{ AInterfaceArray }
{ Base class for an array of Interface's. }
{ }
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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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, Count: 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);
{ }
{ 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): LongWord; virtual;
procedure SetRangeL(const Idx: Integer; const Value: LongWord); virtual;
public
{ AType }
procedure Assign(const Source: TObject); override;
function IsEqual(const V: TObject): Boolean; override;
{ AArray }
procedure Delete(const Idx: Integer; const Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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]: LongWord read GetRangeL write SetRangeL;
function IsRange(const LoIdx, HiIdx: Integer; const Value: Boolean): Boolean; virtual;
procedure Fill(const Idx, Count: 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 Count: Integer = 1): Integer; virtual;
end;
{ }
{ ARRAY IMPLEMENTATIONS }
{ }
{ }
{ 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 Data: 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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 = TLongIntArray;
{ }
{ 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 Data: 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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 = TLongWordArray;
{ }
{ 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 Data: 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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;
{ }
{ 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 Data: 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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 Data: 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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 Data: 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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;
{ }
{ 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 Data: 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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;
{ }
{ 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 Data: 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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;
{ }
{ TWideStringArray }
{ AWideStringArray implemented using a dynamic array. }
{ }
type
TWideStringArray = class(AWideStringArray)
protected
FData : WideStringArray;
FCapacity : Integer;
FCount : Integer;
{ ACollection }
function GetCount: Integer; override;
procedure SetCount(const NewCount: Integer); override;
{ AWideStringArray }
function GetItem(const Idx: Integer): WideString; override;
procedure SetItem(const Idx: Integer; const Value: WideString); override;
function GetRange(const LoIdx, HiIdx: Integer): WideStringArray; override;
procedure SetRange(const LoIdx, HiIdx: Integer; const V: WideStringArray); override;
procedure SetData(const Data: WideStringArray); virtual;
public
constructor Create(const V: WideStringArray = 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: Integer = 1); override;
{ AWideStringArray }
procedure Assign(const V: WideStringArray); overload;
procedure Assign(const V: Array of WideString); overload;
function AppendItem(const Value: WideString): Integer; override;
{ TWideStringArray }
property Data: WideStringArray 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 Data: 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 IsItemOwner: Boolean); override;
public
{ TObjectArray interface }
constructor Create(const V: ObjectArray = nil;
const IsItemOwner: 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: Integer = 1); override;
{ AObjectArray }
function AppendItem(const Value: TObject): Integer; override;
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 Data: 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 Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: 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;
{ }
{ TBitArray }
{ ABitArray implemented using a dynamic array. }
{ }
type
TBitArray = class(ABitArray)
protected
FData : LongWordArray;
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): LongWord; override;
procedure SetRangeL(const Idx: Integer; const Value: LongWord); 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;
{ }
{ THashedStringArray }
{ AStringArray that maintains a hash lookup table of array values. }
{ }
type
THashedStringArray = class(TStringArray)
protected
FLookup : Array of IntegerArray;
FCaseSensitive : Boolean;
function LocateItemHashBuf(const ValueStrPtr: PChar;
const ValueStrLen: Integer;
var LookupList, LookupIdx: Integer): Boolean;
function LocateItemHash(const Value: String;
var LookupList, LookupIdx: Integer): Boolean;
procedure Rehash;
procedure Init; override;
procedure SetItem(const Idx: Integer; const Value: String); override;
procedure SetData(const Data: StringArray); override;
public
constructor Create(const CaseSensitive: Boolean = True);
procedure Assign(const Source: TObject); override;
procedure Clear; override;
procedure ExchangeItems(const Idx1, Idx2: Integer); override;
procedure Delete(const Idx: Integer; const Count: Integer = 1); override;
procedure Insert(const Idx: Integer; const Count: Integer = 1); override;
function AppendItem(const Value: String): Integer; override;
function PosNextBuf(const FindStrPtr: PChar; const FindStrLen: Integer;
const PrevPos: Integer = -1): Integer;
function PosNext(const Find: String; const PrevPos: Integer = -1): Integer;
end;
{ }
{ Self testing code }
{ }
procedure SelfTest;
implementation
uses
{ Fundamentals }
cStrings;
{ }
{ }
{ TYPE BASE CLASSES }
{ }
{ }
{ }
{ AArray }
{ }
procedure AArray.RaiseIndexError(const Idx: Integer);
begin
RaiseTypeError('Array index out of bounds'
{$IFDEF DEBUG} + ': ' + IntToStr(Idx) + '/' + IntToStr(GetCount){$ENDIF},
nil, EArray);
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;
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;
{ }
{ 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 := MaxI(0, LoIdx);
H := MinI(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 := MaxI(0, LoIdx);
H := MinI(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 := MaxI(0, LoIdx);
H := MinI(Count - 1, HiIdx);
C := MinI(Length(V), H - L + 1);
For I := 0 to C - 1 do
Item[L + I] := V[I];
end;
procedure ALongIntArray.Fill(const Idx, Count: Integer; const Value: LongInt);
var I : Integer;
begin
For I := Idx to Idx + Count - 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 MaxI(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 := MaxI(PrevPos + 1, 0) to Count - 1 do
if Item[I] = Find then
begin
Result := I;
exit;
end;
Result := -1;
end;
end;
function ALongIntArray.GetAsString: String;
var I, L : Integer;
begin
L := Count;
if L = 0 then
begin
Result := '';
exit;
end;
Result := IntToStr(Item[0]);
For I := 1 to L - 1 do
Result := Result + ',' + IntToStr(Item[I]);
end;
procedure ALongIntArray.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;
if G = 0 then
Item[L - 1] := 0
else
Item[L - 1] := StrToInt(Copy(S, F, G));
Inc(F, G + 1);
end;
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
RaiseTypeError(ClassName + ' can not append ' + ObjectClassName(V), nil, ELongIntArray);
end;
procedure ALongIntArray.Delete(const Idx: Integer; const Count: Integer);
var I, C, J, L : Integer;
begin
J := MaxI(Idx, 0);
C := GetCount;
L := MinI(Count, C - J);
if L > 0 then
begin
For I := J to J + C - 1 do
SetItem(I, GetItem(I + Count));
SetCount(C - L);
end;
end;
procedure ALongIntArray.Insert(const Idx: Integer; const Count: Integer);
var I, C, J, L : Integer;
begin
if Count <= 0 then
exit;
C := GetCount;
SetCount(C + Count);
J := MinI(MaxI(Idx, 0), C);
L := C - J;
For I := C - 1 downto C - L do
SetItem(I + Count, 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 := MaxI(0, LoIdx);
H := MinI(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 := MaxI(0, LoIdx);
H := MinI(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 := MaxI(0, LoIdx);
H := MinI(Count - 1, HiIdx);
C := MinI(Length(V), H - L + 1);
For I := 0 to C - 1 do
Item[L + I] := V[I];
end;
procedure ALongWordArray.Fill(const Idx, Count: Integer; const Value: LongWord);
var I : Integer;
begin
For I := Idx to Idx + Count - 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 MaxI(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 := MaxI(PrevPos + 1, 0) to Count - 1 do
if Item[I] = Find then
begin
Result := I;
exit;
end;
Result := -1;
end;
end;
function ALongWordArray.GetAsString: String;
var I, L : Integer;
begin
L := Count;
if L = 0 then
begin
Result := '';
exit;
end;
Result := IntToStr(Item[0]);
For I := 1 to L - 1 do
Result := Result + ',' + IntToStr(Item[I]);
end;
procedure ALongWordArray.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;
if G = 0 then
Item[L - 1] := 0
else
Item[L - 1] := StrToInt(Copy(S, F, G));
Inc(F, G + 1);
end;
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
RaiseTypeError(ClassName + ' can not append ' + ObjectClassName(V), nil, ELongWordArray);
end;
procedure ALongWordArray.Delete(const Idx: Integer; const Count: Integer);
var I, C, J, L : Integer;
begin
J := MaxI(Idx, 0);
C := GetCount;
L := MinI(Count, C - J);
if L > 0 then
begin
For I := J to J + C - 1 do
SetItem(I, GetItem(I + Count));
SetCount(C - L);
end;
end;
procedure ALongWordArray.Insert(const Idx: Integer; const Count: Integer);
var I, C, J, L : Integer;
begin
if Count <= 0 then
exit;
C := GetCount;
SetCount(C + Count);
J := MinI(MaxI(Idx, 0), C);
L := C - J;
For I := C - 1 downto C - L do
SetItem(I + Count, 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 := MaxI(0, LoIdx);
H := MinI(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 := MaxI(0, LoIdx);
H := MinI(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 := MaxI(0, LoIdx);
H := MinI(Count - 1, HiIdx);
C := MinI(Length(V), H - L + 1);
For I := 0 to C - 1 do
Item[L + I] := V[I];
end;
procedure AInt64Array.Fill(const Idx, Count: Integer; const Value: Int64);
var I : Integer;
begin
For I := Idx to Idx + Count - 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 MaxI(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 := MaxI(PrevPos + 1, 0) to Count - 1 do
if Item[I] = Find then
begin
Result := I;
exit;
end;
Result := -1;
end;
end;
function AInt64Array.GetAsString: String;
var I, L : Integer;
begin
L := Count;
if L = 0 then
begin
Result := '';
exit;
end;
Result := IntToStr(Item[0]);
For I := 1 to L - 1 do
Result := Result + ',' + IntToStr(Item[I]);
end;
procedure AInt64Array.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;
if G = 0 then
Item[L - 1] := 0
else
Item[L - 1] := StrToInt(Copy(S, F, G));
Inc(F, G + 1);
end;
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
RaiseTypeError(ClassName + ' can not append ' + ObjectClassName(V), nil, EInt64Array);
end;
procedure AInt64Array.Delete(const Idx: Integer; const Count: Integer);
var I, C, J, L : Integer;
begin
J := MaxI(Idx, 0);
C := GetCount;
L := MinI(Count, C - J);
if L > 0 then
begin
For I := J to J + C - 1 do
SetItem(I, GetItem(I + Count));
SetCount(C - L);
end;
end;
procedure AInt64Array.Insert(const Idx: Integer; const Count: Integer);
var I, C, J, L : Integer;
begin
if Count <= 0 then
exit;
C := GetCount;
SetCount(C + Count);
J := MinI(MaxI(Idx, 0), C);
L := C - J;
For I := C - 1 downto C - L do
SetItem(I + Count, 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 := MaxI(0, LoIdx);
H := MinI(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 := MaxI(0, LoIdx);
H := MinI(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 := MaxI(0, LoIdx);
H := MinI(Count - 1, HiIdx);
C := MinI(Length(V), H - L + 1);
For I := 0 to C - 1 do
Item[L + I] := V[I];
end;
procedure ASingleArray.Fill(const Idx, Count: Integer; const Value: Single);
var I : Integer;
begin
For I := Idx to Idx + Count - 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 MaxI(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 := MaxI(PrevPos + 1, 0) to Count - 1 do
if Item[I] = Find then
begin
Result := I;
exit;
end;
Result := -1;
end;
end;
function ASingleArray.GetAsString: String;
var I, L : Integer;
begin
L := Count;
if L = 0 then
begin
Result := '';
exit;
end;
Result := FloatToStr(Item[0]);
For I := 1 to L - 1 do
Result := Result + ',' + FloatToStr(Item[I]);
end;
procedure ASingleArray.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;
if G = 0 then
Item[L - 1] := 0.0
else
Item[L - 1] := StrToFloat(Copy(S, F, G));
Inc(F, G + 1);
end;
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
RaiseTypeError(ClassName + ' can not append ' + ObjectClassName(V), nil, ESingleArray);
end;
procedure ASingleArray.Delete(const Idx: Integer; const Count: Integer);
var I, C, J, L : Integer;
begin
J := MaxI(Idx, 0);
C := GetCount;
L := MinI(Count, C - J);
if L > 0 then
begin
For I := J to J + C - 1 do
SetItem(I, GetItem(I + Count));
SetCount(C - L);
end;
end;
procedure ASingleArray.Insert(const Idx: Integer; const Count: Integer);
var I, C, J, L : Integer;
begin
if Count <= 0 then
exit;
C := GetCount;
SetCount(C + Count);
J := MinI(MaxI(Idx, 0), C);
L := C - J;
For I := C - 1 downto C - L do
SetItem(I + Count, GetItem(I));
end;
{ }
{ ADoubleArray }
{ }
procedure ADoubleArray.ExchangeItems(const Idx1, Idx2: Integer);
var I : Double;
begin
I := Item[Idx1];
Item[Idx1] := Item[Idx2];