Generische Interface-Liste

[TiGü]

So so, jedes Interface hat seine eigene GUID?

Delphi-Quellcode:

    if Supports(Zoo.KatzeList, IItemList<IHund>, HundeListe) then
    begin
      Writeln('Waumiau');
      HundeListe.Add(Hund);
    end;

    if Supports(Zoo.HundList, IItemList<IKatze>, KatzenListe) then
    begin
      Writeln('Miauwau');
      KatzenListe.Add(Katze);
    end;

Und warum sind die Listen von einem Eintrag abgeleitet?
Kommt dir das nicht schon beim Schreiben komisch vor?
Würdest du auch ein TAutohaus von TAuto ableiten?
Oder ein TAutozug von TAuto?

Über diese merkwürdige Getter- und Setterschreibweise will ich mich gar nicht auslassen.
Dafür haben meine Augen schon zuviel gesehen.

Vollständiges Copy & Paste Beispiel:

Delphi-Quellcode:

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}


uses
  System.SysUtils,
  System.Generics.Collections;

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;

  { 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
  Zoo: IZoo;
  Hund: IHund;
  Katze: IKatze;
  HundeListe: IItemList<IHund>;
  KatzenListe: IItemList<IKatze>;

begin
  try
    Zoo := TZoo.Create;

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

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

    if Supports(Zoo.KatzeList, IItemList<IHund>, HundeListe) then
    begin
      Writeln('Waumiau');
      HundeListe.Add(Hund);
    end;

    if Supports(Zoo.HundList, IItemList<IKatze>, KatzenListe) then
    begin
      Writeln('Miauwau');
      KatzenListe.Add(Katze);
    end;

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

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

    Zoo.KatzeList[0] := Katze;
    Katze := Zoo.KatzeList[0];
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.