jclarraylists.pas

East make Tray Icon in delphi

  private
    FCursor: Integer;
    FOwnList: TJclArrayList;
    //FLastRet: Integer;
    FSize: Integer;
  protected
    { IJclIterator}
    procedure Add(AObject: TObject);
    function GetObject: TObject;
    function HasNext: Boolean;
    function HasPrevious: Boolean;
    function Next: TObject;
    function NextIndex: Integer;
    function Previous: TObject;
    function PreviousIndex: Integer;
    procedure Remove;
    procedure SetObject(AObject: TObject);
  public
    constructor Create(AOwnList: TJclArrayList);
    destructor Destroy; override;
  end;

constructor TItr.Create(AOwnList: TJclArrayList);
begin
  inherited Create;
  FCursor := 0;
  FOwnList := AOwnList;
  FOwnList._AddRef; // Add a ref because FOwnList is not an interface !
  //FLastRet := -1;
  FSize := FOwnList.Size;
end;

destructor TItr.Destroy;
begin
  FOwnList._Release;
  inherited Destroy;
end;

procedure TItr.Add(AObject: TObject);
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  // inlined FOwnList.Add
  if FOwnList.FSize = FOwnList.Capacity then
    FOwnList.Grow;
  if FOwnList.FSize <> FCursor then
    System.Move(FOwnList.FElementData[FCursor], FOwnList.FElementData[FCursor + 1],
      (FOwnList.FSize - FCursor) * SizeOf(TObject));
  FOwnList.FElementData[FCursor] := AObject;
  Inc(FOwnList.FSize);

  Inc(FSize);
  Inc(FCursor);
  //FLastRet := -1;
end;

function TItr.GetObject: TObject;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := FOwnList.FElementData[FCursor];
end;

function TItr.HasNext: Boolean;
begin
  Result := FCursor <> FSize;
end;

function TItr.HasPrevious: Boolean;
begin
  Result := FCursor > 0;
end;

function TItr.Next: TObject;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := FOwnList.FElementData[FCursor];
  //FLastRet := FCursor;
  Inc(FCursor);
end;

function TItr.NextIndex: Integer;
begin
  Result := FCursor;
end;

function TItr.Previous: TObject;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Dec(FCursor);
  //FLastRet := FCursor;
  Result := FOwnList.FElementData[FCursor];
end;

function TItr.PreviousIndex: Integer;
begin
  Result := FCursor - 1;
end;

procedure TItr.Remove;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  with FOwnList do
  begin
    FreeObject(FElementData[FCursor]);
    if FSize <> FCursor then
      System.Move(FElementData[FCursor + 1], FElementData[FCursor],
        (FSize - FCursor) * SizeOf(TObject));
  end;
  Dec(FOwnList.FSize);
  Dec(FSize);
end;

procedure TItr.SetObject(AObject: TObject);
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  FOwnList.FElementData[FCursor] := AObject;
end;

//=== { TJclIntfArrayList } ==================================================

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

constructor TJclIntfArrayList.Create(ACollection: IJclIntfCollection);
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 TJclIntfArrayList.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TJclIntfArrayList.Insert(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);
  if FSize = Capacity then
    Grow;
  if FSize <> Index then
    System.Move(FElementData[Index], FElementData[Index + 1],
      (FSize - Index) * SizeOf(IInterface));
  // (rom) otherwise interface reference counting may crash
  FillChar(FElementData[Index], SizeOf(IInterface), 0);
  FElementData[Index] := AInterface;
  Inc(FSize);
end;

function TJclIntfArrayList.InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean;
var
  It: IJclIntfIterator;
  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
    Capacity := FSize + Size;
  if Size <> 0 then
    System.Move(FElementData[Index], FElementData[Index + Size],
      Size * SizeOf(IInterface));
  // (rom) otherwise interface reference counting may crash
  FillChar(FElementData[Index], Size * SizeOf(IInterface), 0);
  It := ACollection.First;
  Result := It.HasNext;
  while It.HasNext do
  begin
    FElementData[Index] := It.Next;
    Inc(Index);
  end;
end;

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

function TJclIntfArrayList.AddAll(ACollection: IJclIntfCollection): Boolean;
var
  It: IJclIntfIterator;
{$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
    if FSize = Capacity then
      Grow;
    FillChar(FElementData[FSize], SizeOf(IInterface), 0);
    FElementData[FSize] := It.Next;
    Inc(FSize);
  end;
  Result := True;
end;

procedure TJclIntfArrayList.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] := nil;
  FSize := 0;
end;

function TJclIntfArrayList.Clone: IInterface;
var
  NewList: IJclIntfList;
begin
  NewList := TJclIntfArrayList.Create(Capacity);
  NewList.AddAll(Self);
  Result := NewList;
end;

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

function TJclIntfArrayList.ContainsAll(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 Result and It.HasNext do
  Result := contains(It.Next);
end;

function TJclIntfArrayList.Equals(ACollection: IJclIntfCollection): Boolean;
var
  I: Integer;
  It: IJclIntfIterator;
{$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 TJclIntfArrayList.GetObject(Index: Integer): IInterface;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if (Index < 0) or (Index >= FSize) then
    Result := nil
  else
    Result := FElementData[Index];
end;

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

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

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

function TJclIntfArrayList.First: IJclIntfIterator;
begin
  Result := TIntfItr.Create(Self);
end;

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

function TJclIntfArrayList.Last: IJclIntfIterator;
var
  NewIterator: TIntfItr;
begin
  NewIterator := TIntfItr.Create(Self);
  NewIterator.FCursor := NewIterator.FOwnList.FSize;
  NewIterator.FSize := NewIterator.FOwnList.FSize;
  Result := NewIterator;
end;

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

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

function TJclIntfArrayList.Remove(Index: Integer): 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);