Это было вызвано ответом Делтика, я хотел привести контрпример, доказывающий, что вы можете использовать дженерики для кормления животных.(т.е.: Полиморфный универсальный список)
Сначала немного предыстории: причина, по которой вы можете кормить родовых животных с помощью базового класса базового списка, заключается в том, что у вас обычно есть такой тип наследования:
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
Это не работает с дженериками, потому что обычно у вас будет это:
TDogList = TList<TDog>
end
TCatList = TList<TCat>
end
... и единственным "общим предком" для обоих списков является TObject
- совсем не полезно.Но мы можем определить новый тип универсального списка, который принимает два аргумента класса: TAnimal
и TSpecificAnimal
, генерируя безопасный для типа список TSpecificAnimal
, совместимый с универсальным списком TAnimal
.Вот базовое определение типа:
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;
Используя это, мы можем сделать:
TAnimal = class;
TDog = class(TAnimal);
TCat = class(TAnimal);
TDogList = TCompatibleList<TAnimal, TDog>;
TCatList = TCompatibleList<TAnimal, TCat>;
Таким образом, TDogList и TCatList фактически наследуются от TObjectList<TAnimal>
, поэтому у нас теперь есть полиморфный универсальный универсальныйlist!
Вот полное консольное приложение, которое демонстрирует эту концепцию в действии.И этот класс теперь входит в мою ClassLibrary для дальнейшего использования!
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.