svn/view/objlist.pas

unit objlist;

{$mode objfpc}{$H+}

interface
uses base;

const
  MaxListSize = Maxint div 16;
type
  PObjectArray = ^TObjectArray;
  TObjectArray = array[0..MaxListSize - 1] of TObject;

  TObjectList = class(TObject)
  private
    FList: PObjectArray;
    FCount: Integer;
    FCapacity: Integer;
    function Get(Index: Integer): TObject;
    procedure Grow;
    procedure Put(Index: Integer; Item: TObject);
    procedure SetCapacity(NewCapacity: Integer);
    procedure SetCount(NewCount: Integer);
    procedure Clear;
    function Expand: TObjectList;
  public
    constructor create(IniSize:integer);
    destructor Destroy; override;
    function Add(Item: TObject): Integer;
    procedure Insert(Index: Integer; Item: TObject);
    procedure Delete(Index: Integer);
    procedure deleteall;
    procedure FreeItem(item:TObject);
    procedure FreeAll;
    property Capacity: Integer read FCapacity write SetCapacity;
    property Count: Integer read FCount write SetCount;
    property Items[Index: Integer]: TObject read Get write Put; default;
    //property List: PObjectArray read FList;
    function KeyOf(item:TObject):AnsiString;virtual; abstract;
    function search(const key:AnsiString; var index:integer):boolean;
  end;


implementation


destructor TObjectList.Destroy;
begin
  FreeAll;
  Clear;
  inherited Destroy;
end;

constructor TObjectList.create(IniSize:integer);
begin
  inherited create;
  setCapacity(IniSize);
end;

function TObjectList.Add(Item: TObject): Integer;
begin
  Result := FCount;
  if Result = FCapacity then Grow;
  FList^[Result] := Item;
  Inc(FCount);
end;

procedure TObjectList.Insert(Index: Integer; Item: TObject);
begin
  if (Index < 0) or (Index > FCount) then exit; //Error(SListIndexError, Index);
  if FCount = FCapacity then Grow;
  if Index < FCount then
    System.Move(FList^[Index], FList^[Index + 1],
      (FCount - Index) * SizeOf(Pointer));
  FList^[Index] := Item;
  Inc(FCount);
end;

procedure TObjectList.Clear;
begin
  SetCount(0);
  SetCapacity(0);
end;

procedure TObjectList.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= FCount) then Exit;
  Dec(FCount);
  if Index < FCount then
    System.Move(FList^[Index + 1], FList^[Index],
      (FCount - Index) * SizeOf(Pointer));
end;

function TObjectList.Expand: TObjectList;
begin
  if FCount = FCapacity then Grow;
  Result := Self;
end;

function TObjectList.Get(Index: Integer): TObject;
begin
 // if (Index < 0) or (Index >= FCount) then Error(SListIndexError, Index);
  Result := FList^[Index];
end;

procedure TObjectList.Grow;
var
  Delta: Integer;
begin
  if Fcapacity >= 16384 then
               Delta:=16384
  else if FCapacity >= 16 then
               Delta := FCapacity
  else  Delta := 4 ;
  SetCapacity(FCapacity + Delta);
end;

procedure TObjectList.Put(Index: Integer; Item: TObject);
begin
  FList^[Index] := Item;
end;

procedure TObjectList.SetCapacity(NewCapacity: Integer);
begin
  if (NewCapacity<FCount) or  (NewCapacity > MaxListSize) then
                                           setexception(5000);
  if NewCapacity mod 4 <>0 then NewCapacity:=(((NewCapacity div 4)+1)*4);
  if NewCapacity <> FCapacity then
  begin
    ReallocMem(FList, NewCapacity * SizeOf(TObject));
    FCapacity := NewCapacity;
  end;
end;

procedure TObjectList.SetCount(NewCount: Integer);
begin
  if NewCount > FCapacity then SetCapacity(NewCount);
  if NewCount > FCount then
    FillChar(FList^[FCount], (NewCount - FCount) * SizeOf(Pointer), 0);
  FCount := NewCount;
end;

procedure TObjectList.deleteAll;
var
   i:integer;
begin
   for i:=count-1 downto 0 do
                Delete(i);
end;

procedure TObjectList.FreeItem(item:TObject);
begin
    Item.Free;
end;

procedure TObjectList.FreeAll;
var
  Temp: TObject;
  i:integer;
begin
   for i:=count-1 downto 0 do
   begin
        Temp := Items[i];
        FreeItem(Temp);               { Delete Item }
        Delete(i);               { Free item from list }
   end;
end;

function TObjectList.search(const key:AnsiString; var index:integer):boolean;
var
   found:boolean;
begin
   index:=0;
   found:=false;
   while (index<count) and not found do
       begin
            if key=KeyOf(items[index]) then
                found:=true
            else
                index:=index+1;
       end;
  search:=found;
end;


begin


end.
