Generische Interface-Liste

[stahli]

Wieso?
Jedes Interface hat doch seine eigne Guid. Deswegen ja gerade die ganzen Ableitungen.

Mein komplexes Projekt kompiliert jetzt auch nach ein paar Anpassungen.
Ich hoffe, dass ich das jetzt nicht nochmal verwerfen muss.

[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.

[stahli]

Danke. Ich fange mal hinten an:

3) Die Getter und Setter benenne ich so, damit sofort auffällt, dass diese nicht per Code aufgerufen werden sollten. (Im Gegensatz zu "GetKontostand").

2) Die Ableitung der ListenInterfaces stammt aus einem anderen Projekt. In einer Liste werden Interfaces verwaltet, die von einem bestimmten Typ sind. Manche können wiederum andere Interfaces verwalten.
Hätte ich hier nicht so machen müssen. Ich hatte das aber in meinem jetzigen Projekt einfach mal übernommen (und so auch in der Demo) und sehe das nicht unbedingt als problematisch an - maximal als unnötig.

1) Supports habe ich nicht ausprobiert.
Das wäre natürlich schon sinnvoll gewesen. Jetzt habe ich kein Delphi verfügbar.
Allerdings ist mir heute früh eingefallen, das Basis-Listeninterface ohne Guid zu deklarieren. Das ist ja eigentlich nur "das Muster" für die Hunde- und Katzenlisten. Davon braucht es keine Instanz zu geben und das Interface wird so auch nicht genutzt.

Wie ist denn sonst die richtige Lösung dafür?

Ich kann zwar mit Ableitungen umgehen und auch mit Interfaces und Generics aber mit allem zusammen wird es schon etwas unübersichtlich.

In meinem früheren Projekt (vor ein paar Jahren) hatte ich die Listeninterfaces noch per C&P definiert und die Item-Interfaces entsprechend ersetzt (IHund -> IKatze -> IMaus).

Jetzt wollte ich das halt auch generisch lösen...

[stahli]

Was mir jetzt noch aufgefallen ist: Ich würde natürlich mit den deklarierten Interfaces arbeiten...

Delphi-Quellcode:

var
  tmpHundList: IHundList;
  tmpKatzeList: IKatzeList;

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

    if Supports(Zoo.HundList, IKatzeList, tmpKatzeList) then
     begin
       Beep; // sollte nie aufgerufen werden
     end;

Ist das denn falsch?
Ich werde mir das heute Abend mal anschauen. Ohne Delphi komme ich da jetzt nicht nach.

Dann noch die Guid bei dem Basis-Listeninterface weg lassen, dann sollte das doch funktionieren...!?

[Stevie]

Man macht auf generische Interfaces einfach kein Supports, mit dem man den generischen Typenparameter ändert, Ende der Geschichte.
Dennoch ist für verschiedene Interne Verwendungszwecke eine GUID ggf notwendig.

[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.