lazarus-ccr/components/flashfiler/sourcelaz/ffllcoll.pas

{*********************************************************}
{* FlashFiler: Collection class                          *}
{*********************************************************}

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower FlashFiler
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{$I ffdefine.inc}

unit ffllcoll;

interface

uses
  Classes,
  ffllbase;

type
  TffCollection = class; {forward declaration}

  TffCollectionItem = class    {class of item appearing in collection}
    protected {private}
      ciContainer : TffCollection;
      ciParent    : TObject;
    protected
      function ciGetIdentifier : integer;
    public
      constructor Create(aParent : TObject; aContainer : TffCollection);
      destructor Destroy; override;

      property Container : TffCollection read ciContainer;
      property Identifier : integer read ciGetIdentifier;
      property Parent : TObject read ciParent;
  end;

  {note: rewritted to use TList                                       !!.06}
  TffCollection = class
    protected {private}
      FItems : TList;
    protected
      function tcGet(aIndex : integer) : TffCollectionItem;
      function tcGetCapacity : integer;
      function tcGetCount : integer;
      procedure tcPut(aIndex : integer; aItem : TffCollectionItem);
      procedure tcSetCapacity(aNewCapacity : integer);
    public
      constructor Create;
      destructor Destroy; override;

      procedure InsertAt(aIndex: integer; aItem : TffCollectionItem);
      procedure Delete(aItem : TffCollectionItem);
      procedure FreeAll;
      function IndexOf(aItem : TffCollectionItem) : integer; virtual;
      function Insert(aItem : TffCollectionItem) : boolean; virtual;

      property Count: integer read tcGetCount;
      property Items[aIndex : integer] : TffCollectionItem
         read tcGet write tcPut; default;
  end;

  TffSortedCollection = class(TffCollection)
    private
      tscAllowDups : boolean;
    public
      constructor Create(aAllowDups : boolean);

      function KeyOf(aItem : TffCollectionItem) : pointer; virtual;
      function Compare(aKey1, aKey2 : Pointer) : integer; virtual; abstract;
      function Insert(aItem : TffCollectionItem) : boolean; override;
      function Search(aKey : Pointer; var aIndex : integer): boolean; virtual;

      property AllowDups : boolean read tscAllowDups;
  end;

implementation

uses
  SysUtils,
  ffconst,
  ffclbase;

{===TffCollectionItem================================================}
constructor TffCollectionItem.Create(aParent    : TObject;
                                     aContainer : TffCollection);
begin
  inherited Create;
  ciParent := aParent;
  ciContainer := aContainer;
  if (aContainer <> nil) then
    if not aContainer.Insert(Self) then
      raise Exception.Create(ffStrResClient[ffccDupItemInColl]);
end;
{--------}
destructor TffCollectionItem.Destroy;
begin
  if (ciContainer <> nil) then
    ciContainer.Delete(Self);
  inherited Destroy;
end;
{--------}
function TffCollectionItem.ciGetIdentifier : integer;
begin
  if (ciContainer <> nil) then
    Result := ciContainer.IndexOf(Self)
  else
    Result := 0;
end;
{====================================================================}


{===TffCollection====================================================}
constructor TffCollection.Create;
begin
  inherited Create;
  FItems := TList.Create;
end;
{--------}
destructor TffCollection.Destroy;
begin
  if (FItems <> nil) then begin
    FreeAll;
    FItems.Free;
  end;
  inherited Destroy;
end;
{--------}
procedure TffCollection.InsertAt(aIndex : integer; aItem : TffCollectionItem);
begin
  FItems.Insert(aIndex, aItem);
end;
{--------}
procedure TffCollection.Delete(aItem : TffCollectionItem);
var
  Inx : integer;
begin
  Inx := FItems.IndexOf(aItem);
  if (Inx <> -1) then
    FItems.Delete(Inx);
end;
{--------}
procedure TffCollection.FreeAll;
var
  Inx : integer;
begin
  {note: the downto is required because the base item class will
         delete itself from the collection when freed}
  for Inx := pred(FItems.Count) downto 0 do
    TObject(FItems[Inx]).Free;
  FItems.Clear;
end;
{--------}
function TffCollection.IndexOf(aItem : TffCollectionItem) : integer;
begin
  Result := FItems.IndexOf(aItem);
end;
{--------}
function TffCollection.Insert(aItem : TffCollectionItem) : boolean;
begin
  FItems.Add(aItem);
  Result := true;
end;
{--------}
function TffCollection.tcGet(aIndex : integer) : TffCollectionItem;
begin
  Result := TffCollectionItem(FItems[aIndex]);
end;
{--------}
function TffCollection.tcGetCount: integer;
begin
  Result := FItems.Count;
end;
{--------}
function TffCollection.tcGetCapacity : integer;
begin
  Result := FItems.Capacity;
end;
{--------}
procedure TffCollection.tcPut(aIndex : integer; aItem : TffCollectionItem);
begin
  FItems[aIndex] := aItem;
end;
{--------}
procedure TffCollection.tcSetCapacity(aNewCapacity : integer);
begin
  FItems.Capacity := aNewCapacity;
end;
{====================================================================}


{===TffSortedCollection==============================================}
constructor TffSortedCollection.Create(aAllowDups : boolean);
begin
  inherited Create;
  tscAllowDups := aAllowDups;
end;
{--------}
function TffSortedCollection.Insert(aItem : TffCollectionItem) : boolean;
var
  Inx : integer;
begin
  if (not Search(KeyOf(aItem), Inx)) or AllowDups then begin
    InsertAt(Inx, aItem);
    Result := true;
  end else
    Result := false;
end;
{--------}
function TffSortedCollection.KeyOf(aItem : TffCollectionItem) : pointer;
begin
  Result := aItem;
end;
{--------}
function TffSortedCollection.Search(aKey : pointer; var aIndex : integer) : boolean;
var
  L, R, M : integer;
  CmpRes  : integer;
begin
  Result := false;
  L := 0;
  R := pred(Count);
  while (L <= R) do begin
    M := (L + R) div 2;
    CmpRes := Compare(KeyOf(FItems[M]), aKey);
    if (CmpRes < 0) then
      L := succ(M)
    else if (CmpRes > 0) then
      R := pred(M)
    else {CmpRes = 0} begin
      Result := true;
      if not AllowDups then begin
        aIndex := M;
        Exit;
      end;
      R := pred(M); {need to find the first dup item}
    end;
  end;
  aIndex := L;
end;
{====================================================================}


end.