unit Unit1;
interface
uses
Contnrs,
Classes;
type
IObjectList =
interface
['
{056BC23C-2F12-40DF-A0F7-2A9AE55ADADB}']
function Add( AObject: TObject ): Integer;
function Extract( Item: TObject ): TObject;
function ExtractItem( Item: TObject; Direction: TList.TDirection ): TObject;
function Remove( AObject: TObject ): Integer;
overload;
function RemoveItem( AObject: TObject; ADirection: TList.TDirection ): Integer;
function IndexOf( AObject: TObject ): Integer;
function IndexOfItem( AObject: TObject; ADirection: TList.TDirection ): Integer;
function FindInstanceOf( AClass: TClass; AExact: Boolean = True; AStartAt: Integer = 0 ): Integer;
procedure Insert(
Index: Integer; AObject: TObject );
function First: TObject;
function Last: TObject;
function GetOwnsObjects: Boolean;
procedure SetOwnsObjects(
const Value: Boolean );
property OwnsObjects: Boolean
read GetOwnsObjects
write SetOwnsObjects;
function GetItem(
Index: Integer ): TObject;
procedure SetItem(
Index: Integer; AObject: TObject );
property Items[
Index: Integer]: TObject
read GetItem
write SetItem;
default;
end;
TInterfacedObjectList =
class( TObjectList, IInterface, IObjectList )
private // IInterface
FRefCount: Integer;
function QueryInterface(
const IID: TGUID;
out Obj ): HRESULT;
stdcall;
function _AddRef: Integer;
stdcall;
function _Release: Integer;
stdcall;
private // IObjectList
function GetOwnsObjects: Boolean;
procedure SetOwnsObjects(
const Value: Boolean );
end;
implementation
{ TInterfacedObjectList }
function TInterfacedObjectList.GetOwnsObjects: Boolean;
begin
Result := OwnsObjects;
end;
function TInterfacedObjectList.QueryInterface(
const IID: TGUID;
out Obj ): HRESULT;
begin
if GetInterface( IID, Obj )
then
Result := 0
else
Result := E_NOINTERFACE;
end;
procedure TInterfacedObjectList.SetOwnsObjects(
const Value: Boolean );
begin
OwnsObjects := Value;
end;
function TInterfacedObjectList._AddRef: Integer;
begin
Result := AtomicIncrement( FRefCount );
end;
function TInterfacedObjectList._Release: Integer;
begin
Result := AtomicDecrement( FRefCount );
if Result = 0
then
Destroy;
end;
end.