unit ArrayUtils;

interface
uses Windows, Classes, SysUtils, Variants, Types;

type
	// Добавил TStrArray, TIntArray, TObjectSet
	// [М. Власов] 17 марта 2004.
	PStrArray = ^TStrArray;
	TStrArray = object
	private
		FItems: array of String;
		FCount: integer;
	public
		constructor Create;

		procedure Clear(aCapacity: Integer = 0);
		procedure Assign(const aList: TStrArray); overload;
		procedure Assign(const aList: array of string); overload;
		procedure Assign(const aList: TStringList); overload;

		procedure Sort;

		function  Join(const aDivider: String; const aFormatItem: String = ''): String;
		function  JoinSlice(aStart, aCount: Integer; const aDivider: String; const aFormatItem: String = ''): String;
		function  Slice(aStart, aCount: Integer): TStrArray;
		procedure Split(const aSrc, aDivider: String);

		function  AsArray: TStringDynArray;

		// разбивает идентификатор на составляющие,
		// 	разделитель частей: точка
		//	пробельные символы игнорируются
		//  LQuote и RQuote символы обквочивания слева и справа
		function  SplitIdent(const aSrc: String; LQuote, RQuote: String): Boolean;

		function  Add(const s: String): Integer; overload;
		procedure Add(const aSrc: TStrArray); overload;
		procedure Delete(i: Integer);
		procedure Remove(const s: String);
		procedure RemoveText(const s: String);
		function  IndexOfText(const aText: String): Integer;
		function  IndexOf(const aValue: String): Integer;
		function  Count: Integer;

		function  Items(anIndex: Integer): String;
		procedure SetItem(anIndex: Integer; const aValue: String);
	end;

	TStrDictionary = object
	private
		FItems: array of String;
		FCount: Integer;

		function  Add(const s: String): Integer; overload;
	public
		procedure Sort;

		function  Join(const aDivider: String; const aFormatItem: String = ''): String;
		procedure Split(const aSrc, aDivider: String);

		procedure Clear(aCapacity: Integer = 0);
		procedure Assign(const aList: TStrDictionary);
		procedure Add(const aSrc: TStrDictionary); overload;
		procedure Delete(i: Integer);

		function  NameExists(const aName: String): Boolean;
		function  IndexOfName(const aName: String): Integer;
		function  GetValue(const aName: String; const aDef: String = ''): String; overload;
		function  GetValue(i: Integer): String; overload;

		procedure SetValue(const aName: String; const aValue: String); overload;
		procedure SetValue(i: Integer; const aValue: String); overload;

		procedure RemoveValue(const aName: String);
		function  GetName(i: Integer): String;

		function GetNameList: TStrArray;
		function GetValueList: TStrArray;

		function Items(anIndex: Integer): String;

		function  Count: Integer;
	end;

	TIntArray = object
  private
		FItems: array of Integer;
    FSorted: Boolean;

  public
  	procedure Clear;

		procedure Add(i: Integer); overload;
		procedure Add(const aList: TIntArray); overload;
		procedure Delete(i: Integer);

		function 	IndexOf(i: Integer): Integer;

		procedure SetItem(i: Integer; aValue: Integer);
    function  GetItem(i: Integer): Integer;
		function  Count: Integer;
		procedure SetCount(aValue: Integer);

		procedure Sort;
	end;

  TDoubleArray = object
  private
    FItems: array of Double;
		FCount: Integer;
  public
    procedure Clear(aCapacity: Integer = 0);

    procedure SetCount(aCount: Integer);

    function  Add(aValue: Double): Integer;
    procedure SetItem(i: Integer; aValue: Double);
    function  GetItem(i: Integer): Double;
    function  Count: Integer;
	end;

	TBooleanArray = object
  private
    FItems: array of Boolean;
    FCount: Integer;
  public
    procedure Clear(aCapacity: Integer = 0);

    procedure SetCount(aCount: Integer);

		function  Add(aValue: Boolean): Integer;
		procedure SetItem(i: Integer; aValue: Boolean);
		function  GetItem(i: Integer): Boolean;
		function  Count: Integer;
	end;

	TVariantArray = object
	private
		FItems: array of Variant;
		FCount: integer;

	public
		constructor Create;
		procedure Clear(aCapacity: Integer = 0);
		procedure Assign(const aList: TVariantArray); overload;
		procedure Assign(const aList: array of Variant); overload;

		function  Add(const aValue: Variant): Integer; overload;
		procedure Add(const aSrc: TVariantArray); overload;
		procedure Delete(i: Integer);

		function  ItemIsNull(anIndex: Integer): Boolean;
		function  GetItem(anIndex: Integer): Variant;
		procedure SetItem(anIndex: Integer; const aValue: Variant);

		function  Count: Integer;
	end;


procedure CheckBounds(anIndex, aCount: Integer);

implementation
uses
	InSysUtils, Math;

procedure CheckBounds(anIndex, aCount: Integer);
begin
	Assert((anIndex >= 0) and (anIndex < aCount));
	if not ((anIndex >= 0) and (anIndex < aCount)) then
		raise Exception.CreateFmt('Index "%d" out of bounds [%d, %d)', [anIndex, 0, aCount]);
end;


{ TStrArray }

procedure TStrArray.Clear;
begin
	FCount := 0;
	SetLength(FItems, aCapacity);
end;

procedure TStrArray.Assign(const aList: array of string);
var
	i: Integer;
begin
	FCount := Length(aList);
	SetLength(FItems, FCount);
	for i := 0 to FCount - 1 do
		FItems[i] := aList[i];
end;

procedure TStrArray.Assign(const aList: TStrArray);
var
	i: Integer;
begin
	FCount := aList.Count;
	SetLength(FItems, FCount);
	for i := 0 to FCount - 1 do
		FItems[i] := aList.FItems[i];
end;

procedure TStrArray.Assign(const aList: TStringList);
var
	i: Integer;
begin
	FCount := aList.Count;
	SetLength(FItems, FCount);
	for i := 0 to FCount - 1 do
		FItems[i] := aList[i];
end;

function TStrArray.Join(const aDivider: String; const aFormatItem: String = ''): String;
begin
	Result := JoinSlice(0, FCount, aDivider, aFormatItem);
end;

function TStrArray.Slice(aStart, aCount: Integer): TStrArray;
var
	i: Integer;
	aRestCount: Integer;
begin
	aRestCount := Max(0, Min(aCount, FCount - aStart));
	Result.Clear(aRestCount);
	for i := 0 to aRestCount - 1 do
		Result.Add(FItems[aStart + i]);
end;

function TStrArray.Add(const s: String): Integer;
begin
	if FCount >= Length(FItems) then
		SetLength(FItems, Max(1, Length(FItems))*2);
	Result := FCount;
	FItems[Result] := s;
	Inc(FCount);
end;

procedure TStrArray.Add(const aSrc: TStrArray);
var
	i: Integer;
begin
	SetLength(FItems, FCount + aSrc.Count);
	for i := 0 to aSrc.Count - 1 do
		FItems[FCount + i] := aSrc.FItems[i];
	Inc(FCount, aSrc.Count)
end;

procedure TStrArray.Delete(i: Integer);
var
	j: Integer;
begin
	for j := i to Count - 2 do
		FItems[j] := FItems[j + 1];
	Dec(FCount);
end;

procedure TStrArray.Remove(const s: String);
var
	i: Integer;
begin
	i := IndexOf(s);
	if i <> -1 then
		Delete(i);
end;

procedure TStrArray.RemoveText(const s: String);
var
	i: Integer;
begin
	i := IndexOfText(s);
	if i <> -1 then
		Delete(i);
end;

procedure TStrArray.Split(const aSrc, aDivider: String);
var
	aRest: String;
	aPos: Integer;
begin
	Clear;
	if aSrc <> '' then begin
		aRest := aSrc;
		repeat
			aPos := Pos(aDivider, aRest);
			if aPos > 0 then begin
				Add(Copy(aRest, 1, aPos - 1));
				System.Delete(aRest, 1, aPos + Length(aDivider) - 1);
			end
			else
				Add(aRest);
		until aPos <= 0;
	end;
end;

function TStrArray.SplitIdent(const aSrc: String; LQuote, RQuote: String): Boolean;
var
	i, j: Integer;
	anIdent: String;
begin
	Clear;
	Result := True;

	i := 1;
	while (i <= Length(aSrc)) and Result do begin

		while (i <= Length(aSrc)) and (aSrc[i] <= ' ') do
			Inc(i);

		if i <= Length(aSrc) then begin
			if aSrc[i] = LQuote then begin
				j := i + 1;
				while (j <= Length(aSrc)) and (aSrc[j] <> RQuote) do
					Inc(j);

				if j > Length(aSrc) then
					Result := False
				else
					Inc(j);

				anIdent := Copy(aSrc, i, j - i);

				i := j;
				while (i <= Length(aSrc)) and (aSrc[i] <= ' ') do
					Inc(i);

				if (i <= Length(aSrc)) and (aSrc[i] <> '.') then
					Result := False
				else
					Inc(i)
			end
			else begin
				j := i;
				while (j <= Length(aSrc)) and (aSrc[j] <> '.') do
					Inc(j);

				anIdent := Trim(Copy(aSrc, i, j - i));

				i := j + 1;
			end;

			Add(anIdent);
		end;
	end;

	// проверка кооректности разбивки идентификатора на части
	Result := Result and (Count > 0) and (Trim(FItems[Count - 1]) <> '');
	if Result then begin
		i := 0;
		while (i < Count) and Result do begin
			Result := ((Pos(LQuote, FItems[i]) = 0) and (Pos(RQuote, FItems[i]) = 0)) or
				((Length(FItems[i]) > 0) and
					(Pos(LQuote, FItems[i]) = 1) and (FItems[i][Length(FItems[i])] = RQuote));

			Inc(i);
		end;
	end;
end;

function TStrArray.IndexOfText(const aText: String): Integer;
begin
	for Result := 0 to FCount - 1 do
		if SameText(FItems[Result], aText) then
			Exit;
	Result := -1;
end;

function TStrArray.Count: Integer;
begin
	Result := FCount;
end;

function TStrArray.IndexOf(const aValue: String): Integer;
begin
	for Result := 0 to Count - 1 do
		if FItems[Result] = aValue then
			Exit;
	Result := -1;
end;

function TStrArray.Items(anIndex: Integer): String;
begin
	Result := FItems[anIndex];
end;

procedure TStrArray.SetItem(anIndex: Integer; const aValue: String);
begin
	FItems[anIndex] := aValue;
end;

constructor TStrArray.Create;
begin
	FCount := 0;
end;

function TStrArray.JoinSlice(aStart, aCount: Integer; const aDivider,
  aFormatItem: String): String;
var
	i, aFinish: integer;
	sb: TStringBuilder;
begin
	if aStart < 0 then
		aStart := 0;
	if (aCount <= 0) or (aStart >= FCount) then
		Result := ''
	else begin
		sb.Init;
		aFinish := Min(FCount, aStart + aCount) - 1;
		if aFormatItem = '' then begin
			sb.Add(FItems[aStart]);
			for i := aStart + 1 to aFinish do begin
				sb.Add(aDivider);
				sb.Add(FItems[i]);
			end;
		end
		else begin
			sb.Add(Format(aFormatItem, [FItems[aStart]]));
			for i := aStart + 1 to aFinish do begin
				sb.Add(aDivider);
				sb.Add(Format(aFormatItem, [FItems[i]]));
			end;
		end;
		sb.GetString(Result);
	end;
end;

procedure TStrArray.Sort;

	procedure QuickSort(L, R: Integer);
	var
		x, w: String;
		i, j: Integer;
	begin
		i := L;
		j := R;
		x := FItems[(i+j) div 2];

		repeat
			while FItems[i] < x do inc(i);
			while FItems[j] > x do dec(j);

			if i<=j then begin
				w := FItems[i];
				FItems[i] := FItems[j];
				FItems[j] := w;

				inc(i);
				dec(j);
			end;
		until i > j;

		if L < j then
			QuickSort(L, j);

		if i < R then
			QuickSort(i, R);
	end;

begin
	if (FCount > 0) then
		QuickSort(0, FCount - 1);
end;

function TStrArray.AsArray: TStringDynArray;
var
	i: Integer;
begin
	SetLength(Result, Count);
	for i := 0 to Count - 1 do
		Result[i] := FItems[i];
end;

{ TStrDictionary }

function TStrDictionary.Add(const s: String): Integer;
begin
	if FCount >= Length(FItems) then
		SetLength(FItems, Max(1, Length(FItems))*2);
	Result := FCount;
	FItems[Result] := s;
	Inc(FCount);
end;

procedure TStrDictionary.Delete(i: Integer);
var
	j: Integer;
begin
	CheckBounds(i, FCount);
	for j := i to Count - 2 do
		FItems[j] := FItems[j + 1];
	Dec(FCount);
end;

procedure TStrDictionary.Clear(aCapacity: Integer);
begin
	SetLength(FItems, aCapacity);
	FCount := 0;
end;

procedure TStrDictionary.Assign(const aList: TStrDictionary);
var
	i: Integer;
begin
	FCount := aList.Count;
	SetLength(FItems, FCount);
	for i := 0 to FCount - 1 do
		FItems[i] := aList.FItems[i];
end;

procedure TStrDictionary.Add(const aSrc: TStrDictionary);
var
	i: Integer;
begin
	for i := 0 to aSrc.Count - 1 do
		SetValue(aSrc.GetName(i), aSrc.GetValue(i));
end;

function TStrDictionary.Count: Integer;
begin
	Result := FCount;
end;

function TStrDictionary.GetName(i: Integer): String;
var
	j: Integer;
begin
	CheckBounds(i, FCount);
	
	j := Pos('=', Items(i));
	Assert(j <> 0);

	Result := Copy(Items(i), 1, j - 1);
end;

function TStrDictionary.GetValue(const aName, aDef: String): String;
var
	i: Integer;
begin
	i := IndexOfName(aName);
	if i <> -1 then
		Result := GetValue(i)
	else
		Result := aDef;
end;

function TStrDictionary.GetValue(i: Integer): String;
var
	s: String;
	j: Integer;
begin
	CheckBounds(i, FCount);
	s := FItems[i];
	j := Pos('=', s);
	Assert(j <> 0);

	if j = 0 then
		Result := ''
	else
		Result := Copy(s, j + 1, Length(s) - j);
end;

function TStrDictionary.IndexOfName(const aName: String): Integer;
begin
	for Result := 0 to Count - 1 do
		if AnsiSameText(GetName(Result), aName) then
			Exit;

	Result := -1;
end;

function TStrDictionary.Join(const aDivider, aFormatItem: String): String;
var
	i: Integer;
begin
	if FCount = 0 then
		Result := ''
	else if aFormatItem = '' then begin
		Result := FItems[0];
		for i := 1 to FCount - 1 do
			Result := Result + aDivider + FItems[i];
	end
	else begin
		Result := Format(aFormatItem, [FItems[0]]);
		for i := 1 to FCount - 1 do
			Result := Result + aDivider + Format(aFormatItem, [FItems[i]]);
	end;
end;

function TStrDictionary.NameExists(const aName: String): Boolean;
begin
	Result := IndexOfName(aName) <> -1;
end;

procedure TStrDictionary.RemoveValue(const aName: String);
var
	i: Integer;
begin
	i := IndexOfName(aName);
	if i <> -1 then
		Delete(i);
end;

procedure TStrDictionary.SetValue(const aName, aValue: String);
var
	s: String;
	i: Integer;
begin
	s := aName + '=' + aValue;
	i := IndexOfName(aName);

	if i <> -1 then
		FItems[i] := s
	else
		Add(s)
end;

procedure TStrDictionary.SetValue(i: Integer; const aValue: String);
begin
	CheckBounds(i, FCount);
	FItems[i] := GetName(i) + '=' + aValue;
end;

procedure TStrDictionary.Split(const aSrc, aDivider: String);
var
	aRest: String;
	aPos: Integer;
	aValue: String;
begin
	Clear;
	if aSrc <> '' then begin
		aRest := aSrc;
		repeat
			aPos := Pos(aDivider, aRest);
			if aPos > 0 then begin
				aValue := Copy(aRest, 1, aPos - 1);
				System.Delete(aRest, 1, aPos + Length(aDivider) - 1);
			end
			else
				aValue := aRest;

			if Trim(aValue) <> '' then
				Add(aValue);

		until aPos <= 0;
	end;
end;

function TStrDictionary.Items(anIndex: Integer): String;
begin
	CheckBounds(anIndex, FCount);
	Result := FItems[anIndex];
end;

procedure TStrDictionary.Sort;

	procedure QuickSort(L, R: Integer);
	var
		x, w: String;
		i, j: Integer;
	begin
		i := L;
		j := R;
		x := GetName((i+j) div 2);

		repeat
			while GetName(i) < x do inc(i);
			while GetName(j) > x do dec(j);

			if i<=j then begin
				w := FItems[i];
				FItems[i] := FItems[j];
				FItems[j] := w;

				inc(i);
				dec(j);
			end;
		until i > j;

		if L < j then
			QuickSort(L, j);

		if i < R then
			QuickSort(i, R);
	end;

begin
	if FCount > 0 then
		QuickSort(0, FCount - 1);
end;

function TStrDictionary.GetNameList: TStrArray;
var
	i: Integer;
begin
	Result.Clear(Count);
	for i := 0 to Count - 1 do
		Result.Add(GetName(i));
end;

function TStrDictionary.GetValueList: TStrArray;
var
	i: Integer;
begin
	Result.Clear(Count);
	for i := 0 to Count - 1 do
		Result.Add(GetValue(i));
end;


{ TIntArray }

procedure TIntArray.Add(i: Integer);
begin
	SetLength(FItems, Length(FItems) + 1);
	FItems[Length(FItems) - 1] := i;
  FSorted := False;
end;

procedure TIntArray.Add(const aList: TIntArray);
var
	i, j: Integer;
begin
	if aList.Count = 0 then
		Exit;

	j := Count;

	SetLength(FItems, Count + aList.Count);
	for i := 0 to aList.Count - 1 do
		FItems[i + j] := aList.FItems[i];

	FSorted := False;
end;

procedure TIntArray.Delete(i: Integer);
var
	j: Integer;
begin
	for j := i to Length(FItems) - 2 do
		FItems[j] := FItems[j + 1];

	SetLength(FItems, Length(FItems) - 1);
end;

procedure TIntArray.Clear;
begin
	SetLength(FItems, 0)
end;

function TIntArray.Count: Integer;
begin
	Result := Length(FItems);
end;

function TIntArray.GetItem(i: Integer): Integer;
begin
  Result := FItems[i];
end;

function TIntArray.IndexOf(i: Integer): Integer;
begin
	for Result := 0 to Length(FItems) - 1 do
		if FItems[Result] = i then
			Exit;
	Result := -1;
end;

procedure TIntArray.SetCount(aValue: Integer);
begin
	SetLength(FItems, aValue);
  FSorted := False;
end;

procedure TIntArray.SetItem(i, aValue: Integer);
begin
  FItems[i] := aValue;
  FSorted := False;
end;

procedure TIntArray.Sort;

	procedure QuickSort(L, R: Integer);
	var
		x, w: Integer;
		i, j: Integer;
	begin
		i := L;
		j := R;
		x := FItems[(i+j) div 2];

		repeat
			while FItems[i] < x do inc(i);
			while FItems[j] > x do dec(j);

			if i<=j then begin
				w := FItems[i];
				FItems[i] := FItems[j];
				FItems[j] := w;

				inc(i);
				dec(j);
			end;
		until i > j;

		if L < j then
			QuickSort(L, j);

		if i < R then
			QuickSort(i, R);
	end;

begin
	if (Length(FItems) > 0) and not FSorted then begin
		QuickSort(0, High(FItems));
    FSorted := True
	end;
end;

{ TDoubleArray }

procedure TDoubleArray.Clear(aCapacity: Integer);
begin
	FCount := 0;
	SetLength(FItems, Max(aCapacity, 0));
end;

function TDoubleArray.Add(aValue: Double): Integer;
begin
	if FCount >= Length(FItems) then
		SetLength(FItems, Max(1, Length(FItems))*2);

	Result := FCount;
	FItems[Result] := aValue;
	Inc(FCount);
end;

function TDoubleArray.Count: Integer;
begin
  Result := FCount;
end;

function TDoubleArray.GetItem(i: Integer): Double;
begin
	CheckBounds(i, FCount);
	Result := FItems[i];
end;

procedure TDoubleArray.SetItem(i: Integer; aValue: Double);
begin
	CheckBounds(i, FCount);
	FItems[i] := aValue;
end;

procedure TDoubleArray.SetCount(aCount: Integer);
begin
	SetLength(FItems, aCount);
	FCount := aCount;
end;

{ TBooleanArray }

procedure TBooleanArray.Clear(aCapacity: Integer);
begin
	FCount := 0;
	SetLength(FItems, Max(aCapacity, 0));
end;

function TBooleanArray.Add(aValue: Boolean): Integer;
begin
	if FCount >= Length(FItems) then
		SetLength(FItems, Max(1, Length(FItems))*2);

	Result := FCount;
	FItems[Result] := aValue;
	Inc(FCount);
end;

function TBooleanArray.Count: Integer;
begin
	Result := FCount;
end;

function TBooleanArray.GetItem(i: Integer): Boolean;
begin
	CheckBounds(i, FCount);
	Result := FItems[i];
end;

procedure TBooleanArray.SetItem(i: Integer; aValue: Boolean);
begin
	CheckBounds(i, FCount);
	FItems[i] := aValue;
end;

procedure TBooleanArray.SetCount(aCount: Integer);
begin
	SetLength(FItems, aCount);
	FCount := aCount;
end;

{ TVariantArray }

constructor TVariantArray.Create;
begin
	SetLength(FItems, 0);
	FCount := 0;
end;

procedure TVariantArray.Clear(aCapacity: Integer);
begin
	SetLength(FItems, aCapacity);
	FCount := 0;
end;

procedure TVariantArray.Assign(const aList: TVariantArray);
var
	i: Integer;
begin
	FCount := aList.Count;
	SetLength(FItems, FCount);
	for i := 0 to FCount - 1 do
		FItems[i] := aList.FItems[i];
end;

procedure TVariantArray.Assign(const aList: array of Variant);
var
	i: Integer;
begin
	FCount := Length(aList);
	SetLength(FItems, FCount);
	for i := 0 to FCount - 1 do
		FItems[i] := aList[i];
end;

function TVariantArray.Add(const aValue: Variant): Integer;
begin
	if FCount >= Length(FItems) then
		SetLength(FItems, Max(1, Length(FItems))*2);
	Result := FCount;
	FItems[Result] := aValue;
	Inc(FCount);
end;

procedure TVariantArray.Add(const aSrc: TVariantArray);
var
	i: Integer;
begin
	SetLength(FItems, FCount + aSrc.Count);
	for i := 0 to aSrc.Count - 1 do
		FItems[FCount + i] := aSrc.FItems[i];
	Inc(FCount, aSrc.Count)
end;

function TVariantArray.Count: Integer;
begin
	Result := FCount;
end;

procedure TVariantArray.Delete(i: Integer);
var
	j: Integer;
begin
	CheckBounds(i, FCount);

	for j := i to Count - 2 do
		FItems[j] := FItems[j + 1];
	Dec(FCount);
end;

function TVariantArray.GetItem(anIndex: Integer): Variant;
begin
	CheckBounds(anIndex, FCount);
	
	Result := FItems[anIndex];
end;

procedure TVariantArray.SetItem(anIndex: Integer; const aValue: Variant);
begin
	CheckBounds(anIndex, FCount);

	FItems[anIndex] := aValue;
end;

function TVariantArray.ItemIsNull(anIndex: Integer): Boolean;
begin
	CheckBounds(anIndex, FCount);
	
	Result := VarIsNull(FItems[anIndex])
end;


end.
