1567 lines
42 KiB
PHP
1567 lines
42 KiB
PHP
{*******************************************************************************}
|
|
{ }
|
|
{ Library: Fundamentals 5.00 }
|
|
{ File name: flcDataStructArrays.pas }
|
|
{ File version: 5.32 }
|
|
{ Description: Data structures: Arrays }
|
|
{ }
|
|
{ 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: }
|
|
{ }
|
|
{ Array classes for various item types. }
|
|
{ }
|
|
{ Revision history: }
|
|
{ }
|
|
{ 1999/11/12 0.01 Initial development. }
|
|
{ 2000/02/08 1.02 Initial version. AArray, TArray.. }
|
|
{ 2000/06/07 1.03 Base classes (AIntegerArray). }
|
|
{ 2000/06/08 1.04 Added AObjectArray. }
|
|
{ 2000/06/03 1.05 Added AArray, AIntegerArray, AExtendedArray, }
|
|
{ AStringArray with some implementations. }
|
|
{ 2000/06/06 1.06 Added AInt64Array. }
|
|
{ 2000/06/08 1.07 Added TObjectArray. }
|
|
{ 2000/06/14 1.08 Converted cDataStructs to template. }
|
|
{ 2001/07/15 1.09 Changed memory arrays to pre-allocate when growing. }
|
|
{ 2002/05/15 3.10 Created cArrays unit from cDataStructs. }
|
|
{ Refactored for Fundamentals 3. }
|
|
{ 2002/09/30 3.11 Moved stream array classes to unit cStreamArrays. }
|
|
{ 2003/03/08 3.12 Renamed Add methods to Append. }
|
|
{ 2003/05/26 3.13 Added Remove methods to object array. }
|
|
{ 2003/09/11 3.14 Added TInterfaceArray. }
|
|
{ 2004/01/02 3.15 Bug fixed in TStringArray.SetAsString by Eb. }
|
|
{ 2004/01/18 3.16 Added TWideStringArray. }
|
|
{ 2004/07/24 3.17 Fixed bug in Sort with duplicate values. Thanks to Eb }
|
|
{ and others for reporting it. }
|
|
{ 2007/09/27 4.18 Merged into single unit for Fundamentals 4. }
|
|
{ 2012/04/11 4.19 Unicode string changes. }
|
|
{ 2012/09/01 4.20 Unicode string changes. }
|
|
{ 2015/03/13 4.21 RawByteString support. }
|
|
{ 2016/01/16 5.22 Revised for Fundamentals 5. }
|
|
{ 2018/07/17 5.23 Int32/Word32 arrays. }
|
|
{ 2018/08/12 5.24 String type changes. }
|
|
{ 2019/04/02 5.25 Integer/Cardinal array changes. }
|
|
{ 2020/03/22 5.26 Rename parameters to avoid conflict with properties. }
|
|
{ 2020/03/31 5.27 Integer array changes. }
|
|
{ 2020/06/02 5.28 UInt64 changes. }
|
|
{ 2020/07/02 5.29 Split arrays into separate unit. }
|
|
{ 2020/07/03 5.30 Factor out methods from base class to concrete classes. }
|
|
{ Remove unused types and define equivalent types. }
|
|
{ 2020/07/05 5.31 Move bit array into seperate unit. }
|
|
{ Remove dependencies on units flcDynArrays, flcStrings. }
|
|
{ 2020/07/07 5.32 Refactor and remove dependency on unit flcUtils. }
|
|
{ Added TByteArray. }
|
|
{ }
|
|
{ Supported compilers: }
|
|
{ }
|
|
{ Delphi 2010-10.4 Win32/Win64 5.29 2020/06/02 }
|
|
{ Delphi 10.2-10.4 Linux64 5.29 2020/06/02 }
|
|
{ FreePascal 3.0.4 Win64 5.29 2020/06/02 }
|
|
{ }
|
|
{*******************************************************************************}
|
|
|
|
{$INCLUDE ..\flcInclude.inc}
|
|
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF TEST}
|
|
{$DEFINE ARRAY_TEST}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF FREEPASCAL}
|
|
{$WARNINGS OFF}
|
|
{$HINTS OFF}
|
|
{$ENDIF}
|
|
|
|
unit flcDataStructArrays;
|
|
|
|
interface
|
|
|
|
uses
|
|
{ System }
|
|
SysUtils,
|
|
|
|
{ Fundamentals }
|
|
flcStdTypes;
|
|
|
|
|
|
|
|
{ }
|
|
{ EArrayError }
|
|
{ Exception raised by array objects. }
|
|
{ }
|
|
type
|
|
EArrayError = class(Exception);
|
|
|
|
|
|
|
|
{ }
|
|
{ TArrayBase }
|
|
{ Base class for an array class. }
|
|
{ }
|
|
type
|
|
TArrayBase = class
|
|
end;
|
|
|
|
TArrayBaseClass = class of TArrayBase;
|
|
|
|
|
|
|
|
{ }
|
|
{ TObjectArray }
|
|
{ An TObjectArray implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
TObjectArray = class(TArrayBase)
|
|
protected
|
|
FData : ObjectArray;
|
|
FCapacity : NativeInt;
|
|
FCount : NativeInt;
|
|
FIsItemOwner : Boolean;
|
|
|
|
procedure Init; virtual;
|
|
|
|
procedure FreeItems;
|
|
|
|
procedure SetData(const AData: ObjectArray); virtual;
|
|
|
|
procedure SetCount(const ANewCount: NativeInt);
|
|
|
|
function GetItem(const AIdx: NativeInt): TObject; {$IFDEF UseInline}inline;{$ENDIF}
|
|
procedure SetItem(const AIdx: NativeInt; const AValue: TObject); {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function GetTailItem: TObject;
|
|
|
|
function CompareItems(const AIdx1, AIdx2: NativeInt): Int32; virtual;
|
|
|
|
public
|
|
class function CreateInstance(const AIsItemOwner: Boolean = False): TObjectArray; virtual;
|
|
|
|
constructor Create(
|
|
const AIsItemOwner: Boolean = False); overload; virtual;
|
|
constructor Create(
|
|
const AData: ObjectArray = nil;
|
|
const AIsItemOwner: Boolean = False); overload;
|
|
|
|
destructor Destroy; override;
|
|
|
|
property Data: ObjectArray read FData write SetData;
|
|
property IsItemOwner: Boolean read FIsItemOwner;
|
|
|
|
procedure Clear;
|
|
|
|
procedure Assign(const ASource: TObjectArray);
|
|
|
|
function Duplicate: TObjectArray;
|
|
|
|
function IsEqual(const V: TObjectArray): Boolean;
|
|
|
|
property Count: NativeInt read FCount write SetCount;
|
|
property Item[const AIdx: NativeInt]: TObject read GetItem write SetItem; default;
|
|
|
|
property TailItem: TObject read GetTailItem;
|
|
|
|
function PosNext(const AItem: TObject; const APrevPos: NativeInt): NativeInt; overload;
|
|
function PosNext(var AItem: TObject; const AClassType: TClass; const APrevPos: NativeInt = -1): NativeInt; overload;
|
|
function PosNext(var AItem: TObject; const AClassName: String; const APrevPos: NativeInt = -1): NativeInt; overload;
|
|
|
|
function GetIndex(const AValue: TObject): NativeInt;
|
|
function HasValue(const AValue: TObject): Boolean;
|
|
|
|
function Add(const AValue: TObject): NativeInt;
|
|
function AddIfNotExists(const AValue: TObject): NativeInt;
|
|
|
|
function AddArray(const AArray: ObjectArray): NativeInt; overload;
|
|
function AddArray(const AArray: TObjectArray): NativeInt; overload;
|
|
|
|
procedure Insert(const AIdx: NativeInt; const ACount: NativeInt = 1);
|
|
|
|
procedure Delete(const AIdx: NativeInt; const ACount: NativeInt = 1);
|
|
|
|
function ReleaseItem(const AIdx: NativeInt): TObject;
|
|
function ReleaseValue(const AValue: TObject): Boolean;
|
|
|
|
function RemoveItem(const AIdx: NativeInt): TObject;
|
|
function RemoveValue(const AValue: TObject): Boolean;
|
|
|
|
function DeleteValue(const AValue: TObject): Boolean;
|
|
function DeleteAll(const AValue: TObject): NativeInt;
|
|
|
|
procedure Sort;
|
|
|
|
function GetRange(const ALoIdx, AHiIdx: NativeInt): ObjectArray;
|
|
procedure SetRange(const ALoIdx, AHiIdx: NativeInt; const V: ObjectArray);
|
|
end;
|
|
|
|
|
|
|
|
{%DEFINE AArrayDynArray}
|
|
{ }
|
|
{-T%1%Array }
|
|
{- An T%1%Array implemented using a dynamic array. }
|
|
{ }
|
|
type
|
|
T%1%Array = class(TArrayBase)
|
|
protected
|
|
FData : %1%Array;
|
|
FCapacity : NativeInt;
|
|
FCount : NativeInt;
|
|
|
|
procedure SetData(const AData: %1%Array); virtual;
|
|
|
|
procedure SetCount(const ANewCount: NativeInt);
|
|
|
|
function GetItem(const AIdx: NativeInt): %2%; {$IFDEF UseInline}inline;{$ENDIF}
|
|
procedure SetItem(const AIdx: NativeInt; const AValue: %2%); {$IFDEF UseInline}inline;{$ENDIF}
|
|
|
|
function CompareItems(const AIdx1, AIdx2: NativeInt): Int32; virtual;{%IF 3}
|
|
|
|
function GetItemAsString(const AIdx: NativeInt): String;
|
|
procedure SetItemAsString(const AIdx: NativeInt; const AValue: String);
|
|
|
|
function GetAsString: String;
|
|
procedure SetAsString(const S: String);{%ENDIF}
|
|
|
|
public
|
|
class function CreateInstance: T%1%Array; virtual;
|
|
|
|
constructor Create; overload; virtual;
|
|
constructor Create(const V: %1%Array); overload;
|
|
|
|
property Data: %1%Array read FData write SetData;
|
|
|
|
procedure Clear;
|
|
|
|
procedure Assign(const ASource: T%1%Array); overload;
|
|
procedure Assign(const ASource: %1%Array); overload;
|
|
procedure Assign(const ASource: Array of %2%); overload;
|
|
|
|
function Duplicate: T%1%Array;
|
|
|
|
function IsEqual(const V: T%1%Array): Boolean;
|
|
|
|
property Count: NativeInt read FCount write SetCount;
|
|
property Item[const AIdx: NativeInt]: %2% read GetItem write SetItem; default;
|
|
|
|
function PosNext(
|
|
const AItem: %2%;
|
|
const APrevPos: NativeInt = -1;
|
|
const IsSortedAscending: Boolean = False): NativeInt;
|
|
|
|
function GetIndex(const AValue: %2%): NativeInt;
|
|
function HasValue(const AValue: %2%): Boolean;
|
|
|
|
function Add(const AValue: %2%): NativeInt;
|
|
function AddIfNotExists(const AValue: %2%): NativeInt;
|
|
|
|
function AddArray(const AArray: %1%Array): NativeInt; overload;
|
|
function AddArray(const AArray: T%1%Array): NativeInt; overload;
|
|
|
|
procedure Insert(const AIdx: NativeInt; const ACount: NativeInt = 1);
|
|
|
|
procedure Delete(const AIdx: NativeInt; const ACount: NativeInt = 1);
|
|
|
|
procedure Sort;
|
|
|
|
function GetRange(const ALoIdx, AHiIdx: NativeInt): %1%Array;
|
|
procedure SetRange(const ALoIdx, AHiIdx: NativeInt; const V: %1%Array);
|
|
|
|
procedure Fill(const AIdx, ACount: NativeInt; const AValue: %2%);{%IF 3}
|
|
|
|
property ItemAsString[const AIdx: NativeInt]: String read GetItemAsString write SetItemAsString;
|
|
property AsString: String read GetAsString write SetAsString;{%ENDIF}
|
|
end;
|
|
|
|
|
|
{%ENDDEF}
|
|
{%TEMPLATE AArrayDynArray 'Int32' 'Int32' 'S' }
|
|
{%TEMPLATE AArrayDynArray 'Int64' 'Int64' 'S' }
|
|
{ }
|
|
{ Equivalent Integer types }
|
|
{ }
|
|
{$IFDEF LongIntIs32Bits}
|
|
type
|
|
TLongIntArray = TInt32Array;
|
|
{$ELSE}{$IFDEF LongIntIs64Bits}
|
|
type
|
|
TLongIntArray = TInt64Array;
|
|
{$ENDIF}{$ENDIF}
|
|
|
|
type
|
|
TIntegerArray = TInt32Array;
|
|
|
|
{$IFDEF NativeIntIs32Bits}
|
|
type
|
|
TNativeIntArray = TInt32Array;
|
|
{$ELSE}{$IFDEF NativeIntIs64Bits}
|
|
type
|
|
TNativeIntArray = TInt64Array;
|
|
{$ENDIF}{$ENDIF}
|
|
|
|
type
|
|
TIntArray = TInt64Array;
|
|
|
|
|
|
|
|
{%TEMPLATE AArrayDynArray 'Byte' 'Byte' 'S' }
|
|
{%TEMPLATE AArrayDynArray 'Word32' 'Word32' 'S' }
|
|
{%TEMPLATE AArrayDynArray 'Word64' 'Word64' '' }
|
|
{ }
|
|
{ Equivalent Unsigned Integer types }
|
|
{ }
|
|
{$IFDEF LongWordIs32Bits}
|
|
type
|
|
TLongWordArray = TWord32Array;
|
|
{$ELSE}{$IFDEF LongWordIs64Bits}
|
|
type
|
|
TLongWordArray = TWord64Array;
|
|
{$ENDIF}{$ENDIF}
|
|
|
|
type
|
|
TCardinalArray = TWord32Array;
|
|
TUInt32Array = TWord32Array;
|
|
TUInt64Array = TWord64Array;
|
|
|
|
{$IFDEF NativeUIntIs32Bits}
|
|
type
|
|
TNativeUIntArray = TUInt32Array;
|
|
{$ELSE}{$IFDEF NativeUIntIs64Bits}
|
|
type
|
|
TNativeUIntArray = TUInt64Array;
|
|
{$ENDIF}{$ENDIF}
|
|
|
|
type
|
|
TNativeWordArray = TNativeUIntArray;
|
|
TUIntArray = TUInt64Array;
|
|
|
|
|
|
|
|
{%TEMPLATE AArrayDynArray 'Single' 'Single' 'S' }
|
|
{%TEMPLATE AArrayDynArray 'Double' 'Double' 'S' }
|
|
{ }
|
|
{ Equivalent Float type (Double) }
|
|
{ }
|
|
type
|
|
TFloatArray = TDoubleArray;
|
|
|
|
|
|
|
|
{$IFDEF SupportAnsiString}
|
|
{%TEMPLATE AArrayDynArray 'AnsiString' 'AnsiString' 'S' }
|
|
{$ENDIF}
|
|
{%TEMPLATE AArrayDynArray 'RawByteString' 'RawByteString' 'S' }
|
|
{%TEMPLATE AArrayDynArray 'UnicodeString' 'UnicodeString' 'S' }
|
|
{ }
|
|
{ Equivalent String types }
|
|
{ }
|
|
type
|
|
TUTF8StringArray = TRawByteStringArray;
|
|
|
|
{$IFDEF StringIsUnicode}
|
|
type
|
|
TStringArray = TUnicodeStringArray;
|
|
{$ELSE}{$IFDEF SupportAnsiString}
|
|
type
|
|
TStringArray = TAnsiStringArray;
|
|
{$ENDIF}{$ENDIF}
|
|
|
|
|
|
|
|
{%TEMPLATE AArrayDynArray 'Pointer' 'Pointer' '' }
|
|
{%TEMPLATE AArrayDynArray 'Interface' 'IInterface' '' }
|
|
{ }
|
|
{ Error strings }
|
|
{ }
|
|
const
|
|
SErrArrayIndexOutOfBounds = 'Array index out of bounds (%d)';
|
|
SErrCannotDuplicate = '%s cannot duplicate: %s';
|
|
SErrInvalidCountValue = 'Invalid count value (%d)';
|
|
SErrSourceNotAssigned = 'Source not assigned';
|
|
|
|
|
|
|
|
implementation
|
|
|
|
|
|
|
|
{ }
|
|
{ Utility functions }
|
|
{ }
|
|
function MinNativeInt(const A, B: NativeInt): NativeInt; inline;
|
|
begin
|
|
if A < B then
|
|
Result := A
|
|
else
|
|
Result := B;
|
|
end;
|
|
|
|
function MaxNativeInt(const A, B: NativeInt): NativeInt; inline;
|
|
begin
|
|
if A > B then
|
|
Result := A
|
|
else
|
|
Result := B;
|
|
end;
|
|
|
|
|
|
|
|
{ }
|
|
{ TObjectArray }
|
|
{ }
|
|
class function TObjectArray.CreateInstance(const AIsItemOwner: Boolean): TObjectArray;
|
|
begin
|
|
Result := TObjectArray.Create(nil, AIsItemOwner);
|
|
end;
|
|
|
|
constructor TObjectArray.Create(
|
|
const AIsItemOwner: Boolean);
|
|
begin
|
|
inherited Create;
|
|
Init;
|
|
FIsItemOwner := AIsItemOwner;
|
|
FData := nil;
|
|
FCount := 0;
|
|
FCapacity := 0;
|
|
end;
|
|
|
|
constructor TObjectArray.Create(
|
|
const AData: ObjectArray;
|
|
const AIsItemOwner: Boolean);
|
|
begin
|
|
inherited Create;
|
|
Init;
|
|
FIsItemOwner := AIsItemOwner;
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
destructor TObjectArray.Destroy;
|
|
begin
|
|
if FIsItemOwner then
|
|
FreeItems;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TObjectArray.Init;
|
|
begin
|
|
end;
|
|
|
|
procedure TObjectArray.FreeItems;
|
|
var
|
|
C : NativeInt;
|
|
L : NativeInt;
|
|
I : NativeInt;
|
|
begin
|
|
C := FCount;
|
|
L := Length(FData);
|
|
if L < C then
|
|
C := L;
|
|
for I := C - 1 downto 0 do
|
|
FreeAndNil(FData[I]);
|
|
FData := nil;
|
|
FCapacity := 0;
|
|
FCount := 0;
|
|
end;
|
|
|
|
procedure TObjectArray.Clear;
|
|
begin
|
|
if FIsItemOwner then
|
|
FreeItems
|
|
else
|
|
begin
|
|
FData := nil;
|
|
FCapacity := 0;
|
|
FCount := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TObjectArray.SetData(const AData: ObjectArray);
|
|
begin
|
|
Clear;
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure TObjectArray.Assign(const ASource: TObjectArray);
|
|
var
|
|
D : ObjectArray;
|
|
begin
|
|
if not Assigned(ASource) then
|
|
raise EArrayError.Create(SErrSourceNotAssigned);
|
|
|
|
D := Copy(ASource.FData);
|
|
SetLength(D, ASource.FCount);
|
|
SetData(D);
|
|
end;
|
|
|
|
function TObjectArray.Duplicate: TObjectArray;
|
|
var
|
|
Obj : TObjectArray;
|
|
begin
|
|
try
|
|
Obj := CreateInstance(False);
|
|
try
|
|
Obj.Assign(self);
|
|
except
|
|
Obj.Free;
|
|
raise;
|
|
end;
|
|
except
|
|
on E : Exception do
|
|
raise EArrayError.CreateFmt(SErrCannotDuplicate, [ClassName, E.Message]);
|
|
end;
|
|
Result := Obj;
|
|
end;
|
|
|
|
function TObjectArray.IsEqual(const V: TObjectArray): Boolean;
|
|
var
|
|
I : NativeInt;
|
|
L : NativeInt;
|
|
A : TObject;
|
|
B : TObject;
|
|
begin
|
|
L := V.Count;
|
|
if FCount <> L then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
for I := 0 to L - 1 do
|
|
begin
|
|
A := FData[I];
|
|
B := V.FData[I];
|
|
if A <> B then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
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 ANewCount. }
|
|
{ * For shrinking blocks: shrink actual allocation when Count is less }
|
|
{ than half of the allocated size. }
|
|
procedure TObjectArray.SetCount(const ANewCount: NativeInt);
|
|
var
|
|
N : NativeInt;
|
|
C : NativeInt;
|
|
I : NativeInt;
|
|
L : NativeInt;
|
|
begin
|
|
N := ANewCount;
|
|
if N < 0 then
|
|
raise EArrayError.CreateFmt(SErrInvalidCountValue, [N]);
|
|
|
|
C := FCount;
|
|
if N = C then
|
|
exit;
|
|
|
|
if (N < C) and FIsItemOwner then
|
|
for I := C - 1 downto N do
|
|
FreeAndNil(FData[I]);
|
|
|
|
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
|
|
SetLength(FData, N);
|
|
if N > L then
|
|
FillChar(FData[L], SizeOf(TObject) * (N - L), 0);
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function TObjectArray.GetItem(const AIdx: NativeInt): TObject;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (AIdx < 0) or (AIdx >= FCount) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);
|
|
{$ELSE}
|
|
Assert(AIdx >= 0);
|
|
Assert(AIdx < FCount);
|
|
{$ENDIF}
|
|
|
|
Result := FData[AIdx];
|
|
end;
|
|
|
|
procedure TObjectArray.SetItem(const AIdx: NativeInt; const AValue: TObject);
|
|
var
|
|
P : ^TObject;
|
|
V : TObject;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (AIdx < 0) or (AIdx >= FCount) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);
|
|
{$ELSE}
|
|
Assert(AIdx >= 0);
|
|
Assert(AIdx < FCount);
|
|
{$ENDIF}
|
|
|
|
P := Pointer(FData);
|
|
Inc(P, AIdx);
|
|
if FIsItemOwner then
|
|
begin
|
|
V := P^;
|
|
if V = AValue then
|
|
exit;
|
|
V.Free;
|
|
end;
|
|
P^ := AValue;
|
|
end;
|
|
|
|
function TObjectArray.GetTailItem: TObject;
|
|
var
|
|
C : NativeInt;
|
|
begin
|
|
C := FCount;
|
|
if C <= 0 then
|
|
Result := nil
|
|
else
|
|
Result := FData[C - 1];
|
|
end;
|
|
|
|
function TObjectArray.PosNext(const AItem: TObject; const APrevPos: NativeInt): NativeInt;
|
|
var
|
|
F : NativeInt;
|
|
I : NativeInt;
|
|
begin
|
|
F := APrevPos + 1;
|
|
if F < 0 then
|
|
F := 0;
|
|
for I := F to FCount - 1 do
|
|
if FData[I] = AItem then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TObjectArray.PosNext(
|
|
var AItem: TObject;
|
|
const AClassType: TClass;
|
|
const APrevPos: NativeInt): NativeInt;
|
|
var
|
|
F : NativeInt;
|
|
I : NativeInt;
|
|
begin
|
|
F := APrevPos + 1;
|
|
if F < 0 then
|
|
F := 0;
|
|
for I := F to FCount - 1 do
|
|
begin
|
|
AItem := FData[I];
|
|
if AItem.InheritsFrom(AClassType) then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
end;
|
|
AItem := nil;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TObjectArray.PosNext(
|
|
var AItem: TObject;
|
|
const AClassName: String;
|
|
const APrevPos: NativeInt): NativeInt;
|
|
var
|
|
F : NativeInt;
|
|
I : NativeInt;
|
|
begin
|
|
F := APrevPos + 1;
|
|
if F < 0 then
|
|
F := 0;
|
|
for I := F to FCount - 1 do
|
|
begin
|
|
AItem := FData[I];
|
|
if Assigned(AItem) and AItem.ClassNameIs(AClassName) then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
end;
|
|
AItem := nil;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TObjectArray.GetIndex(const AValue: TObject): NativeInt;
|
|
begin
|
|
Result := PosNext(AValue, -1);
|
|
end;
|
|
|
|
function TObjectArray.HasValue(const AValue: TObject): Boolean;
|
|
begin
|
|
Result := PosNext(AValue, -1) >= 0;
|
|
end;
|
|
|
|
function TObjectArray.Add(const AValue: TObject): NativeInt;
|
|
var
|
|
C : NativeInt;
|
|
begin
|
|
C := FCount;
|
|
if C >= FCapacity then
|
|
SetCount(C + 1)
|
|
else
|
|
FCount := C + 1;
|
|
FData[C] := AValue;
|
|
Result := C;
|
|
end;
|
|
|
|
function TObjectArray.AddIfNotExists(const AValue: TObject): NativeInt;
|
|
var
|
|
I : NativeInt;
|
|
begin
|
|
I := PosNext(AValue, -1);
|
|
if I < 0 then
|
|
I := Add(AValue);
|
|
Result := I;
|
|
end;
|
|
|
|
function TObjectArray.AddArray(const AArray: ObjectArray): NativeInt;
|
|
var
|
|
C : NativeInt;
|
|
I : NativeInt;
|
|
L : NativeInt;
|
|
begin
|
|
C := FCount;
|
|
L := Length(AArray);
|
|
SetCount(C + L);
|
|
|
|
for I := 0 to L - 1 do
|
|
FData[C + I] := AArray[I];
|
|
|
|
Result := C;
|
|
end;
|
|
|
|
function TObjectArray.AddArray(const AArray: TObjectArray): NativeInt;
|
|
var
|
|
C : NativeInt;
|
|
I : NativeInt;
|
|
L : NativeInt;
|
|
begin
|
|
if not Assigned(AArray) then
|
|
raise EArrayError.Create(SErrSourceNotAssigned);
|
|
|
|
C := FCount;
|
|
L := AArray.FCount;
|
|
SetCount(C + L);
|
|
|
|
for I := 0 to L - 1 do
|
|
FData[C + I] := AArray.FData[I];
|
|
|
|
Result := C;
|
|
end;
|
|
|
|
procedure TObjectArray.Insert(const AIdx: NativeInt; const ACount: NativeInt = 1);
|
|
var
|
|
A : NativeInt;
|
|
C : NativeInt;
|
|
N : NativeInt;
|
|
begin
|
|
A := ACount;
|
|
if A <= 0 then
|
|
exit;
|
|
|
|
C := FCount;
|
|
if (AIdx < 0) or (AIdx > C) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);
|
|
|
|
N := C + A;
|
|
if N > FCapacity then
|
|
SetCount(N)
|
|
else
|
|
FCount := N;
|
|
|
|
if AIdx < C then
|
|
Move(FData[AIdx], FData[AIdx + A], (C - AIdx) * SizeOf(TObject));
|
|
|
|
FillChar(FData[AIdx], A * SizeOf(TObject), 0);
|
|
end;
|
|
|
|
procedure TObjectArray.Delete(const AIdx: NativeInt; const ACount: NativeInt);
|
|
var
|
|
A : NativeInt;
|
|
C : NativeInt;
|
|
L : NativeInt;
|
|
I : NativeInt;
|
|
begin
|
|
A := ACount;
|
|
if A <= 0 then
|
|
exit;
|
|
|
|
C := FCount;
|
|
if (AIdx < 0) or (AIdx >= C) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);
|
|
|
|
L := AIdx + A;
|
|
if L > C then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);
|
|
|
|
if FIsItemOwner then
|
|
for I := AIdx to L - 1 do
|
|
FreeAndNil(FData[AIdx])
|
|
else
|
|
for I := AIdx to L - 1 do
|
|
FData[AIdx] := nil;
|
|
|
|
if L < C then
|
|
begin
|
|
Move(FData[L], FData[AIdx], SizeOf(TObject) * (C - AIdx - A));
|
|
FillChar(FData[C - A], A * SizeOf(TObject), 0);
|
|
end;
|
|
|
|
SetCount(C - A);
|
|
end;
|
|
|
|
function TObjectArray.ReleaseItem(const AIdx: NativeInt): TObject;
|
|
var
|
|
Itm : TObject;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (AIdx < 0) or (AIdx >= FCount) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);
|
|
{$ELSE}
|
|
Assert(AIdx >= 0);
|
|
Assert(AIdx < FCount);
|
|
{$ENDIF}
|
|
|
|
Itm := FData[AIdx];
|
|
if Assigned(Itm) then
|
|
FData[AIdx] := nil;
|
|
Result := Itm;
|
|
end;
|
|
|
|
function TObjectArray.DeleteValue(const AValue: TObject): Boolean;
|
|
var
|
|
I : NativeInt;
|
|
begin
|
|
I := PosNext(AValue, -1);
|
|
Result := I >= 0;
|
|
if Result then
|
|
Delete(I, 1);
|
|
end;
|
|
|
|
function TObjectArray.DeleteAll(const AValue: TObject): NativeInt;
|
|
begin
|
|
Result := 0;
|
|
while DeleteValue(AValue) do
|
|
Inc(Result);
|
|
end;
|
|
|
|
function TObjectArray.ReleaseValue(const AValue: TObject): Boolean;
|
|
var I : NativeInt;
|
|
begin
|
|
I := PosNext(AValue, -1);
|
|
Result := I >= 0;
|
|
if Result then
|
|
ReleaseItem(I);
|
|
end;
|
|
|
|
function TObjectArray.RemoveItem(const AIdx: NativeInt): TObject;
|
|
begin
|
|
Result := ReleaseItem(AIdx);
|
|
Delete(AIdx, 1);
|
|
end;
|
|
|
|
function TObjectArray.RemoveValue(const AValue: TObject): Boolean;
|
|
var
|
|
I : NativeInt;
|
|
begin
|
|
I := PosNext(AValue, -1);
|
|
Result := I >= 0;
|
|
if Result then
|
|
RemoveItem(I);
|
|
end;
|
|
|
|
function TObjectArray.CompareItems(const AIdx1, AIdx2: NativeInt): Int32;
|
|
var
|
|
A : TObject;
|
|
B : TObject;
|
|
begin
|
|
Assert(AIdx1 >= 0);
|
|
Assert(AIdx1 < FCount);
|
|
Assert(AIdx2 >= 0);
|
|
Assert(AIdx2 < FCount);
|
|
|
|
A := FData[AIdx1];
|
|
B := FData[AIdx2];
|
|
if NativeUInt(A) = NativeUInt(B) then
|
|
Result := 0
|
|
else
|
|
if NativeUInt(A) < NativeUInt(B) then
|
|
Result := -1
|
|
else
|
|
Result := 1;
|
|
end;
|
|
|
|
procedure TObjectArray.Sort;
|
|
|
|
procedure QuickSort(L, R: NativeInt);
|
|
var
|
|
I : NativeInt;
|
|
J : NativeInt;
|
|
M : NativeInt;
|
|
T : TObject;
|
|
begin
|
|
repeat
|
|
I := L;
|
|
J := R;
|
|
M := (L + R) shr 1;
|
|
repeat
|
|
while CompareItems(I, M) < 0 do
|
|
Inc(I);
|
|
while CompareItems(J, M) > 0 do
|
|
Dec(J);
|
|
if I <= J then
|
|
begin
|
|
T := FData[I];
|
|
FData[I] := FData[J];
|
|
FData[J] := T;
|
|
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
|
|
C : NativeInt;
|
|
begin
|
|
C := Count;
|
|
if C > 0 then
|
|
QuickSort(0, C - 1);
|
|
end;
|
|
|
|
function TObjectArray.GetRange(const ALoIdx, AHiIdx: NativeInt): ObjectArray;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (ALoIdx < 0) or (ALoIdx >= FCount) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [ALoIdx]);
|
|
if (AHiIdx < 0) or (AHiIdx >= FCount) or (AHiIdx < ALoIdx) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AHiIdx]);
|
|
{$ELSE}
|
|
Assert((ALoIdx >= 0) and (ALoIdx < FCount));
|
|
Assert((AHiIdx >= 0) and (AHiIdx < FCount) and (AHiIdx >= ALoIdx));
|
|
{$ENDIF}
|
|
|
|
Result := Copy(FData, ALoIdx, MinNativeInt(AHiIdx, FCount - 1) - ALoIdx + 1);
|
|
end;
|
|
|
|
procedure TObjectArray.SetRange(const ALoIdx, AHiIdx: NativeInt; const V: ObjectArray);
|
|
var
|
|
I : NativeInt;
|
|
L : NativeInt;
|
|
H : NativeInt;
|
|
C : NativeInt;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (ALoIdx < 0) or (ALoIdx >= FCount) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [ALoIdx]);
|
|
if (AHiIdx < 0) or (AHiIdx >= FCount) or (AHiIdx < ALoIdx) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AHiIdx]);
|
|
{$ELSE}
|
|
Assert((ALoIdx >= 0) and (ALoIdx < FCount));
|
|
Assert((AHiIdx >= 0) and (AHiIdx < FCount) and (AHiIdx >= ALoIdx));
|
|
{$ENDIF}
|
|
|
|
L := MaxNativeInt(0, ALoIdx);
|
|
H := MinNativeInt(Count - 1, AHiIdx);
|
|
C := MinNativeInt(Length(V), H - L + 1);
|
|
|
|
for I := 0 to C - 1 do
|
|
Item[L + I] := V[I];
|
|
end;
|
|
|
|
|
|
|
|
{%DEFINE AArrayDynArrayImpl}
|
|
{ }
|
|
{-T%1%Array }
|
|
{ }
|
|
class function T%1%Array.CreateInstance: T%1%Array;
|
|
begin
|
|
Result := T%1%Array.Create;
|
|
end;
|
|
|
|
constructor T%1%Array.Create;
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
constructor T%1%Array.Create(const V: %1%Array);
|
|
begin
|
|
inherited Create;
|
|
SetData(V);
|
|
end;
|
|
|
|
procedure T%1%Array.SetData(const AData: %1%Array);
|
|
begin
|
|
FData := AData;
|
|
FCount := Length(FData);
|
|
FCapacity := FCount;
|
|
end;
|
|
|
|
procedure T%1%Array.Clear;
|
|
begin
|
|
FData := nil;
|
|
FCapacity := 0;
|
|
FCount := 0;
|
|
end;
|
|
|
|
procedure T%1%Array.Assign(const ASource: %1%Array);
|
|
begin
|
|
SetData(Copy(ASource));
|
|
end;
|
|
|
|
procedure T%1%Array.Assign(const ASource: Array of %3%);
|
|
var
|
|
H : NativeInt;
|
|
L : NativeInt;
|
|
I : NativeInt;
|
|
begin
|
|
H := High(ASource);
|
|
L := H + 1;
|
|
SetLength(FData, L);
|
|
for I := 0 to H do
|
|
FData[I] := ASource[I];
|
|
FCount := L;
|
|
FCapacity := L;
|
|
end;
|
|
|
|
procedure T%1%Array.Assign(const ASource: T%1%Array);
|
|
var
|
|
D : %1%Array;
|
|
begin
|
|
if not Assigned(ASource) then
|
|
raise EArrayError.Create(SErrSourceNotAssigned);
|
|
|
|
D := Copy(ASource.FData);
|
|
SetLength(D, ASource.FCount);
|
|
SetData(D);
|
|
end;
|
|
|
|
function T%1%Array.Duplicate: T%1%Array;
|
|
var
|
|
Obj : T%1%Array;
|
|
begin
|
|
try
|
|
Obj := CreateInstance;
|
|
try
|
|
Obj.Assign(self);
|
|
except
|
|
Obj.Free;
|
|
raise;
|
|
end;
|
|
except
|
|
on E : Exception do
|
|
raise EArrayError.CreateFmt(SErrCannotDuplicate, [ClassName, E.Message]);
|
|
end;
|
|
Result := Obj;
|
|
end;
|
|
|
|
function T%1%Array.IsEqual(const V: T%1%Array): Boolean;
|
|
var
|
|
I, L : NativeInt;
|
|
begin
|
|
L := V.Count;
|
|
Result := L = Count;
|
|
if not Result then
|
|
exit;
|
|
for I := 0 to L - 1 do
|
|
if FData[I] <> V.FData[I] then
|
|
begin
|
|
Result := False;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
procedure T%1%Array.SetCount(const ANewCount: NativeInt);
|
|
var
|
|
L : NativeInt;
|
|
C : NativeInt;
|
|
N : NativeInt;
|
|
begin
|
|
N := ANewCount;
|
|
if N < 0 then
|
|
raise EArrayError.CreateFmt(SErrInvalidCountValue, [N]);
|
|
C := FCount;
|
|
if N = C 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 // pre-allocate 1/8th extra if growing
|
|
else
|
|
if N > L shr 1 then // only reduce capacity if size is at least half
|
|
exit;
|
|
|
|
if N <> L then
|
|
begin
|
|
SetLength(FData, N);
|
|
{%IF 2}if N > L then
|
|
FillChar(FData[L], SizeOf(%3%) * (N - L), 0);
|
|
{%ENDIF}
|
|
FCapacity := N;
|
|
end;
|
|
end;
|
|
|
|
function T%1%Array.GetItem(const AIdx: NativeInt): %3%;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (AIdx < 0) or (AIdx >= FCount) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);
|
|
{$ELSE}
|
|
Assert(AIdx >= 0);
|
|
Assert(AIdx < FCount);
|
|
{$ENDIF}
|
|
|
|
Result := FData[AIdx];
|
|
end;
|
|
|
|
procedure T%1%Array.SetItem(const AIdx: NativeInt; const AValue: %3%);
|
|
begin
|
|
{$IFOPT R+}
|
|
if (AIdx < 0) or (AIdx >= FCount) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);
|
|
{$ELSE}
|
|
Assert(AIdx >= 0);
|
|
Assert(AIdx < FCount);
|
|
{$ENDIF}
|
|
|
|
FData[AIdx] := AValue;
|
|
end;
|
|
|
|
function T%1%Array.PosNext(
|
|
const AItem: %3%;
|
|
const APrevPos: NativeInt;
|
|
const IsSortedAscending: Boolean): NativeInt;
|
|
var
|
|
F : NativeInt;
|
|
I : NativeInt;
|
|
L : NativeInt;
|
|
H : NativeInt;
|
|
D : %3%;
|
|
begin
|
|
F := APrevPos + 1;
|
|
if F < 0 then
|
|
F := 0;
|
|
if IsSortedAscending then // binary search
|
|
begin
|
|
if F = 0 then // find first
|
|
begin
|
|
L := 0;
|
|
H := Count - 1;
|
|
repeat
|
|
I := (L + H) div 2;
|
|
D := FData[I];
|
|
if D = AItem then
|
|
begin
|
|
while (I > 0) and (FData[I - 1] = AItem) do
|
|
Dec(I);
|
|
Result := I;
|
|
exit;
|
|
end
|
|
else
|
|
if %5%D{%IF 5}){%ENDIF} > %5%AItem{%IF 5}){%ENDIF} then
|
|
H := I - 1
|
|
else
|
|
L := I + 1;
|
|
until L > H;
|
|
Result := -1;
|
|
end
|
|
else // find next
|
|
if APrevPos >= Count - 1 then
|
|
Result := -1
|
|
else
|
|
if FData[APrevPos + 1] = AItem then
|
|
Result := APrevPos + 1
|
|
else
|
|
Result := -1;
|
|
end
|
|
else // linear search
|
|
begin
|
|
for I := F to Count - 1 do
|
|
if FData[I] = AItem then
|
|
begin
|
|
Result := I;
|
|
exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
end;
|
|
|
|
function T%1%Array.GetIndex(const AValue: %3%): NativeInt;
|
|
begin
|
|
Result := PosNext(AValue, -1, False);
|
|
end;
|
|
|
|
function T%1%Array.HasValue(const AValue: %3%): Boolean;
|
|
begin
|
|
Result := PosNext(AValue, -1, False) >= 0;
|
|
end;
|
|
|
|
function T%1%Array.Add(const AValue: %3%): NativeInt;
|
|
var
|
|
C : NativeInt;
|
|
begin
|
|
C := FCount;
|
|
if C >= FCapacity then
|
|
SetCount(C + 1)
|
|
else
|
|
FCount := C + 1;
|
|
FData[C] := AValue;
|
|
Result := C;
|
|
end;
|
|
|
|
function T%1%Array.AddIfNotExists(const AValue: %3%): NativeInt;
|
|
var
|
|
I : NativeInt;
|
|
begin
|
|
I := PosNext(AValue, -1);
|
|
if I < 0 then
|
|
I := Add(AValue);
|
|
Result := I;
|
|
end;
|
|
|
|
function T%1%Array.AddArray(const AArray: %1%Array): NativeInt;
|
|
var
|
|
C : NativeInt;
|
|
I : NativeInt;
|
|
L : NativeInt;
|
|
begin
|
|
C := FCount;
|
|
L := Length(AArray);
|
|
SetCount(C + L);
|
|
|
|
for I := 0 to L - 1 do
|
|
FData[C + I] := AArray[I];
|
|
|
|
Result := C;
|
|
end;
|
|
|
|
function T%1%Array.AddArray(const AArray: T%1%Array): NativeInt;
|
|
var
|
|
C : NativeInt;
|
|
I : NativeInt;
|
|
L : NativeInt;
|
|
begin
|
|
if not Assigned(AArray) then
|
|
raise EArrayError.Create(SErrSourceNotAssigned);
|
|
|
|
C := FCount;
|
|
L := AArray.FCount;
|
|
SetCount(C + L);
|
|
|
|
for I := 0 to L - 1 do
|
|
FData[C + I] := AArray.FData[I];
|
|
|
|
Result := C;
|
|
end;
|
|
|
|
procedure T%1%Array.Insert(const AIdx: NativeInt; const ACount: NativeInt = 1);
|
|
var
|
|
C : NativeInt;
|
|
A : NativeInt;
|
|
N : NativeInt;
|
|
begin
|
|
C := FCount;
|
|
if (AIdx < 0) or (AIdx > C) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);
|
|
if ACount <= 0 then
|
|
exit;
|
|
|
|
A := ACount;
|
|
N := C + A;
|
|
if N > FCapacity then
|
|
SetCount(N)
|
|
else
|
|
FCount := N;
|
|
|
|
if AIdx < C then
|
|
Move(FData[AIdx], FData[AIdx + A], (C - AIdx) * SizeOf(%3%));
|
|
|
|
FillChar(FData[AIdx], A * SizeOf(%3%), 0);
|
|
end;
|
|
|
|
procedure T%1%Array.Delete(const AIdx: NativeInt; const ACount: NativeInt = 1);
|
|
var
|
|
A : NativeInt;
|
|
C : NativeInt;
|
|
L : NativeInt;{%IF 6}
|
|
I : NativeInt;{%ENDIF}
|
|
begin
|
|
A := ACount;
|
|
if A <= 0 then
|
|
exit;
|
|
|
|
C := FCount;
|
|
if (AIdx < 0) or (AIdx >= C) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);
|
|
|
|
L := AIdx + A;
|
|
if L > C then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AIdx]);{%IF 6}
|
|
|
|
for I := AIdx to L - 1 do
|
|
FData[I] := %6%;{%ENDIF}
|
|
|
|
if L < C then{%IF 6}
|
|
begin
|
|
{%ENDIF} Move(FData[AIdx + A], FData[AIdx], SizeOf(%3%) * (C - AIdx - A));{%IF 6}
|
|
FillChar(FData[C - A], SizeOf(%3%) * A, 0);
|
|
end;{%ENDIF}
|
|
|
|
SetCount(C - A);
|
|
end;
|
|
|
|
function T%1%Array.CompareItems(const AIdx1, AIdx2: NativeInt): Int32;
|
|
var
|
|
I, J : %3%;
|
|
begin
|
|
Assert(AIdx1 >= 0);
|
|
Assert(AIdx1 < FCount);
|
|
Assert(AIdx2 >= 0);
|
|
Assert(AIdx2 < FCount);
|
|
|
|
I := FData[AIdx1];
|
|
J := FData[AIdx2];
|
|
if %5%I{%IF 5}){%ENDIF} < %5%J{%IF 5}){%ENDIF} then
|
|
Result := -1
|
|
else
|
|
if %5%I{%IF 5}){%ENDIF} > %5%J{%IF 5}){%ENDIF} then
|
|
Result := 1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure T%1%Array.Sort;
|
|
|
|
procedure QuickSort(L, R: NativeInt);
|
|
var
|
|
I : NativeInt;
|
|
J : NativeInt;
|
|
M : NativeInt;
|
|
T : %3%;
|
|
begin
|
|
repeat
|
|
I := L;
|
|
J := R;
|
|
M := (L + R) shr 1;
|
|
repeat
|
|
while CompareItems(I, M) < 0 do
|
|
Inc(I);
|
|
while CompareItems(J, M) > 0 do
|
|
Dec(J);
|
|
if I <= J then
|
|
begin
|
|
T := FData[I];
|
|
FData[I] := FData[J];
|
|
FData[J] := T;
|
|
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
|
|
C : NativeInt;
|
|
begin
|
|
C := Count;
|
|
if C > 0 then
|
|
QuickSort(0, C - 1);
|
|
end;
|
|
|
|
procedure T%1%Array.Fill(const AIdx, ACount: NativeInt; const AValue: %3%);
|
|
var
|
|
I : NativeInt;
|
|
begin
|
|
for I := AIdx to AIdx + ACount - 1 do
|
|
FData[I] := AValue;
|
|
end;
|
|
|
|
function T%1%Array.GetRange(const ALoIdx, AHiIdx: NativeInt): %1%Array;
|
|
var
|
|
L : NativeInt;
|
|
H : NativeInt;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (ALoIdx < 0) or (ALoIdx >= FCount) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [ALoIdx]);
|
|
if (AHiIdx < 0) or (AHiIdx >= FCount) or (AHiIdx < ALoIdx) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AHiIdx]);
|
|
{$ELSE}
|
|
Assert((ALoIdx >= 0) and (ALoIdx < FCount));
|
|
Assert((AHiIdx >= 0) and (AHiIdx < FCount) and (AHiIdx >= ALoIdx));
|
|
{$ENDIF}
|
|
|
|
L := MaxNativeInt(0, ALoIdx);
|
|
H := MinNativeInt(AHiIdx, FCount);
|
|
if H >= L then
|
|
Result := Copy(FData, L, H - L + 1)
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure T%1%Array.SetRange(const ALoIdx, AHiIdx: NativeInt; const V: %1%Array);
|
|
var
|
|
L : NativeInt;
|
|
H : NativeInt;
|
|
C : NativeInt;
|
|
begin
|
|
{$IFOPT R+}
|
|
if (ALoIdx < 0) or (ALoIdx >= FCount) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [ALoIdx]);
|
|
if (AHiIdx < 0) or (AHiIdx >= FCount) or (AHiIdx < ALoIdx) then
|
|
raise EArrayError.CreateFmt(SErrArrayIndexOutOfBounds, [AHiIdx]);
|
|
{$ELSE}
|
|
Assert((ALoIdx >= 0) and (ALoIdx < FCount));
|
|
Assert((AHiIdx >= 0) and (AHiIdx < FCount) and (AHiIdx >= ALoIdx));
|
|
{$ENDIF}
|
|
|
|
L := MaxNativeInt(0, ALoIdx);
|
|
H := MinNativeInt(AHiIdx, FCount);
|
|
C := MaxNativeInt(MinNativeInt(Length(V), H - L + 1), 0);
|
|
if C > 0 then
|
|
Move(V[0], FData[L], C * Sizeof(%3%));
|
|
end;
|
|
|
|
{%IF 7}function T%1%Array.GetItemAsString(const AIdx: NativeInt): String;
|
|
begin
|
|
Result := %7%(GetItem(AIdx));
|
|
end;
|
|
|
|
function T%1%Array.GetAsString: String;
|
|
var
|
|
I : NativeInt;
|
|
L : NativeInt;
|
|
begin
|
|
L := FCount;
|
|
if L = 0 then
|
|
begin
|
|
Result := '';
|
|
exit;
|
|
end;
|
|
Result := GetItemAsString(0);
|
|
for I := 1 to L - 1 do
|
|
Result := Result + ',' + GetItemAsString(I);
|
|
end;
|
|
{%ENDIF}
|
|
{%IF 8}procedure T%1%Array.SetItemAsString(const AIdx: NativeInt; const AValue: String);
|
|
begin
|
|
SetItem(AIdx, %8%(AValue));
|
|
end;
|
|
|
|
procedure T%1%Array.SetAsString(const S: String);
|
|
var
|
|
L : NativeInt;
|
|
F : NativeInt;
|
|
C : NativeInt;
|
|
G : NativeInt;
|
|
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;
|
|
{%ENDIF}
|
|
{%ENDDEF}
|
|
|
|
{%TEMPLATE AArrayDynArrayImpl 'Int32' 'Z' 'Int32' '' '' '' 'IntToStr' 'StrToInt' }
|
|
{%TEMPLATE AArrayDynArrayImpl 'Int64' 'Z' 'Int64' '' '' '' 'IntToStr' 'StrToInt64' }
|
|
{%TEMPLATE AArrayDynArrayImpl 'Byte' 'Z' 'Byte' '' '' '' 'IntToStr' 'StrToInt' }
|
|
{%TEMPLATE AArrayDynArrayImpl 'Word32' 'Z' 'Word32' '' '' '' 'IntToStr' 'StrToInt' }
|
|
{%TEMPLATE AArrayDynArrayImpl 'Word64' 'Z' 'Word64' '' '' '' '' '' }
|
|
{%TEMPLATE AArrayDynArrayImpl 'Single' 'Z' 'Single' '' '' '' 'FloatToStr' 'StrToFloat' }
|
|
{%TEMPLATE AArrayDynArrayImpl 'Double' 'Z' 'Double' '' '' '' 'FloatToStr' 'StrToFloat' }
|
|
{$IFDEF SupportAnsiString}
|
|
{%TEMPLATE AArrayDynArrayImpl 'AnsiString' 'Z' 'AnsiString' 'A' '' '''''' 'String' 'AnsiString' }
|
|
{$ENDIF}
|
|
{%TEMPLATE AArrayDynArrayImpl 'RawByteString' 'Z' 'RawByteString' 'B' '' '''''' 'String' 'RawByteString' }
|
|
{%TEMPLATE AArrayDynArrayImpl 'UnicodeString' 'Z' 'UnicodeString' 'U' '' '''''' 'String' 'UnicodeString' }
|
|
{%TEMPLATE AArrayDynArrayImpl 'Pointer' 'Z' 'Pointer' '' 'NativeUInt(' 'nil' '' '' }
|
|
{%TEMPLATE AArrayDynArrayImpl 'Interface' 'Z' 'IInterface' '' 'NativeUInt(' 'nil' '' '' }
|
|
|
|
|
|
|
|
end.
|
|
|