jcllinkedlists.pas

East make Tray Icon in delphi

  end;
  //I := 0;
  while (I <= Last) and It.HasNext do
  begin
    Result.Add(It.Next);
    Inc(I);
  end;
end;

//=== { TJclStrLinkedList } ==================================================

constructor TJclStrLinkedList.Create(ACollection: IJclStrCollection = nil);
var
  It: IJclStrIterator;
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 TJclStrLinkedList.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TJclStrLinkedList.Insert(Index: Integer; const AString: string);
var
  I: Integer;
  Current: PJclStrLinkedListItem;
  NewItem: PJclStrLinkedListItem;
{$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 AString = '' then
    Exit;
  if FStart = nil then
  begin
    AddFirst(AString);
    Exit;
  end;
  New(NewItem);
  NewItem.Str := AString;
  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 TJclStrLinkedList.Add(const AString: string): Boolean;
var
  NewItem: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if AString = '' then
    Exit;
  Result := True;
  if FStart = nil then
  begin
    AddFirst(AString);
    Exit;
  end;
  New(NewItem);
  NewItem.Str := AString;
  NewItem.Next := nil;
  FEnd.Next := NewItem;
  FEnd := NewItem;
  Inc(FSize);
end;

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

function TJclStrLinkedList.InsertAll(Index: Integer; ACollection: IJclStrCollection): Boolean;
var
  I: Integer;
  It: IJclStrIterator;
  Current: PJclStrLinkedListItem;
  NewItem: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if ACollection = nil then
    Exit;

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

  It := ACollection.First;
  // (rom) is this a bug? Only one element added.
  if (FStart = nil) and It.HasNext then
  begin
    AddFirst(It.Next);
    //Exit;  //Daniele Teti
  end;
  Current := FStart;
  I := 0;
  while (Current <> nil) and (I <> Index) do
  begin
    Current := Current.Next;
    inc(I);
  end;
  while It.HasNext do
  begin
    New(NewItem);
    NewItem.Str := 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 TJclStrLinkedList.AddFirst(const AString: string);
begin
  New(FStart);
  FStart.Str := AString;
  FStart.Next := nil;
  FEnd := FStart;
  Inc(FSize);
end;

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

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

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

function TJclStrLinkedList.Contains(const AString: string): Boolean;
var
  I: Integer;
  Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if AString = '' then
    Exit;
  Current := FStart;
  for I := 0 to FSize - 1 do
  begin
    if Current.Str = AString then
    begin
      Result := True;
      Exit;
    end;
    Current := Current.Next;
  end;
end;

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

function TJclStrLinkedList.First: IJclStrIterator;
begin
  Result := TStrItr.Create(Self, FStart);
end;

function TJclStrLinkedList.GetString(Index: Integer): string;
var
  I: Integer;
  Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := '';
  if FStart = nil then
    Exit;
  Current := FStart;
  for I := 0 to Index - 1 do
    Current := Current.Next;
  Result := Current.Str;
end;

function TJclStrLinkedList.IndexOf(const AString: string): Integer;
var
  I: Integer;
  Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := -1;
  if AString = '' then
    Exit;
  if FStart = nil then
    Exit;
  Current := FStart;
  for I := 0 to FSize - 1 do
  begin
    if Current.Str = AString then
    begin
      Result := I;
      Break;
    end;
    Current := Current.Next;
  end;
end;

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

function TJclStrLinkedList.Last: IJclStrIterator;
begin
  Result := TStrItr.Create(Self, FStart);
end;

function TJclStrLinkedList.LastIndexOf(const AString: string): Integer;
var
  I: Integer;
  Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := -1;
  if AString = '' then
    Exit;
  if FStart = nil then
    Exit;
  Current := FStart;
  for I := 0 to FSize - 1 do
  begin
    if Current.Str = AString then
      Result := I;
    Current := Current.Next;
  end;
end;

function TJclStrLinkedList.Remove(Index: Integer): string;
var
  I: Integer;
  Old, Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := '';
  if FStart = nil then
    Exit;
  Old := nil;
  Current := FStart;
  for I := 0 to Index - 1 do
  begin
    Old := Current;
    Current := Current.Next;
  end;
  Current.Str := '';
  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 TJclStrLinkedList.Remove(const AString: string): Boolean;
var
  I: Integer;
  Old, Current: PJclStrLinkedListItem;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF THREADSAFE}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF THREADSAFE}
  Result := False;
  if AString = '' then
    Exit;
  if FStart = nil then
    Exit;
  Old := nil;
  Current := FStart;
  for I := 0 to FSize - 1 do
  begin
    if Current.Str = AString then
    begin
      Current.Str := '';
      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 TJclStrLinkedList.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 TJclStrLinkedList.RetainAll(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 := First;
  while It.HasNext do
    if not ACollection.Contains(It.Next) then
      It.Remove;
end;

procedure TJclStrLinkedList.SetString(Index: Integer; const AString: string);
var
  I: Integer;
  Current: PJclStrLinkedListItem;
{$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.Str := AString;
end;

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

function TJclStrLinkedList.SubList(First, Count: Integer): IJclStrList;
var
  I: Integer;
  It: IJclStrIterator;
  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 := TJclStrLinkedList.Create;
  I := 0;
  It := Self.First;
  while (I < First) and It.HasNext do
  begin
    It.Next;
    Inc(I);
  end;
  //I := 0;
  while (I <= Last) and It.HasNext do
  begin
    Result.Add(It.Next);
    Inc(I);
  end;
end;

//=== { TJclLinkedList } =====================================================

constructor TJclLinkedList.Create(ACollection: IJclCollection = nil; AOwnsObjects: Boolean = True);
var
  It: IJclIterator;
begin
  inherited Create;
  FStart := nil;
  FEnd := nil;
  FSize := 0;
  FOwnsObjects := AOwnsObjects;
  if ACollection <> nil then
  begin
    It := ACollection.First;
    while It.HasNext do
      Add(It.Next);
  end;
end;

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

procedure TJclLinkedList.Insert(Index: Integer; AObject: TObject);
var
  I: Integer;
  Current: PJclLinkedListItem;
  NewItem: PJclLinkedListItem;
{$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 AObject = nil then
    Exit;
  if FStart = nil then
  begin
    AddFirst(AObject);
    Exit;
  end;
  New(NewItem);
  NewItem.Obj := AObject;
  if Index = 0 then
  begin
    NewItem.Next := FStart;
    FStart := NewItem;