Einzelnen Beitrag anzeigen

Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
4.343 Beiträge
 
Delphi 11 Alexandria
 
#19

AW: Generische Interface-Liste

  Alt 27. Jul 2020, 21:24
Aber ich steige hier erst mal besser wieder aus und rede in 1-2 Jahren wieder zu dem Thema mit.
Jetzt sind es glatt 8 Jahre später und ich hatte jetzt mal das gleiche Problem (und bin bei der Lösungssuche auf den Thread hier gestoßen).

Mit meinem Projekt bin ich noch nicht ganz zurecht gekommen und habe mal ein kleines Testprojekt aufgebaut, um hier nochmal konkret nachzufragen.
Damit funktioniert es jedoch korrekt...

Also stelle ich es mal hier ein, falls es jemand nachvollziehen möchte bzw. gebrauchen kann:
(Real sind die Klassen natürlich in verschiedene Klassen aufgeteilt, wird eine Factory benutzt usw.)


Delphi-Quellcode:
program GenInterfacesTest;

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

uses
  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;

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;

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];

end.
Stahli
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)

Geändert von stahli (27. Jul 2020 um 21:56 Uhr) Grund: noch etwas erweitert...
  Mit Zitat antworten Zitat