jclarraylists.pas

East make Tray Icon in delphi

  Result := FElementData[Index];
  FElementData[Index] := nil;
  if FSize <> Index then
    System.Move(FElementData[Index + 1], FElementData[Index],
      (FSize - Index) * SizeOf(IInterface));
  Dec(FSize);
end;

function TJclIntfArrayList.RemoveAll(ACollection: IJclIntfCollection): Boolean;
var
  It: IJclIntfIterator;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := True;
  if ACollection = nil then
    Exit;
  It := ACollection.First;
  while It.HasNext do
    Result := Remove(It.Next) and Result;
end;

function TJclIntfArrayList.RetainAll(ACollection: IJclIntfCollection): Boolean;
var
  I: Integer;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if ACollection = nil then
    Exit;
  for I := FSize - 1 downto 0 do
    if not ACollection.Contains(FElementData[I]) then
      Remove(I);
end;

procedure TJclIntfArrayList.SetObject(Index: Integer; AInterface: IInterface);
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if (Index < 0) or (Index >= FSize) then
    raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
  FElementData[Index] := AInterface;
end;

function TJclIntfArrayList.Size: Integer;
begin
  Result := FSize;
end;

function TJclIntfArrayList.SubList(First, Count: Integer): IJclIntfList;
var
  I: Integer;
  Last: Integer;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Last := First + Count - 1;
  if Last >= FSize then
    Last := FSize - 1;
  Result := TJclIntfArrayList.Create(Count);
  for I := First to Last do
    Result.Add(FElementData[I]);
end;

//=== { TJclStrArrayList } ===================================================

constructor TJclStrArrayList.Create(ACapacity: Integer = DefaultContainerCapacity);
begin
  inherited Create;
  FSize := 0;
  if ACapacity < 0 then
    FCapacity := 0
  else
    FCapacity := ACapacity;
  SetLength(FElementData, FCapacity);
end;

constructor TJclStrArrayList.Create(ACollection: IJclStrCollection);
begin
  // (rom) disabled because the following Create already calls inherited
  // inherited Create;
  if ACollection = nil then
    raise EJclIllegalArgumentError.CreateRes(@RsENoCollection);
  Create(ACollection.Size);
  AddAll(ACollection);
end;

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

procedure TJclStrArrayList.Insert(Index: Integer; const AString: string);
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if (Index < 0) or (Index > FSize) then
    raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
  if FSize = Capacity then
    Grow;
  if FSize <> Index then
    System.Move(FElementData[Index], FElementData[Index + 1],
      (FSize - Index) * SizeOf(string));
  // (rom) otherwise string reference counting would crash
  FillChar(FElementData[Index], SizeOf(string), 0);
  FElementData[Index] := AString;
  Inc(FSize);
end;

function TJclStrArrayList.InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean;
var
  It: IJclStrIterator;
  Size: Integer;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;

  if (Index < 0) or (Index >= FSize) then
    raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);

  if ACollection = nil then
    Exit;
  Size := ACollection.Size;
  if FSize + Size >= Capacity then
  begin
    Capacity := FSize + Size;
    FSize := Capacity;
  end;
  if Size <> 0 then
    System.Move(FElementData[Index], FElementData[Index + Size],
      Size * SizeOf(string));
  // (rom) otherwise string reference counting would crash
  FillChar(FElementData[Index], Size * SizeOf(string), 0);
  It := ACollection.First;
  Result := It.HasNext;
  while It.HasNext do
  begin
    FElementData[Index] := It.Next;
    Inc(Index);
  end;
end;

function TJclStrArrayList.Add(const AString: string): Boolean;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if FSize = Capacity then
    Grow;
  FillChar(FElementData[FSize], SizeOf(string), 0);
  FElementData[FSize] := AString;
  Inc(FSize);
  Result := True;
end;

function TJclStrArrayList.AddAll(ACollection: IJclStrCollection): Boolean;
var
  It: IJclStrIterator;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if ACollection = nil then
    Exit;
  It := ACollection.First;
  while It.HasNext do
  begin
    // (rom) inlining Add() gives about 5 percent performance increase
    // without THREADSAFE and about 30 percent with THREADSAFE
    if FSize = Capacity then
      Grow;
    FillChar(FElementData[FSize], SizeOf(string), 0);
    FElementData[FSize] := It.Next;
    Inc(FSize);
  end;
  Result := True;
end;

procedure TJclStrArrayList.Clear;
var
  I: Integer;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  for I := 0 to FSize - 1 do
    FElementData[I] := '';
  FSize := 0;
end;

function TJclStrArrayList.Clone: TObject;
var
  NewList: TJclStrArrayList;
begin
  NewList := TJclStrArrayList.Create(Capacity);
  NewList.AddAll(Self);
  Result := NewList;
end;

function TJclStrArrayList.Contains(const AString: string): Boolean;
var
  I: Integer;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if AString = '' then
    Exit;
  for I := 0 to FSize - 1 do
    if FElementData[I] = AString then
    begin
      Result := True;
      Break;
    end;
end;

function TJclStrArrayList.ContainsAll(ACollection: IJclStrCollection): Boolean;
var
  It: IJclStrIterator;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := True;
  if ACollection = nil then
    Exit;
  It := ACollection.First;
  while Result and It.HasNext do
  Result := contains(It.Next);
end;

function TJclStrArrayList.Equals(ACollection: IJclStrCollection): Boolean;
var
  I: Integer;
  It: IJclStrIterator;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if ACollection = nil then
    Exit;
  if FSize <> ACollection.Size then
    Exit;
  It := ACollection.First;
  for I := 0 to FSize - 1 do
    if FElementData[I] <> It.Next then
      Exit;
  Result := True;
end;

function TJclStrArrayList.First: IJclStrIterator;
begin
  Result := TStrItr.Create(Self);
end;

function TJclStrArrayList.GetString(Index: Integer): string;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if (Index < 0) or (Index >= FSize) then
    Result := ''
  else
    Result := FElementData[Index];
end;

procedure TJclStrArrayList.SetCapacity(ACapacity: Integer);
begin
  if ACapacity >= FSize then
  begin
    SetLength(FElementData, ACapacity);
    FCapacity := ACapacity;
  end
  else
    raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
end;

procedure TJclStrArrayList.Grow;
begin
  if Capacity > 64 then
    Capacity := Capacity + Capacity div 4
  else if FCapacity = 0 then
    FCapacity := 64
  else
    Capacity := Capacity * 4;
end;

function TJclStrArrayList.IndexOf(const AString: string): Integer;
var
  I: Integer;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := -1;
  if AString = '' then
    Exit;
  for I := 0 to FSize - 1 do
    if FElementData[I] = AString then
    begin
      Result := I;
      Break;
    end;
end;

function TJclStrArrayList.IsEmpty: Boolean;
begin
  Result := FSize = 0;
end;

function TJclStrArrayList.Last: IJclStrIterator;
var
  NewIterator: TStrItr;
begin
  NewIterator := TStrItr.Create(Self);
  NewIterator.FCursor := NewIterator.FOwnList.FSize;
  NewIterator.FSize := NewIterator.FOwnList.FSize;
  Result := NewIterator;
end;

function TJclStrArrayList.LastIndexOf(const AString: string): Integer;
var
  I: Integer;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := -1;
  if AString = '' then
    Exit;
  for I := FSize - 1 downto 0 do
    if FElementData[I] = AString then
    begin
      Result := I;
      Break;
    end;
end;

function TJclStrArrayList.Remove(const AString: string): Boolean;
var
  I: Integer;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if AString = '' then
    Exit;
  for I := FSize - 1 downto 0 do
    if FElementData[I] = AString then // Removes all AString
    begin
      FElementData[I] := ''; // Force Release
      if FSize <> I then
        System.Move(FElementData[I + 1], FElementData[I],
          (FSize - I) * SizeOf(IInterface));
      Dec(FSize);
      Result := True;
    end;
end;

function TJclStrArrayList.Remove(Index: Integer): string;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if (Index < 0) or (Index >= FSize) then
    raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
  Result := FElementData[Index];
  FElementData[Index] := '';
  if FSize <> Index then
    System.Move(FElementData[Index + 1], FElementData[Index],
      (FSize - Index) * SizeOf(IInterface));
  Dec(FSize);
end;

function TJclStrArrayList.RemoveAll(ACollection: IJclStrCollection): Boolean;
var
  It: IJclStrIterator;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := True;
  if ACollection = nil then
    Exit;
  It := ACollection.First;
  while It.HasNext do
    Result := Remove(It.Next) and Result;
end;

function TJclStrArrayList.RetainAll(ACollection: IJclStrCollection): Boolean;
var
  I: Integer;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if ACollection = nil then
    Exit;
  for I := FSize - 1 downto 0 do
    if not ACollection.Contains(FElementData[I]) then
      Remove(I);
end;

procedure TJclStrArrayList.SetString(Index: Integer; const AString: string);
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if (Index < 0) or (Index >= FSize) then
    raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
  FElementData[Index] := AString
end;

function TJclStrArrayList.Size: Integer;
begin
  Result := FSize;
end;

function TJclStrArrayList.SubList(First, Count: Integer): IJclStrList;
var