unit XLists;

interface

uses
	SysUtils, Classes;

type
	PXByteArray = ^TXByteArray;
	TXByteArray = array [0..MaxInt div sizeof(Byte) - 1] of Byte;

	PXWordArray = ^TXWordArray;
	TXWordArray = array [0..MaxInt div sizeof(Word) - 1] of Word;

	PXLongArray = ^TXLongArray;
	TXLongArray = array [0..MaxInt div sizeof(Longint) - 1] of Longint;

	PXIntArray = ^TXIntArray;
	TXIntArray = array [0..MaxInt div sizeof(Integer) - 1] of Integer;

	EArray = class(Exception);

	TObjectList = class(TList)
	protected
		procedure ItemInserted(anItem: Pointer); virtual;
		procedure ItemRemoved(anItem: Pointer); virtual;
		procedure ClearItem(anItem: TObject); virtual;
	public
		destructor Destroy; override;

		function Add(anItem: Pointer): Integer;
		procedure Insert(anIndex: Integer; anItem: Pointer);
		function Remove(anItem: Pointer): Integer;
		function Delete(anIndex: Integer): TObject;
		procedure Clear; override;
		procedure RemoveAll;
	end;

	{	TRecArray }
	ERecArray = class(Exception);
	TRecArrayBase = object
		Items: Pointer;
		ItemSize,
		Capacity,
		Count: Longint;
	end;
	
	TRecArray = object(TRecArrayBase)
		procedure Init(anItemSize: Longint);
		procedure Done;

		procedure Clear;
		procedure Assign(const aSrc: TRecArrayBase);
		procedure Grow;
		procedure SetCapacity(aValue: Longint);

		procedure LoadFromStream(aStm: TStream);
		procedure SaveToStream(aStm: TStream);

		procedure AddRecs(const aRec; aCount: Longint);
		procedure InsertRecs(anIndex: Integer; const aRec; aCount: Longint);
		procedure DeleteRecs(anIndex, aCount: Integer);

		procedure Add(const aRec);
		procedure Insert(anIndex: Integer; const aRec);
		procedure Delete(anIndex: Integer);

		function GetPtr(anIndex: Integer): Pointer;
		procedure Get(anIndex: Integer; var aRec);
		procedure Put(anIndex: Integer; const aRec);
	end;

	{ TListBase }

	TListBase = class(TPersistent)
	private
		FUpdateCount: Integer;
		FSorted: Boolean;
		FDuplicates: TDuplicates;
		FOnChange: TNotifyEvent;
		FOnChanging: TNotifyEvent;
		FCount: Longint;

		procedure SetSorted(Value: Boolean);

	protected

		procedure Changed;
		procedure Changing;

		procedure QuickSort(L, R: Integer); virtual; abstract;

	public
		procedure Sort;
		procedure BeginUpdate;
		procedure EndUpdate;

		property Count: Longint read FCount;
		property Sorted: Boolean read FSorted write SetSorted;
		property Duplicates: TDuplicates read FDuplicates write FDuplicates;
		property OnChange: TNotifyEvent read FOnChange write FOnChange;
		property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
	end;

	{ TByteList }

	TByteList = class(TListBase)
	private
		Delta,
		FCapacity: Integer;
		FItems: PXByteArray;

		procedure SetCapacity(aCapacity: Integer);
		function GetItem(anIndex: Integer): Byte;
		procedure SetItem(anIndex: Integer; aValue: Byte);

	protected
		procedure AssignTo(Dest: TPersistent); override;
		procedure DefineProperties(aFiler: TFiler); override;
		procedure QuickSort(L, R: Integer); override;

	public
		constructor Create;
		destructor Destroy; override;

		procedure LoadFromStream(aStream: TStream);
		procedure SaveToStream(aStream: TStream);

		function Add(aValue: Byte): Integer;
		procedure Delete(anIndex: Integer);
		procedure Insert(anIndex: Integer; aValue: Byte);
		procedure Clear;

		procedure Exchange(Index1, Index2: Integer);
		function Find(Value: Byte; var Index: Integer): Boolean;
		function IndexOf(Value: Byte): Integer;

		property Capacity: Integer read FCapacity write SetCapacity;
		property Items[anIndex: Integer]: Byte read GetItem write SetItem; 
	end;

	{ TWordList }

	TWordList = class(TListBase)
	private
		Delta,
		FCapacity: Integer;
		FItems: PXWordArray;

		procedure SetCapacity(aCapacity: Integer);
		function GetItem(anIndex: Integer): Word;
		procedure SetItem(anIndex: Integer; aValue: Word);

	protected

		procedure AssignTo(Dest: TPersistent); override;
		procedure DefineProperties(aFiler: TFiler); override;
		procedure QuickSort(L, R: Integer); override;

	public
		constructor Create;
		destructor Destroy; override;

		procedure LoadFromStream(aStream: TStream);
		procedure SaveToStream(aStream: TStream);

		function Add(aValue: Word): Integer;
		procedure Delete(anIndex: Integer);
		procedure Insert(anIndex: Integer; aValue: Word);
		procedure Clear;

		procedure Exchange(Index1, Index2: Integer);
		function Find(Value: Word; var Index: Integer): Boolean;
		function IndexOf(Value: Word): Integer;

		property Capacity: Integer read FCapacity write SetCapacity;
		property Items[anIndex: Integer]: Word read GetItem write SetItem; default;
	end;

	{ TLongintList }

	TCompareLongintFunc = function(Value1, Value2: LongInt): Integer;

	TLongintList = class(TListBase)
	private
		Delta,
		FCapacity: Integer;
		FItems: PXLongArray;

		procedure SetCapacity(aCapacity: Integer);
		function GetItem(anIndex: Integer): Longint;
		procedure SetItem(anIndex: Integer; aValue: Longint);

		function Compare(Value1, Value2: Longint): Integer;

	protected
		procedure AssignTo(Dest: TPersistent); override;
		procedure DefineProperties(aFiler: TFiler); override;
		procedure QuickSort(L, R: Integer); override;

	public
		CompareValues: TCompareLongintFunc;

		constructor Create;
		destructor Destroy; override;

		procedure LoadFromStream(aStream: TStream);
		procedure SaveToStream(aStream: TStream);

		function Add(aValue: Longint): Integer;
		procedure Delete(anIndex: Integer);
		procedure Insert(anIndex: Integer; aValue: Longint);
		procedure Clear;

		procedure Exchange(Index1, Index2: Integer);
		function Find(Value: LongInt; var Index: Integer): Boolean;
		function IndexOf(Value: LongInt): Integer;

		property Capacity: Integer read FCapacity write SetCapacity;
		property Items[anIndex: Integer]: Longint read GetItem write SetItem; default;
	end;

	{ TIntegerList }

	TCompareIntegerFunc = function(Value1, Value2: LongInt): Integer;

	TIntegerList = class(TListBase)
	private
		Delta,
		FCapacity: Integer;
		FItems: PXLongArray;

		procedure SetCapacity(aCapacity: Integer);
		function GetItem(anIndex: Integer): Integer;
		procedure SetItem(anIndex: Integer; aValue: Integer);

		function Compare(Value1, Value2: Integer): Integer;

	protected
		procedure AssignTo(Dest: TPersistent); override;
		procedure DefineProperties(aFiler: TFiler); override;
		procedure QuickSort(L, R: Integer); override;

	public
		CompareValues: TCompareIntegerFunc;

		constructor Create;
		destructor Destroy; override;

		procedure LoadFromStream(aStream: TStream);
		procedure SaveToStream(aStream: TStream);

		function Add(aValue: Integer): Integer;
		procedure Delete(anIndex: Integer);
		procedure Insert(anIndex: Integer; aValue: Integer);
		procedure Clear;

		procedure Exchange(Index1, Index2: Integer);
		function Find(Value: LongInt; var Index: Integer): Boolean;
		function IndexOf(Value: LongInt): Integer;

		property Capacity: Integer read FCapacity write SetCapacity;
		property Items[anIndex: Integer]: Integer read GetItem write SetItem; default;
	end;

	{ TPointerList }

	TFreeItem = procedure(anItem: Pointer);
	TReadItem = function(aStm: TStream): Pointer;
	TWriteItem = procedure(aStm: TStream; anItem: Pointer);
	TCompareKeys = function(aKey1, aKey2: Pointer): Integer;
	TKeyOf = function(anItem: Pointer): Pointer;

	TPtrList = class(TLongintList)
	private
		function GetItem(anIndex: Integer): Pointer;
		procedure SetItem(anIndex: Integer; aValue: Pointer);

	public
		FreeItem: TFreeItem;
		CompareKeys: TCompareKeys;
		KeyOf: TKeyOf;

		ReadItem: TReadItem;
		WriteItem: TWriteItem;

		destructor Destroy; override;
		procedure LoadFromStream(aStream: TStream);
		procedure SaveToStream(aStream: TStream);

		procedure Find;
		procedure Clear(aDummy: Integer);

		procedure DeleteAll;
    procedure FreeAll;

    procedure AtFree(anIndex: Integer);

		function Add(anItem: Pointer): Integer;
		function FindKey(const aKey; var Index: Integer): Boolean;
		function IndexOf(anItem: Pointer): Integer;
		procedure Insert(anIndex: Integer; anItem: Pointer);
		property Items[anIndex: Integer]: Pointer read GetItem write SetItem; 
	end;

	{ TRecList }

	TCompareRecFunc = function(const Value1, Value2): Integer;
	TRecList = class(TListBase)
	private
		Delta,
		FCapacity,
		FItemSize: Integer;
		FItems: Pointer;
		FCompareValues: TCompareRecFunc;

		procedure SetCapacity(aCapacity: Integer);
		function GetItem(anIndex: Integer): Pointer;

	protected
		procedure AssignTo(Dest: TPersistent); override;
		procedure DefineProperties(aFiler: TFiler); override;
		function Compare(const Value1, Value2): Integer;
		procedure QuickSort(L, R: Integer); override;

	public
		constructor Create(anItemSize: Integer);
		destructor Destroy; override;

		procedure LoadFromMemory(aBuffer: Pointer; aCount: Integer);

		procedure LoadFromStream(aStream: TStream);
		procedure SaveToStream(aStream: TStream);

		function Add(const aValue): Integer;
		procedure Delete(anIndex: Integer);
		procedure Insert(anIndex: Integer; const aValue);
		procedure Clear;

		procedure Exchange(Index1, Index2: Integer);
		function Find(const Value; var Index: Integer): Boolean;
		function IndexOf(const Value): Integer;

		property Capacity: Integer read FCapacity write SetCapacity;
		property Items[anIndex: Integer]: Pointer read GetItem;
		property CompareItems: TCompareRecFunc read FCompareValues write FCompareValues;
	end;

	TEnumList = class
	private
		FList,
		FAdding: TList;
		FEnumCount: Integer;
	protected
		procedure ItemInserted(anItem: Pointer); virtual;
		procedure ItemRemoving(anItem: Pointer); virtual;
	public
		constructor Create;
		destructor Destroy; override;

		function HasItem(anItem: Pointer): Boolean;
		function BeginEnum: TList;
		procedure EndEnum;

		procedure Add(anItem: Pointer);
		procedure Remove(anItem: Pointer);
	end;

{ TEventList }

	TObjectProc = record
		Proc, Obj: Pointer;
	end;

	PEventRec = ^TEventRec;
	TEventRec = record
		Proc: TObjectProc;
		Flag: (erNormal, erUnregistered, erRegistered);
		Data: record end;
	end;

	TCompareEventDataProc = function (const aData1, aData2): Boolean;
	TEventList = class
	private
		PreventRegistration: Boolean;
		List: TRecList;
		Current: PEventRec;
		CurrentIndex: Integer;
		DataSize: Integer;
		FCompareData: TCompareEventDataProc;

	public
		property CompareData: TCompareEventDataProc read FCompareData write FCompareData;

		constructor Create(const aName: string; aDataSize: Integer);
		destructor Destroy; override;

		function GetFirst: Pointer;
		function GetNext: Pointer;


		procedure Register(const anEvent, aData); { anEvent: procedure of object }
		procedure Unregister(const anEvent, aData); { anEvent: procedure of object }
	end;

function CompareLongints(Value1, Value2: Longint): Integer;
function CompareIntegers(Value1, Value2: Integer): Integer;

const
	CompareLongintsFunc: TCompareLongintFunc = CompareLongints;
	CompareIntegersFunc: TCompareIntegerFunc = CompareIntegers;

implementation

uses
	InSysUtils;

//******************************************************************
//	TRecArray
//
procedure TRecArray.Init(anItemSize: Longint);
begin
	Items := nil;
	ItemSize := anItemSize;
	Capacity := 0;
	Count := 0;
end;

procedure TRecArray.Done;
begin
	Clear;
end;

procedure TRecArray.Assign(const aSrc: TRecArrayBase);
begin
	if ItemSize <> aSrc.ItemSize then
		raise ERecArray.Create('Не совпадает размер элемента (TRecArray.Assign)');
	if Capacity < aSrc.Count then
		SetCapacity(aSrc.Count);
	if aSrc.Count <> 0 then
		Move(aSrc.Items^, Items^, ItemSize * aSrc.Count);
	Count := aSrc.Count;
end;

procedure TRecArray.Clear;
begin
	if Assigned(Items) then begin
		FreeMem(Items);
		Items := nil;
	end;
	Capacity := 0;
	Count := 0;
end;

procedure TRecArray.SetCapacity(aValue: Longint);
var
	aNewItems: Pointer;
begin
	if aValue < Count then
		aValue := Count;
	if aValue <> Capacity then begin
		if aValue > 0 then
			aNewItems := AllocMem(aValue * ItemSize)
		else
			aNewItems := nil;
		if Assigned(Items) then begin
			if Assigned(aNewItems) then
				Move(Items^, aNewItems^, Count * ItemSize);
			FreeMem(Items);
		end;
		Capacity := aValue;
		Items := aNewItems;
	end;
end;

procedure TRecArray.Grow;
var
	aDelta: Integer;
begin
	if Capacity > 64 then aDelta := Capacity div 4 else
		if Capacity > 8 then aDelta := 16 else
			aDelta := 4;
	SetCapacity(Capacity + aDelta);
end;

procedure TRecArray.LoadFromStream(aStm: TStream);
var
	aSize: Longint;
begin
	Clear;
	aStm.ReadBuffer(aSize, sizeof(aSize));
	SetCapacity(aSize div ItemSize);
	aStm.ReadBuffer(Items^, aSize);
	Count := Capacity;
end;

procedure TRecArray.SaveToStream(aStm: TStream);
var
	aSize: Longint;
begin
	aSize := Count * ItemSize;
	aStm.WriteBuffer(aSize, sizeof(aSize));
	if aSize <> 0 then
		aStm.WriteBuffer(Items^, aSize);
end;

procedure TRecArray.InsertRecs(anIndex: Integer; const aRec; aCount: Longint);
var
	aPos, aDelta,
	aNewCount: Longint;
begin
	if (anIndex < 0) or (anIndex > Count) then
		raise ERecArray.Create('Индекс массива выходит за пределы (TRecArray.InsertRecs)');

	aNewCount := Count + aCount;
	if aNewCount > Capacity then
		SetCapacity(aNewCount);

	aPos := anIndex * ItemSize;
	aDelta := aCount * ItemSize;
	if anIndex < Count then
		Move(Pointer(Longint(Items) + aPos)^, Pointer(Longint(Items) + aPos + aDelta)^,
			(Count - anIndex) * ItemSize);

	Move(aRec, Pointer(Longint(Items) + aPos)^, aDelta);
	Count := aNewCount;
end;

procedure TRecArray.DeleteRecs(anIndex, aCount: Integer);
var
	aPos: Longint;
begin
	if (anIndex < 0) or (anIndex + aCount > Count) then
		raise ERecArray.Create('Индекс массива выходит за пределы (TRecArray.DeleteRecs)');
	if anIndex + aCount < Count then begin
		aPos := anIndex * ItemSize;
		Move(Pointer(Longint(Items) + aPos + aCount * ItemSize)^,
			Pointer(Longint(Items) + aPos)^, (Count - anIndex - aCount) * ItemSize);
	end;
	Dec(Count, aCount);
end;

procedure TRecArray.AddRecs(const aRec; aCount: Longint);
begin
	InsertRecs(Count, aRec, aCount);
end;

procedure TRecArray.Add(const aRec);
begin
	if Count = Capacity then
		Grow;
	AddRecs(aRec, 1);
end;

procedure TRecArray.Insert(anIndex: Integer; const aRec);
begin
	if Count = Capacity then
		Grow;
	InsertRecs(anIndex, aRec, 1);
end;

procedure TRecArray.Delete(anIndex: Integer);
begin
	DeleteRecs(anIndex, 1);
end;

function TRecArray.GetPtr(anIndex: Integer): Pointer;
begin
	if (anIndex < 0) or (anIndex >= Count) then
		raise ERecArray.CreateFmt('Индекс массива %d выходит за пределы [0, %d] (TRecArray.GetPtr)', [anIndex, Count - 1]);
	Result := Pointer(Longint(Items) + anIndex * ItemSize);
end;

procedure TRecArray.Get(anIndex: Integer; var aRec);
begin
	Move(GetPtr(anIndex)^, aRec, ItemSize);
end;

procedure TRecArray.Put(anIndex: Integer; const aRec);
begin
	Move(aRec, GetPtr(anIndex)^, ItemSize);
end;

procedure CheckIndex(anIndex, aCount: Longint);
begin
	if (anIndex < 0) or (anIndex >= aCount) then
		raise EArray.CreateFmt('Индекс массива %d выходит за пределы [0, %d]', [anIndex, aCount - 1]);
end;

function CompareLongints(Value1, Value2: Longint): Integer;
begin
	if Value1 < Value2 then Result := -1
	else if Value1 = Value2 then Result := 0
	else Result := 1;
end;

function CompareIntegers(Value1, Value2: Integer): Integer;
begin
	if Value1 < Value2 then Result := -1
	else if Value1 = Value2 then Result := 0
	else Result := 1;
end;

{	TObjectList	}

destructor TObjectList.Destroy;
begin
	Clear;
	inherited Destroy;
end;

procedure TObjectList.ItemInserted(anItem: Pointer);
begin
end;

procedure TObjectList.ItemRemoved(anItem: Pointer);
begin
end;

function TObjectList.Add(anItem: Pointer): Integer;
begin
	Result := inherited Add(anItem);
	if Assigned(anItem) then
		ItemInserted(anItem);
end;

procedure TObjectList.Insert(anIndex: Integer; anItem: Pointer);
begin
	inherited Insert(anIndex, anItem);
	if Assigned(anItem) then
		ItemInserted(anItem);
end;

function TObjectList.Remove(anItem: Pointer): Integer;
begin
	Result := inherited Remove(anItem);
	if (Result <> -1) and Assigned(anItem)  then
		ItemRemoved(anItem);
end;

function TObjectList.Delete(anIndex: Integer): TObject;
begin
	Result := Items[anIndex];
	inherited Delete(anIndex);
	if Assigned(Result) then
		ItemRemoved(Result);
end;

procedure TObjectList.Clear;
var
	i: Integer;
	anItem: TObject;
begin
	i := Count - 1;
	while i >= 0 do begin
		anItem := Items[i];
		inherited Delete(i);
		if Assigned(anItem) then begin
			ItemRemoved(anItem);
			ClearItem(anItem);
		end;
		i := Count - 1;
	end;
	inherited Clear;
end;

procedure TObjectList.ClearItem(anItem: TObject);
begin
	anItem.Free;
end;

procedure TObjectList.RemoveAll;
var
	i: Integer;
begin
	i := Count - 1;
	while i >= 0 do begin
		Delete(i);
		i := Count - 1;
	end;
	inherited Clear;
end;

{ TListBase }

procedure TListBase.Changed;
begin
	if (FUpdateCount = 0) and Assigned(FOnChange) then FOnChange(Self);
end;

procedure TListBase.Changing;
begin
	if (FUpdateCount = 0) and Assigned(FOnChanging) then FOnChanging(Self);
end;

procedure TListBase.SetSorted(Value: Boolean);
begin
	if FSorted <> Value then
	begin
		if Value then Sort;
		FSorted := Value;
	end;
end;

procedure TListBase.Sort;
begin
	if not Sorted and (FCount > 1) then
	begin
		BeginUpdate;
		QuickSort(0, Count - 1);
		EndUpdate;
	end;
end;

procedure TListBase.BeginUpdate;
begin
	if FUpdateCount = 0 then Changing;
	Inc(FUpdateCount);
end;

procedure TListBase.EndUpdate;
begin
	Dec(FUpdateCount);
	if FUpdateCount = 0 then Changed;
end;

{	TByteList }

procedure TByteList.SetCapacity(aCapacity: Integer);
begin
	if aCapacity > FCount then begin
		ReallocMem(FItems, aCapacity);
		FCapacity := aCapacity;
	end;
end;

procedure TByteList.QuickSort(L, R: Integer);
var
	I, J: Integer;
	P: Byte;
begin
	I := L;
	J := R;
	P := FItems^[(L + R) shr 1];
	repeat
		while FItems^[I] < P do Inc(I);
		while FItems^[J] > P do Dec(J);
		if I <= J then
		begin
			Exchange(I, J);
			Inc(I);
			Dec(J);
		end;
	until I > J;
	if L < J then QuickSort(L, J);
	if I < R then QuickSort(I, R);
end;

function TByteList.GetItem(anIndex: Integer): Byte;
begin
	CheckIndex(anIndex, FCount);
	result := FItems^[anIndex];
end;

procedure TByteList.SetItem(anIndex: Integer; aValue: Byte);
begin
	CheckIndex(anIndex, FCount);
	FItems^[anIndex] := aValue;
end;

procedure TByteList.AssignTo(Dest: TPersistent);
var
	i: Word;
begin
	if Dest is TByteList then begin
		TByteList(Dest).BeginUpdate;
		TByteList(Dest).Clear;
		TByteList(Dest).Capacity := FCount;
		Move(FItems^, TByteList(Dest).FItems^, FCount);
		TByteList(Dest).FCount := FCount;
		TByteList(Dest).EndUpdate;
		Exit;
	end
	else if Dest is TWordList then begin
		TWordList(Dest).BeginUpdate;
		TWordList(Dest).Clear;
		TWordList(Dest).Capacity := FCount;
		for i := 0 to FCount - 1 do
			TWordList(Dest).FItems^[i] := FItems^[i];
		TWordList(Dest).FCount := FCount;
		TWordList(Dest).EndUpdate;
		Exit;
	end
	else if Dest is TLongintList then begin
		TLongintList(Dest).BeginUpdate;
		TLongintList(Dest).Clear;
		TLongintList(Dest).Capacity := FCount;
		for i := 0 to FCount - 1 do
			TLongintList(Dest).FItems^[i] := FItems^[i];
		TLongintList(Dest).FCount := FCount;
		TLongintList(Dest).EndUpdate;
		Exit;
	end;
	inherited AssignTo(Dest);
end;

procedure TByteList.DefineProperties(aFiler: TFiler);
begin
	inherited DefineProperties(aFiler);
	aFiler.DefineBinaryProperty('Items', LoadFromStream, SaveToStream, FCount > 0);
end;

constructor TByteList.Create;
begin
	inherited Create;
	Delta := 16;
end;

destructor TByteList.Destroy;
begin
	if Assigned(FItems) then
		FreeMem(FItems, FCapacity);
	inherited Destroy;
end;

procedure TByteList.LoadFromStream(aStream: TStream);
var
	aCount: Word;
begin
	BeginUpdate;
	aStream.ReadBuffer(aCount, sizeof(aCount));
	Capacity := aCount;
	if aCount > 0 then
		aStream.ReadBuffer(FItems^, aCount);
	FCount := aCount;
  EndUpdate;
end;

procedure TByteList.SaveToStream(aStream: TStream);
var
	aCount: Word;
begin
	aCount := FCount;
	aStream.WriteBuffer(aCount, sizeof(aCount));
	if FCount > 0 then
		aStream.WriteBuffer(FItems^, FCount);
end;

function TByteList.Add(aValue: Byte): Integer;
begin
	if not Sorted then
		Result := FCount
	else
		if Find(aValue, Result) then
			case Duplicates of
				dupIgnore: Exit;
				dupError: raise EArray.Create('Значение уже имеется в списке');
			end;

	Insert(Result, aValue);
end;

procedure TByteList.Insert(anIndex: Integer; aValue: Byte);
begin
	Changing;

	CheckIndex(anIndex, FCount + 1);

	if FCount >= FCapacity then
		Capacity := FCount + Delta;

	if anIndex < FCount then
		Move(FItems^[anIndex], FItems^[anIndex + 1], FCount - anIndex);
	FItems^[anIndex] := aValue;
	Inc(FCount);

	Changed;
end;

procedure TByteList.Delete(anIndex: Integer);
begin
	Changing;
	CheckIndex(anIndex, FCount);
	Dec(FCount);
	if anIndex < FCount then
		Move(FItems^[anIndex + 1], FItems^[anIndex], FCount - anIndex);
	Changed;
end;

procedure TByteList.Clear;
begin
	Changing;
	FCount := 0;
	Changed;
end;

procedure TByteList.Exchange(Index1, Index2: Integer);
var
	T: Byte;
begin
	CheckIndex(Index1, FCount);
	CheckIndex(Index2, FCount);
	Changing;
	T := FItems^[Index1];
	FItems^[Index1] := FItems^[Index2];
	FItems^[Index2] := T;
	Changed;
end;

function TByteList.Find(Value: Byte; var Index: Integer): Boolean;
var
	L, H, I: Integer;
begin
	Result := False;
	L := 0;
	H := Count - 1;
	while L <= H do
	begin
		I := (L + H) shr 1;
		if FItems^[I] < Value then L := I + 1
		else begin
			H := I - 1;
			if FItems^[I] = Value then
			begin
				Result := True;
				if Duplicates <> dupAccept then L := I;
			end;
		end;
	end;
	Index := L;
end;

function TByteList.IndexOf(Value: Byte): Integer;
begin
	if not Sorted then
	begin
		for Result := 0 to FCount - 1 do
			if Value = FItems^[Result] then
				Exit;
		Result := -1;
	end
	else
		if not Find(Value, Result) then Result := -1;
end;

{	TWordList }

procedure TWordList.SetCapacity(aCapacity: Integer);
begin
	if aCapacity > FCount then begin
		ReallocMem(FItems, aCapacity * sizeof(Word));
		FCapacity := aCapacity;
	end;
end;

function TWordList.GetItem(anIndex: Integer): Word;
begin
	CheckIndex(anIndex, FCount);
	result := FItems^[anIndex];
end;

procedure TWordList.SetItem(anIndex: Integer; aValue: Word);
begin
	CheckIndex(anIndex, FCount);
	FItems^[anIndex] := aValue;
end;

procedure TWordList.QuickSort(L, R: Integer);
var
	I, J: Integer;
	P: Word;
begin
	I := L;
	J := R;
	P := FItems^[(L + R) shr 1];
	repeat
		while FItems^[I] < P do Inc(I);
		while FItems^[J] > P do Dec(J);
		if I <= J then
		begin
			Exchange(I, J);
			Inc(I);
			Dec(J);
		end;
	until I > J;
	if L < J then QuickSort(L, J);
	if I < R then QuickSort(I, R);
end;

procedure TWordList.AssignTo(Dest: TPersistent);
var
	i: Word;
begin
	if Dest is TByteList then begin
  	TByteList(Dest).BeginUpdate;
		TByteList(Dest).Clear;
		TByteList(Dest).Capacity := FCount;
		for i := 0 to FCount - 1 do
			TByteList(Dest).FItems^[i] := FItems^[i];
		TByteList(Dest).FCount := FCount;
  	TByteList(Dest).EndUpdate;
		Exit;
	end
	else if Dest is TWordList then begin
		TWordList(Dest).BeginUpdate;
		TWordList(Dest).Clear;
		TWordList(Dest).Capacity := FCount;
		Move(FItems^, TWordList(Dest).FItems^, Longint(FCount) * sizeof(Word));
		TWordList(Dest).FCount := FCount;
		TWordList(Dest).EndUpdate;
		Exit;
	end
	else if Dest is TLongintList then begin
		TLongintList(Dest).BeginUpdate;
		TLongintList(Dest).Clear;
		TLongintList(Dest).Capacity := FCount;
		for i := 0 to FCount - 1 do
			TLongintList(Dest).FItems^[i] := FItems^[i];
		TLongintList(Dest).FCount := FCount;
		TLongintList(Dest).EndUpdate;
		Exit;
	end;
	inherited AssignTo(Dest);
end;

procedure TWordList.DefineProperties(aFiler: TFiler);
begin
	inherited DefineProperties(aFiler);
	aFiler.DefineBinaryProperty('Items', LoadFromStream, SaveToStream, FCount > 0);
end;

constructor TWordList.Create;
begin
	inherited Create;
	Delta := 16;
end;

destructor TWordList.Destroy;
begin
	if Assigned(FItems) then
		FreeMem(FItems, FCapacity * sizeof(Word));
	inherited Destroy;
end;

procedure TWordList.LoadFromStream(aStream: TStream);
var
	aCount: Word;
begin
	BeginUpdate;
	aStream.ReadBuffer(aCount, sizeof(aCount));
	Capacity := aCount;
	if aCount > 0 then
		aStream.ReadBuffer(FItems^, Longint(aCount) * sizeof(Word));
	FCount := aCount;
	EndUpdate;
end;

procedure TWordList.SaveToStream(aStream: TStream);
var
	aCount: Word;
begin
	aCount := FCount;
	aStream.WriteBuffer(aCount, sizeof(aCount));
	if FCount > 0 then
		aStream.WriteBuffer(FItems^, Longint(FCount) * sizeof(Word));
end;

function TWordList.Add(aValue: Word): Integer;
begin
	if not Sorted then
		Result := FCount
	else
		if Find(aValue, Result) then
			case Duplicates of
				dupIgnore: Exit;
				dupError: raise EArray.Create('Значение уже имеется в списке');
			end;

	Insert(Result, aValue);
end;

procedure TWordList.Insert(anIndex: Integer; aValue: Word);
begin
	CheckIndex(anIndex, FCount + 1);
	Changing;

	if FCount >= FCapacity then
		Capacity := FCount + Delta;

	if anIndex < FCount then
		Move(FItems^[anIndex], FItems^[anIndex + 1], (FCount - anIndex) * sizeof(Word));
	FItems^[anIndex] := aValue;
	Inc(FCount);
  Changed;
end;

procedure TWordList.Delete(anIndex: Integer);
begin
	Changing;
	CheckIndex(anIndex, FCount);
	Dec(FCount);
	if anIndex < FCount then
		Move(FItems^[anIndex + 1], FItems^[anIndex], (FCount - anIndex) * sizeof(Word));
	Changed;
end;

procedure TWordList.Clear;
begin
	Changing;
	FCount := 0;
  Changed;
end;

procedure TWordList.Exchange(Index1, Index2: Integer);
var
	T: Word;
begin
	CheckIndex(Index1, FCount);
	CheckIndex(Index2, FCount);
	Changing;
	T := FItems^[Index1];
	FItems^[Index1] := FItems^[Index2];
	FItems^[Index2] := T;
	Changed;
end;

function TWordList.Find(Value: Word; var Index: Integer): Boolean;
var
	L, H, I: Integer;
begin
	Result := False;
	L := 0;
	H := Count - 1;
	while L <= H do
	begin
		I := (L + H) shr 1;
		if FItems^[I] < Value then L := I + 1
		else begin
			H := I - 1;
			if FItems^[I] = Value then
			begin
				Result := True;
				if Duplicates <> dupAccept then L := I;
			end;
		end;
	end;
	Index := L;
end;

function TWordList.IndexOf(Value: Word): Integer;
begin
	if not Sorted then
	begin
		for Result := 0 to FCount - 1 do
			if Value = FItems^[Result] then
				Exit;
		Result := -1;
	end
	else
		if not Find(Value, Result) then Result := -1;
end;

{	TLongintList }

function TLongintList.Compare(Value1, Value2: Longint): Integer;
begin
	if not Assigned(CompareValues) then
		raise EArray.Create('Не установлена функция сравнения у TLongintList');

	Result := CompareValues(Value1, Value2);
end;

procedure TLongintList.QuickSort(L, R: Integer);
var
	I, J: Integer;
	P: Longint;
begin
	I := L;
	J := R;
	P := FItems^[(L + R) shr 1];
	repeat
		while Compare(FItems^[I], P) < 0 do Inc(I);
		while Compare(FItems^[J], P) > 0 do Dec(J);
		if I <= J then
		begin
			Exchange(I, J);
			Inc(I);
			Dec(J);
		end;
	until I > J;
	if L < J then QuickSort(L, J);
	if I < R then QuickSort(I, R);
end;

procedure TLongintList.SetCapacity(aCapacity: Integer);
begin
	if aCapacity > FCount then begin
		ReallocMem(FItems, aCapacity * sizeof(Longint));
		FCapacity := aCapacity;
	end;
end;

function TLongintList.GetItem(anIndex: Integer): Longint;
begin
	CheckIndex(anIndex, FCount);
	result := FItems^[anIndex];
end;

procedure TLongintList.SetItem(anIndex: Integer; aValue: Longint);
begin
	CheckIndex(anIndex, FCount);
	FItems^[anIndex] := aValue;
end;

procedure TLongintList.AssignTo(Dest: TPersistent);
var
	i: Word;
begin
	if Dest is TByteList then begin
		TByteList(Dest).BeginUpdate;
		TByteList(Dest).Clear;
		TByteList(Dest).Capacity := FCount;
		for i := 0 to FCount - 1 do
			TByteList(Dest).FItems^[i] := FItems^[i];
		TByteList(Dest).FCount := FCount;
		TByteList(Dest).EndUpdate;
		Exit;
	end
	else if Dest is TWordList then begin
		TWordList(Dest).BeginUpdate;
		TWordList(Dest).Clear;
		TWordList(Dest).Capacity := FCount;
		for i := 0 to FCount - 1 do
			TWordList(Dest).FItems^[i] := FItems^[i];
		TWordList(Dest).FCount := FCount;
		TWordList(Dest).EndUpdate;
		Exit;
	end
	else if Dest is TLongintList then begin
		TLongintList(Dest).BeginUpdate;
		TLongintList(Dest).Clear;
		TLongintList(Dest).Capacity := FCount;
		Move(FItems^, TLongintList(Dest).FItems^, Longint(FCount) * sizeof(Longint));
		TLongintList(Dest).FCount := FCount;
		TLongintList(Dest).EndUpdate;
		Exit;
	end;
	inherited AssignTo(Dest);
end;

procedure TLongintList.DefineProperties(aFiler: TFiler);
begin
	inherited DefineProperties(aFiler);
	aFiler.DefineBinaryProperty('Items', LoadFromStream, SaveToStream, FCount > 0);
end;

constructor TLongintList.Create;
begin
	inherited Create;
	Delta := 16;
	CompareValues := CompareLongintsFunc;
end;

destructor TLongintList.Destroy;
begin
	Clear;
	if Assigned(FItems) then
		FreeMem(FItems, FCapacity * sizeof(Longint));
	inherited Destroy;
end;

procedure TLongintList.LoadFromStream(aStream: TStream);
var
	aCount: Word;
begin
	Clear;

	BeginUpdate;
	aStream.ReadBuffer(aCount, sizeof(aCount));
	Capacity := aCount;
	if aCount > 0 then
		aStream.ReadBuffer(FItems^, Longint(aCount) * sizeof(Longint));
	FCount := aCount;
  EndUpdate;
end;

procedure TLongintList.SaveToStream(aStream: TStream);
var
	aCount: Word;
begin
	aCount := FCount;
	aStream.WriteBuffer(aCount, sizeof(aCount));
	if FCount > 0 then
		aStream.WriteBuffer(FItems^, Longint(FCount) * sizeof(Longint));
end;

function TLongintList.Add(aValue: Longint): Integer;
begin
	if not Sorted then
		Result := FCount
	else
		if Find(aValue, Result) then
			case Duplicates of
				dupIgnore: Exit;
				dupError: raise EArray.Create('Значение уже имеется в списке');
			end;

	Changing;
	Insert(Result, aValue);
	Changed;
end;

procedure TLongintList.Insert(anIndex: Integer; aValue: Longint);
begin
	CheckIndex(anIndex, FCount + 1);
	Changing;

	if FCount >= FCapacity then
		Capacity := FCount + Delta;

	if anIndex < FCount then
		Move(FItems^[anIndex], FItems^[anIndex + 1], (FCount - anIndex) * sizeof(Longint));
	FItems^[anIndex] := aValue;
	Inc(FCount);
	Changed;
end;

procedure TLongintList.Delete(anIndex: Integer);
begin
	CheckIndex(anIndex, FCount);
	Changing;
	Dec(FCount);
	if anIndex < FCount then
		Move(FItems^[anIndex + 1], FItems^[anIndex], (FCount - anIndex) * sizeof(Longint));
	Changed;
end;

procedure TLongintList.Clear;
begin
	Changing;
	FCount := 0;
  Changed;
end;

procedure TLongintList.Exchange(Index1, Index2: Integer);
var
	T: Longint;
begin
	CheckIndex(Index1, FCount);
	CheckIndex(Index2, FCount);
	Changing;
	T := FItems^[Index1];
	FItems^[Index1] := FItems^[Index2];
	FItems^[Index2] := T;
	Changed;
end;

function TLongintList.Find(Value: Longint; var Index: Integer): Boolean;
var
	L, H, I: Integer;
begin
	Result := False;
	L := 0;
	H := Count - 1;
	while L <= H do
	begin
		I := (L + H) shr 1;
		if Compare(FItems^[I], Value) < 0 then L := I + 1
		else begin
			H := I - 1;
			if Compare(FItems^[I], Value) = 0 then
			begin
				Result := True;
				if Duplicates <> dupAccept then L := I;
			end;
		end;
	end;
	Index := L;
end;

function TLongintList.IndexOf(Value: Longint): Integer;
begin
	if not Sorted then
	begin
		for Result := 0 to FCount - 1 do
			if Compare(Value, FItems^[Result]) = 0 then
				Exit;
		Result := -1;
	end
	else
		if not Find(Value, Result) then Result := -1;
end;

{	TIntegerList }

function TIntegerList.Compare(Value1, Value2: Integer): Integer;
begin
	if not Assigned(CompareValues) then
		raise EArray.Create('Не установлена функция сравнения у TIntegerList');

	Result := CompareValues(Value1, Value2);
end;

procedure TIntegerList.QuickSort(L, R: Integer);
var
	I, J: Integer;
	P: Integer;
begin
	I := L;
	J := R;
	P := FItems^[(L + R) shr 1];
	repeat
		while Compare(FItems^[I], P) < 0 do Inc(I);
		while Compare(FItems^[J], P) > 0 do Dec(J);
		if I <= J then
		begin
			Exchange(I, J);
			Inc(I);
			Dec(J);
		end;
	until I > J;
	if L < J then QuickSort(L, J);
	if I < R then QuickSort(I, R);
end;

procedure TIntegerList.SetCapacity(aCapacity: Integer);
begin
	if aCapacity > FCount then begin
		ReallocMem(FItems, aCapacity * sizeof(Integer));
		FCapacity := aCapacity;
	end;
end;

function TIntegerList.GetItem(anIndex: Integer): Integer;
begin
	CheckIndex(anIndex, FCount);
	result := FItems^[anIndex];
end;

procedure TIntegerList.SetItem(anIndex: Integer; aValue: Integer);
begin
	CheckIndex(anIndex, FCount);
	FItems^[anIndex] := aValue;
end;

procedure TIntegerList.AssignTo(Dest: TPersistent);
var
	i: Word;
begin
	if Dest is TByteList then begin
		TByteList(Dest).BeginUpdate;
		TByteList(Dest).Clear;
		TByteList(Dest).Capacity := FCount;
		for i := 0 to FCount - 1 do
			TByteList(Dest).FItems^[i] := FItems^[i];
		TByteList(Dest).FCount := FCount;
		TByteList(Dest).EndUpdate;
		Exit;
	end
	else if Dest is TWordList then begin
		TWordList(Dest).BeginUpdate;
		TWordList(Dest).Clear;
		TWordList(Dest).Capacity := FCount;
		for i := 0 to FCount - 1 do
			TWordList(Dest).FItems^[i] := FItems^[i];
		TWordList(Dest).FCount := FCount;
		TWordList(Dest).EndUpdate;
		Exit;
	end
	else if Dest is TIntegerList then begin
		TIntegerList(Dest).BeginUpdate;
		TIntegerList(Dest).Clear;
		TIntegerList(Dest).Capacity := FCount;
		Move(FItems^, TIntegerList(Dest).FItems^, Integer(FCount) * sizeof(Integer));
		TIntegerList(Dest).FCount := FCount;
		TIntegerList(Dest).EndUpdate;
		Exit;
	end;
	inherited AssignTo(Dest);
end;

procedure TIntegerList.DefineProperties(aFiler: TFiler);
begin
	inherited DefineProperties(aFiler);
	aFiler.DefineBinaryProperty('Items', LoadFromStream, SaveToStream, FCount > 0);
end;

constructor TIntegerList.Create;
begin
	inherited Create;
	Delta := 16;
	CompareValues := CompareIntegersFunc;
end;

destructor TIntegerList.Destroy;
begin
	Clear;
	if Assigned(FItems) then
		FreeMem(FItems, FCapacity * sizeof(Integer));
	inherited Destroy;
end;

procedure TIntegerList.LoadFromStream(aStream: TStream);
var
	aCount: Word;
begin
	Clear;

	BeginUpdate;
	aStream.ReadBuffer(aCount, sizeof(aCount));
	Capacity := aCount;
	if aCount > 0 then
		aStream.ReadBuffer(FItems^, Integer(aCount) * sizeof(Integer));
	FCount := aCount;
  EndUpdate;
end;

procedure TIntegerList.SaveToStream(aStream: TStream);
var
	aCount: Word;
begin
	aCount := FCount;
	aStream.WriteBuffer(aCount, sizeof(aCount));
	if FCount > 0 then
		aStream.WriteBuffer(FItems^, Integer(FCount) * sizeof(Integer));
end;

function TIntegerList.Add(aValue: Integer): Integer;
begin
	if not Sorted then
		Result := FCount
	else
		if Find(aValue, Result) then
			case Duplicates of
				dupIgnore: Exit;
				dupError: raise EArray.Create('Значение уже имеется в списке');
			end;

	Changing;
	Insert(Result, aValue);
	Changed;
end;

procedure TIntegerList.Insert(anIndex: Integer; aValue: Integer);
begin
	CheckIndex(anIndex, FCount + 1);
	Changing;

	if FCount >= FCapacity then
		Capacity := FCount + Delta;

	if anIndex < FCount then
		Move(FItems^[anIndex], FItems^[anIndex + 1], (FCount - anIndex) * sizeof(Integer));
	FItems^[anIndex] := aValue;
	Inc(FCount);
	Changed;
end;

procedure TIntegerList.Delete(anIndex: Integer);
begin
	CheckIndex(anIndex, FCount);
	Changing;
	Dec(FCount);
	if anIndex < FCount then
		Move(FItems^[anIndex + 1], FItems^[anIndex], (FCount - anIndex) * sizeof(Integer));
	Changed;
end;

procedure TIntegerList.Clear;
begin
	Changing;
	FCount := 0;
  Changed;
end;

procedure TIntegerList.Exchange(Index1, Index2: Integer);
var
	T: Integer;
begin
	CheckIndex(Index1, FCount);
	CheckIndex(Index2, FCount);
	Changing;
	T := FItems^[Index1];
	FItems^[Index1] := FItems^[Index2];
	FItems^[Index2] := T;
	Changed;
end;

function TIntegerList.Find(Value: Integer; var Index: Integer): Boolean;
var
	L, H, I: Integer;
begin
	Result := False;
	L := 0;
	H := Count - 1;
	while L <= H do
	begin
		I := (L + H) shr 1;
		if Compare(FItems^[I], Value) < 0 then L := I + 1
		else begin
			H := I - 1;
			if Compare(FItems^[I], Value) = 0 then
			begin
				Result := True;
				if Duplicates <> dupAccept then L := I;
			end;
		end;
	end;
	Index := L;
end;

function TIntegerList.IndexOf(Value: Integer): Integer;
begin
	if not Sorted then
	begin
		for Result := 0 to FCount - 1 do
			if Compare(Value, FItems^[Result]) = 0 then
				Exit;
		Result := -1;
	end
	else
		if not Find(Value, Result) then Result := -1;
end;

{ TPtrList }


destructor TPtrList.Destroy;
begin
	FreeAll;
	inherited Destroy;
end;

procedure TPtrList.Find;
begin
end;

function TPtrList.GetItem(anIndex: Integer): Pointer;
begin
	Result := Pointer(inherited Items[anIndex]);
end;

procedure TPtrList.SetItem(anIndex: Integer; aValue: Pointer);
begin
	inherited Items[anIndex] := Longint(aValue);
end;

function TPtrList.Add(anItem: Pointer): Integer;
begin
	if not Sorted then
		Result := FCount
	else
		if FindKey(KeyOf(anItem)^, Result) then
			case Duplicates of
				dupIgnore: Exit;
				dupError: raise EArray.Create('Значение уже имеется в списке');
			end;

	Changing;
	Insert(Result, anItem);
	Changed;
end;

procedure TPtrList.DeleteAll;
begin
	Changing;
	FCount := 0;
	Changed;
end;

procedure TPtrList.Clear;
var
	I: Integer;
begin
	Changing;
	if Assigned(FreeItem) then
		for I := 0 to FCount - 1 do
			FreeItem(Pointer(FItems^[I]));
	FCount := 0;
	Changed;
end;

procedure TPtrList.AtFree(anIndex: Integer);
begin
	CheckIndex(anIndex, FCount);
	Changing;
	FreeItem(Pointer(FItems^[anIndex]));
	Dec(FCount);
	if anIndex < FCount then
		Move(FItems^[anIndex + 1], FItems^[anIndex], (FCount - anIndex) * sizeof(Pointer));
	Changed;
end;

function TPtrList.FindKey(const aKey; var Index: Integer): Boolean;
var
	L, H, I: Integer;
  aCompareResult: Integer;
begin
	Result := False;
	L := 0;
	H := Count - 1;
	while L <= H do
	begin
		I := (L + H) shr 1;
    aCompareResult := CompareKeys(KeyOf(Pointer(FItems^[I])), @aKey);
		if aCompareResult < 0 then L := I + 1
		else begin
			H := I - 1;
			if aCompareResult = 0 then
			begin
				Result := True;
				if Duplicates <> dupAccept then L := I;
			end;
		end;
	end;
	Index := L;
end;

function TPtrList.IndexOf(anItem: Pointer): Integer;
begin
	for Result := 0 to FCount - 1 do
		if anItem = Pointer(FItems^[Result]) then
			Exit;
	Result := -1;
end;

procedure TPtrList.Insert(anIndex: Integer; anItem: Pointer);
begin
	CheckIndex(anIndex, FCount + 1);
	Changing;

	if FCount >= FCapacity then
		Capacity := FCount + Delta;

	if anIndex < FCount then
		Move(FItems^[anIndex], FItems^[anIndex + 1], (FCount - anIndex) * sizeof(Pointer));
	Pointer(FItems^[anIndex]) := anItem;
	Inc(FCount);
	Changed;
end;

procedure TPtrList.SaveToStream(aStream: TStream);
var
	i: Integer;
	aCount: Word;
begin
	if not Assigned(WriteItem) then
		raise EArray.Create('TPtrList.SaveToStream: Не задана процедура "WriteItem"');

	aCount := FCount;
	aStream.WriteBuffer(aCount, sizeof(aCount));
	for i := 0 to FCount - 1 do
		WriteItem(aStream, Pointer(FItems^[i]));
end;

procedure TPtrList.LoadFromStream(aStream: TStream);
var
	aCount: SmallInt;
	i: Integer;
begin
	if not Assigned(ReadItem) then
		raise EArray.Create('TPtrList.LoadFromStream: Не задана процедура "ReadItem"');

	FreeAll;

	BeginUpdate;
	try
		aStream.ReadBuffer(aCount, sizeof(aCount));
		Capacity := aCount;
    FCount := 0;
		for i := 0 to aCount - 1 do begin
			Pointer(FItems^[i]) := ReadItem(aStream);
			Inc(FCount);
		end;
	finally
		EndUpdate;
	end;
end;

procedure TPtrList.FreeAll;
var
	i: Integer;
begin
	Changing;
	if Assigned(FreeItem) then
		for i := 0 to FCount - 1 do
			FreeItem(Pointer(FItems^[i]));
	FCount := 0;
  Changed;
end;

{	TRecList }

function TRecList.Compare(const Value1, Value2): Integer;
begin
	if not Assigned(FCompareValues) then
		Result := CmpBytes(@Value1, @Value2, FItemSize)
		{raise EArray.Create('Не установлена функция сравнения у TRecList'); }
	else
		Result := FCompareValues(Value1, Value2);
end;

procedure TRecList.QuickSort(L, R: Integer);
var
	I, J: Integer;
	P: Pointer;
begin
	I := L;
	J := R;
	P := GetItem((L + R) shr 1);
	repeat
		while Compare(GetItem(I)^, P^) < 0 do Inc(I);
		while Compare(GetItem(J)^, P^) > 0 do Dec(J);
		if I <= J then
		begin
			Exchange(I, J);
			Inc(I);
			Dec(J);
		end;
	until I > J;
	if L < J then QuickSort(L, J);
	if I < R then QuickSort(I, R);
end;

procedure TRecList.SetCapacity(aCapacity: Integer);
begin
	if aCapacity > FCount then begin
		ReallocMem(FItems, aCapacity * FItemSize);
		FCapacity := aCapacity;
	end;
end;

function TRecList.GetItem(anIndex: Integer): Pointer;
begin
	CheckIndex(anIndex, FCount);
	result := @PXByteArray(FItems)^[anIndex * FItemSize];
end;

procedure TRecList.AssignTo(Dest: TPersistent);
begin
	if Dest is TRecList then begin
    TRecList(Dest).BeginUpdate;
		TRecList(Dest).Clear;
		TRecList(Dest).Capacity := FCount;
		Move(FItems^, TRecList(Dest).FItems^, FCount * FItemsize);
		TRecList(Dest).FCount := FCount;
    TRecList(Dest).EndUpdate;
		Exit;
	end;
	inherited AssignTo(Dest);
end;

procedure TRecList.DefineProperties(aFiler: TFiler);
begin
	inherited DefineProperties(aFiler);
	aFiler.DefineBinaryProperty('Items', LoadFromStream, SaveToStream, FCount > 0);
end;

constructor TRecList.Create(anItemSize: Integer);
begin
	inherited Create;
	FItemSize := anItemSize;
	Delta := 16;
end;

destructor TRecList.Destroy;
begin
	if Assigned(FItems) then
		FreeMem(FItems, FCapacity * FItemSize);
	inherited Destroy;
end;

procedure TRecList.LoadFromMemory(aBuffer: Pointer; aCount: Integer);
begin
	BeginUpdate;
	Capacity := aCount;
	if aCount > 0 then
		Move(aBuffer^, FItems^, aCount * FItemSize);
	FCount := aCount;
  EndUpdate;
end;

procedure TRecList.LoadFromStream(aStream: TStream);
var
	aCount: SmallInt;
begin
	BeginUpdate;
	aStream.ReadBuffer(aCount, sizeof(aCount));
	Capacity := aCount;
	if aCount > 0 then
		aStream.ReadBuffer(FItems^, aCount * FItemSize);
	FCount := aCount;
  EndUpdate;
end;

procedure TRecList.SaveToStream(aStream: TStream);
var
	aCount: SmallInt;
begin
	aCount := FCount;
	aStream.WriteBuffer(aCount, sizeof(aCount));
	if FCount > 0 then
		aStream.WriteBuffer(FItems^, FCount * FItemSize);
end;

function TRecList.Add(const aValue): Integer;
begin
	if not Sorted then
		Result := FCount
	else
		if Find(aValue, Result) then
			case Duplicates of
				dupIgnore: Exit;
				dupError: raise EArray.Create('Значение уже имеется в списке');
			end;

	Changing;
	Insert(Result, aValue);
	Changed;
end;

procedure TRecList.Insert(anIndex: Integer; const aValue);
begin
	CheckIndex(anIndex, FCount + 1);
	Changing;

	if FCount >= FCapacity then
		Capacity := FCount + Delta;

	if anIndex < FCount then
		Move(	PXByteArray(FItems)^[anIndex * FItemSize],
					PXByteArray(FItems)^[(anIndex + 1) * FItemSize],
					(FCount - anIndex) * FItemSize);
	Move(aValue, PXByteArray(FItems)^[anIndex * FItemSize], FItemSize);
	Inc(FCount);
	Changed;
end;

procedure TRecList.Delete(anIndex: Integer);
begin
	CheckIndex(anIndex, FCount);
	Changing;
	Dec(FCount);
	if anIndex < FCount then
		Move(	PXByteArray(FItems)^[(anIndex + 1) * FItemSize],
					PXByteArray(FItems)^[anIndex * FItemSize],
					(FCount - anIndex) * FItemSize);
	Changed;
end;

procedure TRecList.Clear;
begin
	Changing;
	FCount := 0;
  Changed;
end;

procedure TRecList.Exchange(Index1, Index2: Integer);
begin
	CheckIndex(Index1, FCount);
	CheckIndex(Index2, FCount);
	Changing;
{$IFDEF WIN32}
	SwapBytes(GetItem(Index1), GetItem(Index2), FItemSize);
{$ELSE}
	Swap(GetItem(Index1)^, GetItem(Index2)^, FItemSize);
{$ENDIF}
	Changed;
end;

function TRecList.Find(const Value; var Index: Integer): Boolean;
var
	L, H, I: Integer;
begin
	Result := False;
	L := 0;
	H := Count - 1;
	while L <= H do
	begin
		I := (L + H) shr 1;
		if Compare(GetItem(I)^, Value) < 0 then L := I + 1
		else begin
			H := I - 1;
			if Compare(GetItem(I)^, Value) = 0 then
			begin
				Result := True;
				if Duplicates <> dupAccept then L := I;
			end;
		end;
	end;
	Index := L;
end;

function TRecList.IndexOf(const Value): Integer;
begin
	if not Sorted then
	begin
		for Result := 0 to FCount - 1 do
			if Compare(Value, GetItem(Result)^) = 0 then
				Exit;
		Result := -1;
	end
	else
		if not Find(Value, Result) then Result := -1;
end;

//****************************************************************************************
//	TEnumList
//
constructor TEnumList.Create;
begin
	inherited Create;
	FList := TList.Create;
	FAdding := TList.Create;
end;

destructor TEnumList.Destroy;
var
	i: Integer;
begin
	for i := 0 to FAdding.Count - 1 do
		ItemRemoving(FAdding[i]);
	for i := 0 to FList.Count - 1 do
		ItemRemoving(FList[i]);
	FAdding.Free;
	FList.Free;
	inherited Destroy;
end;

procedure TEnumList.ItemInserted(anItem: Pointer);
begin
end;

procedure TEnumList.ItemRemoving(anItem: Pointer);
begin
end;

function TEnumList.BeginEnum: TList;
begin
	Result := FList;
	Inc(FEnumCount);
end;

procedure TEnumList.EndEnum;
var
	i: Integer;
begin
	Dec(FEnumCount);
	if FEnumCount = 0 then begin
		FList.Pack;
		for i := 0 to FAdding.Count - 1 do
			FList.Add(FAdding[i]);
		FAdding.Clear;
	end;
end;

procedure TEnumList.Add(anItem: Pointer);
begin
	if FEnumCount = 0 then
		FList.Add(anItem)
	else
		FAdding.Add(anItem);
	ItemInserted(anItem);
end;

procedure TEnumList.Remove(anItem: Pointer);
var
	i: Integer;
begin
	if FEnumCount = 0 then
		FList.Remove(anItem)
	else begin
		i := FList.IndexOf(anItem);
		if i <> -1 then
			FList[i] := nil;
		FAdding.Remove(anItem);
	end;
	ItemRemoving(anItem);
end;

function TEnumList.HasItem(anItem: Pointer): Boolean;
begin
	Result := (FList.IndexOf(anItem) <> -1) or (FAdding.IndexOf(anItem) <> -1);
end;

{	TEventList }

constructor TEventList.Create(const aName: string; aDataSize: Integer);
begin
	inherited Create{(aName)};
	List := TRecList.Create(sizeof(TEventRec) + aDataSize);
	DataSize := aDataSize;




end;

destructor TEventList.Destroy;
begin
	List.Free;
	inherited Destroy;
end;

function TEventList.GetFirst: Pointer;
begin
	if List.Count = 0 then
		Current := nil
	else begin
		PreventRegistration := True;
		CurrentIndex := 0;
		Current := List.Items[0];
	end;
	Result := Current;
end;

function TEventList.GetNext: Pointer;
	procedure FinishEnum;
	var
		i: Integer;
		p: PEventRec;
	begin
		if List.Count > 0 then begin
			i := 0;
			p := List.Items[0];
			while i < List.Count do begin
				case p^.Flag of
					erRegistered: p^.Flag := erNormal;
					erUnregistered:
						begin
							List.Delete(i);
							Continue;
						end;
				end;
				Inc(i);
				Inc(PChar(p), sizeof(TEventRec) + DataSize);
			end;
		end;
		PreventRegistration := False;
	end;

begin
	if CurrentIndex < List.Count then
		repeat
			Inc(CurrentIndex);
			Inc(PChar(Current), sizeof(TEventRec) + DataSize);
		until (CurrentIndex >= List.Count) or (Current^.Flag = erNormal);

	if CurrentIndex < List.Count then
		Result := Current
	else begin
		Result := nil;
		FinishEnum;
	end
end;

procedure TEventList.Register(const anEvent, aData);
var
	anEventRec: PEventRec;
begin
	GetMem(anEventRec, sizeof(TEventRec) + DataSize);
	try
		anEventRec^.Proc := TObjectProc(anEvent);
		if PreventRegistration then
			anEventRec^.Flag := erRegistered
		else
			anEventRec^.Flag := erNormal;
		if DataSize <> 0 then
			System.Move(aData, anEventRec^.Data, DataSize);

		List.Add(anEventRec^);
	finally
		FreeMem(anEventRec, sizeof(TEventRec) + DataSize);
	end;



end;

procedure TEventList.Unregister(const anEvent, aData);
var
	i: Integer;
	p: PEventRec;
	aFind: TObjectProc absolute anEvent;
begin
	if List.Count > 0 then
	begin
		p := List.Items[0];
		for i := 0 to List.Count - 1 do
		begin
			if (p^.Proc.Obj = aFind.Obj) and (p^.Proc.Proc = aFind.Proc) then
				if not Assigned(FCompareData) or FCompareData(aData, p^.Data) then
				begin
					if PreventRegistration then
						p^.Flag := erUnregistered
					else
						List.Delete(i);
					Exit;
				end;
			Inc(PChar(p), sizeof(TEventRec) + DataSize);
		end;
	end;
	raise Exception.CreateFmt('%s: unregister failed (item not found)', ['(event list)'{ObjectName}]);
end;

end.

