Using Generic containers in Delphi XE always?

This was prompted by Deltic's answer, I wanted to provide an counter-example proving you can use generics for the animal feeding routine. (ie: Polymorphic Generic List)

First some background: The reason you can feed generic animals using a generic base list class is because you'll usually have this kind of inheritance:

TBaseList = class
  // Some code to actually make this a list
end

TSpecificList = class(TBaseList)
  // Code that reintroduces the Add and GetItem routines to turn TSpecificList
  // into a type-safe list of a different type, compatible with the TBaseList
end

This doesn't work with generics because you'll normally have this:

TDogList = TList<TDog>
end

TCatList = TList<TCat>
end

... and the only "common ancestor" for both lists is TObject - not at all helpful. But we can define a new generic list type that takes two class arguments: a TAnimal and a TSpecificAnimal, generating a type-safe list of TSpecificAnimal compatible with a generic list of TAnimal. Here's the basic type definition:

TCompatibleList<T1:class;T2:class> = class(TObjectList<T1>)
private
  function GetItem(i: Integer): T2;
public
  procedure Add(A:T2);
  property Item[i:Integer]:T2 read GetItem;default;
end;

Using this we can do:

TAnimal = class; 
TDog = class(TAnimal); 
TCat = class(TAnimal);

TDogList = TCompatibleList<TAnimal, TDog>;
TCatList = TCompatibleList<TAnimal, TCat>;

This way both TDogList and TCatList actually inherit from TObjectList<TAnimal>, so we now have a polymorphic generic list!

Here's a complete Console application that shows this concept in action. And that class is now going into my ClassLibrary for future reuse!

program Project23;

{$APPTYPE CONSOLE}

uses
  SysUtils, Generics.Collections;

type

  TAnimal = class
  end;

  TDog = class(TAnimal)
  end;

  TCat = class(TAnimal)
  end;

  TCompatibleList<T1:class;T2:class> = class(TObjectList<T1>)
  private
    function GetItem(i: Integer): T2;
  public
    procedure Add(A:T2);
    property Item[i:Integer]:T2 read GetItem;default;
  end;

{ TX<T1, T2> }

procedure TCompatibleList<T1, T2>.Add(A: T2);
begin
  inherited Add(T1(TObject(A)));
end;

function TCompatibleList<T1, T2>.GetItem(i: Integer): T2;
begin
  Result := T2(TObject(inherited Items[i]));
end;

procedure FeedTheAnimals(L: TObjectList<TAnimal>);
var A: TAnimal;
begin
  for A in L do
    Writeln('Feeding a ' + A.ClassName);
end;

var Dogs: TCompatibleList<TAnimal, TDog>;
    Cats: TCompatibleList<TAnimal, TCat>;
    Mixed: TObjectList<TAnimal>;

begin
  try
    // Feed some dogs
    Dogs := TCompatibleList<TAnimal, TDog>.Create;
    try
      Dogs.Add(TDog.Create);
      FeedTheAnimals(Dogs);
    finally Dogs.Free;
    end;
    // Feed some cats
    Cats := TCompatibleList<TAnimal, TCat>.Create;
    try
      Cats.Add(TCat.Create);
      FeedTheAnimals(Cats);
    finally Cats.Free;
    end;
    // Feed a mixed lot
    Mixed := TObjectList<TAnimal>.Create;
    try
      Mixed.Add(TDog.Create);
      Mixed.Add(TCat.Create);
      FeedTheAnimals(Mixed);
    finally Mixed.Free;
    end;
    Readln;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.
原文地址:https://www.cnblogs.com/MaxWoods/p/1993129.html