xtool/contrib/fundamentals/Utils/Templates/flcDataStructArrays.inc

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.