Einzelnen Beitrag anzeigen

Benutzerbild von Stevie
Stevie

Registriert seit: 12. Aug 2003
Ort: Soest
4.008 Beiträge
 
Delphi 10.1 Berlin Enterprise
 
#8

AW: generische Liste als Parameter, Vererbung

  Alt 7. Jul 2015, 15:56
Die Kovarianz kommt ins Spiel, sobald ich eine TList<derived> als TList<base> behandeln will um ebend nicht für jeden Typen in der Liste einen Speziellen Event Handler zu haben.
Warum? Weil dann jeder, der mal an dieses Event gehen möchte, einen Event handler für genau diesen Typ in der Liste implementieren muss.

Und nebenbei bemerkt und leicht off topic ist es keine gute Idee, ein Event als anonyme Methode zu implementieren.

Allerdings fehlt atm noch die Information, warum der Event handler die Liste braucht. Was wird damit gemacht?

Hier mal hingeschludert, wie über ein Interface (wie in meinem Blogpost erklärt) ein sicherer Lesezugriff auf eine generische Objectliste realisiert werden kann.

Delphi-Quellcode:
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.
Stefan
“Simplicity, carried to the extreme, becomes elegance.” Jon Franklin

Delphi Sorcery - DSharp - Spring4D - TestInsight

Geändert von Stevie ( 7. Jul 2015 um 18:06 Uhr)
  Mit Zitat antworten Zitat