Generische Interface-Liste

[stahli]

Vielen Dank.

Also so passt alles. Hier nochmal für die Nachwelt komplett:

Delphi-Quellcode:

program GenInterfacesTest;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Generics.Collections, WinApi.Windows, SysUtils;

type

  // Base

  IItem = interface
    ['{836A887A-1687-4BC3-8534-18BA517D322D}']
    procedure Go;
  end;

  IItemList<T: IItem> = interface(IItem)
    ['{D231E719-50DE-410A-BF54-CC65487B860A}']
    procedure Add(const aItem: T);
    function GetFirstItem: T;
    function _get_Item(Index: Integer): T;
    procedure _set_Item(Index: Integer; aItem: T);
    property Items[Index: Integer]: T read _get_Item write _set_Item; default;
  end;

  TItem = class(TInterfacedObject, IItem)
    procedure Go;
  end;

  TItemList<T: IItem> = class(TItem, IItemList<T>)
    fItems: TList<IItem>;
    procedure Add(const aItem: T);
    function GetFirstItem: T;
    function _get_Item(Index: Integer): T;
    procedure _set_Item(Index: Integer; aItem: T);
    property Items[Index: Integer]: T read _get_Item write _set_Item; default;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  // Logic

  IZoo = interface;
  TZoo = class;

  IHund = interface;
  THund = class;

  IHundList = interface;
  THundList = class;

  IKatze = interface;
  TKatze = class;

  IKatzeList = interface;
  TKatzeList = class;

  IZoo = interface(IItem)
    ['{428FD0E8-8600-430A-9CE6-AA361509FB54}']
    function _get_HundList: IHundList;
    procedure _set_HundList(const aValue: IHundList);
    property HundList: IHundList read _get_HundList write _set_HundList;
    function _get_KatzeList: IKatzeList;
    procedure _set_KatzeList(const aValue: IKatzeList);
    property KatzeList: IKatzeList read _get_KatzeList write _set_KatzeList;
  end;

  TZoo = class(TItem, IZoo)
    fHundList: IHundList;
    fKatzeList: IKatzeList;
    function _get_HundList: IHundList;
    procedure _set_HundList(const aValue: IHundList);
    property HundList: IHundList read _get_HundList write _set_HundList;
    function _get_KatzeList: IKatzeList;
    procedure _set_KatzeList(const aValue: IKatzeList);
    property KatzeList: IKatzeList read _get_KatzeList write _set_KatzeList;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  IHund = interface(IItem)
    ['{956269E2-F70B-4499-B18B-0492CF47CA5B}']
    procedure Wuff;
  end;

  IHundList = interface(IItemList<IHund>)
    ['{331D5BD0-8568-47B5-886D-417BCDAC23B9}']
  end;

  THund = class(TItem, IHund)
    procedure Wuff;
  end;

  THundList = class(TItemList<IHund>, IHundList)
  end;

  IKatze = interface(IItem)
    ['{1D834E0A-1A69-4D7C-9817-F60EE75C4ACB}']
    procedure Miau;
  end;

  IKatzeList = interface(IItemList<IKatze>)
    ['{EC5E64F4-88D5-4E25-9E4C-50F79F0F9395}']
  end;

  TKatze = class(TItem, IKatze)
    procedure Miau;
  end;

  TKatzeList = class(TItemList<IKatze>, IKatzeList)
  end;

var
  Zoo: IZoo;
  Hund: IHund;
  Katze: IKatze;

  { TItem }

procedure TItem.Go;
begin
  //
end;

{ TItemList<T> }

procedure TItemList<T>.Add(const aItem: T);
begin
  fItems.Add(aItem);
end;

constructor TItemList<T>.Create;
begin
  fItems := TList<IItem>.Create;
end;

destructor TItemList<T>.Destroy;
begin
  fItems.Free;
  inherited;
end;

function TItemList<T>.GetFirstItem: T;
begin
  Result := T(fItems[0]);
end;

function TItemList<T>._get_Item(Index: Integer): T;
begin
  Result := T(fItems[Index]);
end;

procedure TItemList<T>._set_Item(Index: Integer; aItem: T);
begin
  fItems[Index] := aItem;
end;

{ TZoo }

constructor TZoo.Create;
begin
  HundList := THundList.Create;
  KatzeList := TKatzeList.Create;
end;

destructor TZoo.Destroy;
begin
  HundList := nil;
  KatzeList := nil;
  inherited;
end;

function TZoo._get_HundList: IHundList;
begin
  Result := fHundList;
end;

function TZoo._get_KatzeList: IKatzeList;
begin
  Result := fKatzeList;
end;

procedure TZoo._set_HundList(const aValue: IHundList);
begin
  fHundList := aValue;
end;

procedure TZoo._set_KatzeList(const aValue: IKatzeList);
begin
  fKatzeList := aValue;
end;

{ THund }

procedure THund.Wuff;
begin
  //
end;

{ TKatze }

procedure TKatze.Miau;
begin
  //
end;

var
  tmpHundList: IHundList;
  tmpKatzeList: IKatzeList;

begin

  Zoo := TZoo.Create;

  Hund := THund.Create;
  Zoo.HundList.Add(Hund);

  Katze := TKatze.Create;
  Zoo.KatzeList.Add(Katze);

  Hund := Zoo.HundList.GetFirstItem;
  Katze := Zoo.KatzeList.GetFirstItem;

  Zoo.HundList[0] := Hund;
  Hund := Zoo.HundList[0];

  Zoo.KatzeList[0] := Katze;
  Katze := Zoo.KatzeList[0];

  if Supports(Zoo.HundList, IHundList, tmpHundList) then
  begin
    tmpHundList.Add(Hund); // sollte passen
    // tmpHundList.Add(Katze); // korrekter Weise nicht kompilierbar
  end;

  if Supports(Zoo.HundList, IKatzeList, tmpKatzeList) then
  begin
    Beep; // wird korrekter Weise nie aufgerufen
  end;

end.