oobjects.pas

适用于 Delphi 2-7 的Delphi控件

{|----------------------------------------------------------------------
 | Unit:        OObjects
 |
 | Author:      Egbert van Nes
 |
 | Description: Some changed TLists (more compatible with Borland Pascal 7)
 |
 | Copyright (c) 2000  Egbert van Nes
 |   All rights reserved
 |   Disclaimer and licence notes: see license.txt
 |
 |----------------------------------------------------------------------
}
unit OObjects;
interface
uses Classes {$IFDEF CS_TRACE} , CodeSiteLogging {$ENDIF};
const
 MaxCollectionSize = Maxint div (SizeOf(Integer) * 2);
 
type
 TOCollection = class(TList)
 public
  constructor Create(ACapacity: Integer);
  procedure AtFree(Index: Integer);
  procedure FreeAll;
  procedure DoFree(Item: Pointer);
  procedure FreeItem(Item: Pointer); virtual;
  destructor Destroy; override;
 end;
 
 TNoOwnerCollection = class(TOCollection)
 public
  procedure FreeItem(Item: Pointer); override;
 end;
 
 { TSortedCollection object }
 
 TSortedCollection = class(TOCollection)
 public
  Duplicates: Boolean;
  constructor Create(ACapacity: Integer);
  function Compare(Key1, Key2: Pointer): Integer; virtual; abstract;
  function IndexOf(Item: Pointer): Integer; virtual;
  procedure Add(Item: Pointer); virtual;
  procedure AddReplace(Item: Pointer); virtual;
  {if duplicate then replace the duplicate else add}
  function KeyOf(Item: Pointer): Pointer; virtual;
  function Search(Key: Pointer; var Index: Integer): Boolean; virtual;
 end;
 
 { TStrCollection object }
 
 TStrCollection = class(TSortedCollection)
 public
  function Compare(Key1, Key2: Pointer): Integer; override;
  procedure FreeItem(Item: Pointer); override;
 end;
 
implementation

uses SysUtils;

constructor TOCollection.Create(ACapacity: Integer);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Create' );{$ENDIF}
 inherited Create;
 SetCapacity(ACapacity);
 {Delta is automatic in TList}
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Create' );{$ENDIF}
end;

destructor TOCollection.Destroy;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Destroy' );{$ENDIF}
 FreeAll;
 inherited Destroy;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Destroy' );{$ENDIF}
end;

procedure TOCollection.AtFree(Index: Integer);
var
 Item: Pointer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'AtFree' );{$ENDIF}
 Item := Items[Index];
 Delete(Index);
 FreeItem(Item);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'AtFree' );{$ENDIF}
end;

procedure TOCollection.FreeAll;
var
 I: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'FreeAll' );{$ENDIF}
 try
  for I := 0 to Count - 1 do
   FreeItem(Items[I]);
 finally
  Count := 0;
 end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'FreeAll' );{$ENDIF}
end;

procedure TOCollection.DoFree(Item: Pointer);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'DoFree' );{$ENDIF}
 AtFree(IndexOf(Item));
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'DoFree' );{$ENDIF}
end;

procedure TOCollection.FreeItem(Item: Pointer);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'FreeItem' );{$ENDIF}
 if (Item <> nil) then
  with TObject(Item) as TObject do
   Free;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'FreeItem' );{$ENDIF}
end;

{----------------------------------------------------------------virtual;
  Implementing TNoOwnerCollection
  -----------------------------------------------------------------}

procedure TNoOwnerCollection.FreeItem(Item: Pointer);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'FreeItem' );{$ENDIF}
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'FreeItem' );{$ENDIF}
end;

{ TSortedCollection }

constructor TSortedCollection.Create(ACapacity: Integer);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Create' );{$ENDIF}
 inherited Create(ACapacity);
 Duplicates := False;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Create' );{$ENDIF}
end;

function TSortedCollection.IndexOf(Item: Pointer): Integer;
var
 I: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'IndexOf' );{$ENDIF}
 IndexOf := -1;
 if Search(KeyOf(Item), I) then
  begin
   if Duplicates then
    while (I < Count) and (Item <> Items[I]) do
     inc(I);
   if I < Count then IndexOf := I;
  end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'IndexOf' );{$ENDIF}
end;

procedure TSortedCollection.AddReplace(Item: Pointer);
var
 Index: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'AddReplace' );{$ENDIF}
 if Search(KeyOf(Item), Index) then
  Delete(Index);
 Add(Item);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'AddReplace' );{$ENDIF}
end;

procedure TSortedCollection.Add(Item: Pointer);
var
 I: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Add' );{$ENDIF}
 if not Search(KeyOf(Item), I) or Duplicates then
  Insert(I, Item);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Add' );{$ENDIF}
end;

function TSortedCollection.KeyOf(Item: Pointer): Pointer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'KeyOf' );{$ENDIF}
 KeyOf := Item;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'KeyOf' );{$ENDIF}
end;

function TSortedCollection.Search(Key: Pointer; var Index: Integer): Boolean;
var
 L, H, I, C: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Search' );{$ENDIF}
 Search := False;
 L := 0;
 H := Count - 1;
 while L <= H do
  begin
   I := (L + H) shr 1;
   C := Compare(KeyOf(Items[I]), Key);
   if C < 0 then
    L := I + 1
   else
    begin
     H := I - 1;
     if C = 0 then
      begin
       Search := True;
       if not Duplicates then L := I;
      end;
    end;
  end;
 Index := L;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Search' );{$ENDIF}
end;

{ TStrCollection }

function TStrCollection.Compare(Key1, Key2: Pointer): Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Compare' );{$ENDIF}
 Compare := StrComp(Key1, Key2);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Compare' );{$ENDIF}
end;

procedure TStrCollection.FreeItem(Item: Pointer);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'FreeItem' );{$ENDIF}
 StrDispose(Item);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'FreeItem' );{$ENDIF}
end;

end.