jcllinkedlists.pas

East make Tray Icon in delphi

  // Unidirectional
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

function TItr.Next: TObject;
{$IFDEF THREADSAFE}
var
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := FCursor.Obj;
  FLastRet := FCursor;
  FCursor := FCursor.Next;
end;

function TItr.NextIndex: Integer;
begin
  // No Index
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

function TItr.Previous: TObject;
begin
  // Unidirectional
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

function TItr.PreviousIndex: Integer;
begin
  // No Index
  raise EJclOperationNotSupportedError.CreateRes(@RsEOperationNotSupported);
end;

procedure TItr.Remove;
var
  Current: PJclLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if FCursor = nil then
    Exit;
  Current := FCursor;
  FCursor := FCursor.Next;
  if FLastRet = nil then
    FOwnList.FStart := FCursor
  else
    FLastRet.Next := FCursor;
  Current.Next := nil;
  if FOwnList.FOwnsObjects then
    Current.Obj.Free;
  Current.Obj := nil;
  Dispose(Current);
  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}
  FCursor.Obj := AObject;
end;

//=== { TJclIntfLinkedList } =================================================

constructor TJclIntfLinkedList.Create(ACollection: IJclIntfCollection = nil);
var
  It: IJclIntfIterator;
begin
  inherited Create;
  FStart := nil;
  FEnd := nil;
  FSize := 0;
  if ACollection <> nil then
  begin
    It := ACollection.First;
    while It.HasNext do
      Add(It.Next);
  end;
end;

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

procedure TJclIntfLinkedList.Insert(Index: Integer; AInterface: IInterface);
var
  I: Integer;
  Current: PJclIntfLinkedListItem;
  NewItem: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if (Index < 0) or (Index > FSize) then
    raise EJclOutOfBoundsError.CreateRes(@RsEOutOfBounds);
  if AInterface = nil then
    Exit;
  if FStart = nil then
  begin
    AddFirst(AInterface);
    Exit;
  end;
  New(NewItem);
  NewItem.Obj := AInterface;
  if Index = 0 then
  begin
    NewItem.Next := FStart;
    FStart := NewItem;
    Inc(FSize);
  end
  else
  begin
    Current := FStart;
    I := 0;
    while (Current <> nil) and (I <> Index) do
      Current := Current.Next;
    NewItem.Next := Current.Next;
    Current.Next := NewItem;
    Inc(FSize);
  end;
end;

function TJclIntfLinkedList.Add(AInterface: IInterface): Boolean;
var
  NewItem: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if AInterface = nil then
    Exit;
  Result := True;
  if FStart = nil then
  begin
    AddFirst(AInterface);
    Exit;
  end;
  New(NewItem);
  NewItem.Obj := AInterface;
  NewItem.Next := nil;
  FEnd.Next := NewItem;
  FEnd := NewItem;
  Inc(FSize);
end;

function TJclIntfLinkedList.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
    Result := Add(It.Next) or Result;
end;

function TJclIntfLinkedList.InsertAll(Index: Integer; ACollection: IJclIntfCollection): Boolean;
var
  I: Integer;
  It: IJclIntfIterator;
  Current: PJclIntfLinkedListItem;
  NewItem: PJclIntfLinkedListItem;
{$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;
  It := ACollection.First;
  // (rom) is this a bug? Only one element added.
  if (FStart = nil) and It.HasNext then
  begin
    AddFirst(It.Next);
    Exit;
  end;
  Current := FStart;
  I := 0;
  while (Current <> nil) and (I <> Index) do
    Current := Current.Next;
  while It.HasNext do
  begin
    New(NewItem);
    NewItem.Obj := It.Next;
    if Index = 0 then
    begin
      NewItem.Next := FStart;
      FStart := NewItem;
      Inc(FSize);
    end
    else
    begin
      NewItem.Next := Current.Next;
      Current.Next := NewItem;
      Inc(FSize);
    end;
    Inc(Index);
  end;
  Result := True;
end;

procedure TJclIntfLinkedList.AddFirst(AInterface: IInterface);
begin
  New(FStart);
  FStart.Obj := AInterface;
  FStart.Next := nil;
  FEnd := FStart;
  Inc(FSize);
end;

procedure TJclIntfLinkedList.Clear;
var
  I: Integer;
  Old, Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Current := FStart;
  for I := 0 to FSize - 1 do
  begin
    Current.Obj := nil;
    Old := Current;
    Current := Current.Next;
    Dispose(Old);
  end;
  FSize := 0;

  //Daniele Teti 27/12/2004
  FStart := nil;
  FEnd := nil;
end;

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

function TJclIntfLinkedList.Contains(AInterface: IInterface): Boolean;
var
  I: Integer;
  Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if AInterface = nil then
    Exit;
  Current := FStart;
  for I := 0 to FSize - 1 do
  begin
    if Current.Obj = AInterface then
    begin
      Result := True;
      Exit;
    end;
    Current := Current.Next;
  end;
end;

function TJclIntfLinkedList.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 TJclIntfLinkedList.Equals(ACollection: IJclIntfCollection): Boolean;
var
  It, ItSelf: 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;
  ItSelf := First;
  while ItSelf.HasNext do
    if ItSelf.Next <> It.Next then
      Exit;
  Result := True;
end;

function TJclIntfLinkedList.GetObject(Index: Integer): IInterface;
var
  I: Integer;
  Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := nil;
  if FStart = nil then
    Exit;
  Current := FStart;
  for I := 0 to Index - 1 do
    Current := Current.Next;
  Result := Current.Obj;
end;

function TJclIntfLinkedList.IndexOf(AInterface: IInterface): Integer;
var
  I: Integer;
  Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := -1;
  if AInterface = nil then
    Exit;
  if FStart = nil then
    Exit;
  Current := FStart;
  for I := 0 to FSize - 1 do
  begin
    if Current.Obj = AInterface then
    begin
      Result := I;
      Break;
    end;
    Current := Current.Next;
  end;
end;

function TJclIntfLinkedList.First: IJclIntfIterator;
begin
  Result := TIntfItr.Create(Self, FStart);
end;

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

function TJclIntfLinkedList.Last: IJclIntfIterator;
begin
  Result := TIntfItr.Create(Self, FStart);
end;

function TJclIntfLinkedList.LastIndexOf(AInterface: IInterface): Integer;
var
  I: Integer;
  Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := -1;
  if AInterface = nil then
    Exit;
  if FStart = nil then
    Exit;
  Current := FStart;
  for I := 0 to FSize - 1 do
  begin
    if Current.Obj = AInterface then
      Result := I;
    Current := Current.Next;
  end;
end;

function TJclIntfLinkedList.Remove(AInterface: IInterface): Boolean;
var
  I: Integer;
  Old, Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if AInterface = nil then
    Exit;
  if FStart = nil then
    Exit;
  Old := nil;
  Current := FStart;
  for I := 0 to FSize - 1 do
  begin
    if Current.Obj = AInterface then
    begin
      Current.Obj := nil;
      if Old <> nil then
      begin
        Old.Next := Current.Next;
        if Old.Next = nil then
          FEnd := Old;
      end
      else
        FStart := Current.Next;
      Dispose(Current);
      Dec(FSize);
      Result := True;
      Exit;
    end;
    Old := Current;
    Current := Current.Next;
  end;
end;

function TJclIntfLinkedList.Remove(Index: Integer): IInterface;
var
  I: Integer;
  Old, Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := nil;
  if FStart = nil then
    Exit;
  Old := nil;
  Current := FStart;
  for I := 0 to Index - 1 do
  begin
    Old := Current;
    Current := Current.Next;
  end;
  Current.Obj := nil;
  if Old <> nil then
  begin
    Old.Next := Current.Next;
    if Old.Next = nil then
      FEnd := Old;
  end
  else
    FStart := Current.Next;
  Dispose(Current);
  Dec(FSize);
end;

function TJclIntfLinkedList.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 TJclIntfLinkedList.RetainAll(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 := First;
  while It.HasNext do
    if not ACollection.Contains(It.Next) then
      It.Remove;
end;

procedure TJclIntfLinkedList.SetObject(Index: Integer; AInterface: IInterface);
var
  I: Integer;
  Current: PJclIntfLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  if FStart = nil then
    Exit;
  Current := FStart;
  for I := 0 to Index - 1 do
    Current := Current.Next;
  Current.Obj := AInterface;
end;

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

function TJclIntfLinkedList.SubList(First, Count: Integer): IJclIntfList;
var
  I: Integer;
  It: IJclIntfIterator;
  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 := TJclIntfLinkedList.Create;
  I := 0;
  It := Self.First;
  while (I < First) and It.HasNext do
  begin
    It.Next;
    Inc(I);