(*****************************************************************************)
(* MODULE: BSECOLL^                                                          *)
(* RIGHTS: Reggatta Systems, Inc. - COPYRIGHT 1995 - 1998                    *)
(* DESCR.: This module contains a TTitanCollection Class.                    *)
(*****************************************************************************)
Unit BseColl;
{$I BSE.INC}
interface
uses
  Classes;

Type
  TTitanCollection =
  Class( TObject )
    Private
      FItems : TList;
    Public
      Constructor Create;
      Destructor  Destroy; Override;
      Function    At( Index : integer ) : pointer;
      Procedure   AtDelete( Index : integer );
      Procedure AtFree( Index : integer );
      Procedure AtInsert( Index: integer; Item : pointer );
      Procedure AtPut( Index : Integer; Item : Pointer );
      Procedure Clear;
      Procedure Delete( Item : Pointer );
      Procedure DeleteAll;
      Procedure Error( Code, Info : Integer );
      Procedure FreeAll;
      Procedure FreeItem( Item : pointer );
      Function  Get( AIndex : integer ) : pointer;
      Function  GetCount : integer;
      Function  IndexOf( Item : pointer ) : integer;
      Procedure Insert( Item : pointer );
        Virtual;
      Procedure Pack;
      Procedure Put( AIndex : integer; APointer : pointer );
      Function  GetCapacity : Integer;
      Procedure SetCapacity( NewCapacity : Integer );

      Property  Count: integer
        Read  GetCount;
      Property  Items[ index : integer ] : pointer
        Read  Get
        Write Put;
      Property  Capacity : Integer
        Read  GetCapacity
        Write SetCapacity;
  end;

  TSortedCollection =
  Class( TTitanCollection )
    Private
      FDuplicates : Boolean;
    Public
      Constructor Create;
      Function  KeyOf( Item : Pointer ) : Pointer; Virtual;
      Function  Compare( Key1, Key2 : Pointer ) : Integer; Virtual; abstract;
      Procedure Insert( Item : Pointer ); Override;
      Function  Search( Key : Pointer; var Index : Integer): Boolean; Virtual;

      Property  Duplicates: Boolean
        Read  FDuplicates
        Write FDuplicates;
  end;


implementation


Constructor TTitanCollection.Create;
begin
  Inherited Create;
  FItems := TList.Create;
end;


Destructor TTitanCollection.Destroy;
begin
  FreeAll;
  FItems.Free;
  Inherited Destroy;
end;


Function TTitanCollection.At( Index : integer ) : pointer;
begin
  Try
    Result := FItems[ Index ];
  Except
    On E:EListError do
      Result := NIL;
  end;
end;


Procedure TTitanCollection.AtDelete( Index : integer);
begin
  FItems.Delete( Index );
end;


Procedure TTitanCollection.AtFree( Index : integer );
var
  Item : pointer;
begin
  Item := At( Index );
  if ( Item <> NIL ) then
  begin
    AtDelete( Index );
    FreeItem( Item );
  end;
end;


Procedure TTitanCollection.AtInsert( Index : integer; Item : pointer );
begin
  FItems.Insert( Index, Item );
end;


Procedure TTitanCollection.AtPut( Index : integer; Item : pointer );
begin
  FItems[ Index ] := Item;
end;


Procedure TTitanCollection.Clear;
begin
  FItems.Clear;
end;


Procedure TTitanCollection.Delete( Item : pointer );
var
  i : Integer;
begin
  i := IndexOf( Item );
  if ( i <> -1 ) then
    AtDelete( i );
end;


Procedure TTitanCollection.DeleteAll;
begin
  FItems.Clear;
end;


Procedure TTitanCollection.Error( Code, Info : integer );
begin
  Raise EListError.Create( 'Collection index out of range' );
end;




Procedure TTitanCollection.FreeAll;
{ Special Thanks to Mark Lussier for DownTo change here }
var
  I : integer;
begin
  Try
    for I := Pred( Count ) DownTo 0 do
      FreeItem( At( I ) );
  Except
    On EListError Do
      ;
  End;
  FItems.Clear;
end;


Procedure TTitanCollection.FreeItem( Item : pointer );
begin
  If ( Item <> NIL ) then
    TObject( Item ).Free;
end;


Function TTitanCollection.Get( AIndex : integer ) : pointer;
begin
  Result := FItems[ AIndex ];
end;


Function TTitanCollection.GetCount: integer;
begin
  Result := FItems.Count;
end;


Function TTitanCollection.IndexOf( Item : pointer ) : integer;
begin
  Result := FItems.IndexOf( Item );
end;


Procedure TTitanCollection.Insert( Item : pointer );
begin
  FItems.Add( Item );
end;




Procedure TTitanCollection.Pack;
begin
  FItems.Pack;
end;


Procedure TTitanCollection.Put( AIndex : integer; APointer : pointer );
begin
  FItems[ AIndex ] := APointer;
end;


Function TTitanCollection.GetCapacity : Integer;
begin
  Result := FItems.Capacity;
end;


Procedure TTitanCollection.SetCapacity( NewCapacity : Integer );
begin
  FItems.Capacity := NewCapacity;
end;


Constructor TSortedCollection.Create;
begin
  Inherited Create;
  FDuplicates := TRUE;
end;


Procedure TSortedCollection.Insert( Item : pointer );
var
  i : Integer;
begin
  if ( not Search( KeyOf( Item ), i ) ) or ( Duplicates ) then
    AtInsert( i, Item );
end;


Function TSortedCollection.KeyOf( Item : pointer ) : pointer;
begin
  Result := Item;
end;


Function TSortedCollection.Search( Key : pointer; var Index : integer ) : Boolean;
var
  L, H, I, C : integer;
begin
  Result := FALSE;
  L      := 0;
  H      := Pred( Count );
  while ( L <= H ) do
  begin
    I := ( L + H ) Shr 1;
    C := Compare( KeyOf( FItems[ I ] ), Key );
    if ( C < 0 ) then
      L := Succ( I )
    else
    begin
      H := Pred( I );
      if ( C = 0 ) then
      begin
        Result := TRUE;
        if not Duplicates then
          L := I;
      end;
    end;
  end;
  Index := L;
end;


end.
