program Project1;
{$APPTYPE CONSOLE}
uses
Generics.Collections,
SysUtils;
type
IReadOnlyObjectList =
interface
['
{3DFBDE4F-16A4-4395-AB29-58671BD7EC1E}']
function GetClassType: TClass;
function GetCount: Integer;
function GetItem(
Index: Integer): TObject;
function GetEnumerator: TEnumerator<TObject>;
property ClassType: TClass
read GetClassType;
property Count: Integer
read GetCount;
property Items[
Index: Integer]: TObject
read GetItem;
default;
end;
TListBasis<T:
class> =
class(TObjectList<T>, IReadOnlyObjectList)
private
function GetClassType: TClass;
function GetCount: Integer;
function GetItem(
Index: Integer): TObject;
function GetEnumerator: TEnumerator<TObject>;
protected
function QueryInterface(
const IID: TGUID;
out Obj): HRESULT;
stdcall;
function _AddRef: Integer;
stdcall;
function _Release: Integer;
stdcall;
public
constructor Create;
virtual;
end;
{ TListBasis<T> }
constructor TListBasis<T>.Create;
begin
inherited Create;
end;
function TListBasis<T>.GetClassType: TClass;
begin
Result := T;
end;
function TListBasis<T>.GetCount: Integer;
begin
Result :=
inherited Count;
end;
function TListBasis<T>.GetEnumerator: TEnumerator<TObject>;
begin
Result := TEnumerator<TObject>(
inherited GetEnumerator);
end;
function TListBasis<T>.GetItem(
Index: Integer): TObject;
begin
Result := TObject(
inherited Items[
Index]);
end;
function TListBasis<T>.QueryInterface(
const IID: TGUID;
out Obj): HRESULT;
begin
if GetInterface(IID, obj)
then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TListBasis<T>._AddRef: Integer;
begin
Result := -1;
end;
function TListBasis<T>._Release: Integer;
begin
Result := -1;
end;
type
TOnLoadListEvent =
procedure (Sender: TObject;
const aList: IReadOnlyObjectList)
of object;
TBla =
class
end;
TTest =
class
private
FOnLoadList: TOnLoadListEvent;
FList: TListBasis<TBla>;
procedure LoadListHandler(Sender: TObject;
const aList: IReadOnlyObjectList);
public
constructor Create;
destructor Destroy;
override;
procedure LoadStuff;
end;
{ TTest }
constructor TTest.Create;
begin
inherited Create;
FList := TListBasis<TBla>.Create;
FOnLoadList := LoadListHandler;
end;
destructor TTest.Destroy;
begin
FList.Free;
inherited;
end;
procedure TTest.LoadListHandler(Sender: TObject;
const aList: IReadOnlyObjectList);
var
obj: TObject;
begin
Writeln(aList.Count, '
items of type ', aList.ClassType.ClassName);
end;
procedure TTest.LoadStuff;
begin
FList.AddRange([TBla.Create, TBla.Create, TBla.Create, TBla.Create]);
if Assigned(FOnLoadList)
then
FOnLoadList(Self, FList);
end;
var
test: TTest;
begin
try
test := TTest.Create;
try
test.LoadStuff;
finally
test.Free;
end;
except
on E:
Exception do
Writeln(E.ClassName, '
: ', E.
Message);
end;
Readln;
end.