Delphi 在编译时复制具有未知基类型的通用对象

Question

我想复制通用对象，但它的类型只能在运行时通过“类”构造获得，因为源对象类型可能不同（TItem 或 TSpecificItem 等）：

type
  TItem = class
  //...
    procedure Assign(Source: TItem);virtual; abstract; //edit
  end;

  TSpecificItem = class(TItem)
  //...
  end;

  TEvenMoreSpecificItem = class(TSpecificItem)
  //...
  end;

  TItemClass = class of TItem;

  TItemContainer = class
    FItems: TObjectList<TItem>; //edit
    procedure Assign(Source: TObject); //edit
    function GetItem(Index: Integer): TItem; inline; //edit
    procedure SetItem(Index: Integer; Item: TItem); inline; //edit
    function Count: Integer; //edit;
    function ItemClass: TItemClass; virtual; abstract;
    property Items[Index: Integer]: TItem read GetItem write SetItem; //edit
  end;

  TItemContainer<T: TItem> = class(TItemContainer)
  //...
    function GetItem(Index: Integer): T; inline; //edit
    procedure SetItem(Index: Integer; Item: T); inline; //edit
    function ItemClass: TItemClass; override;
    property Items[Index: Integer]: T read GetItem write SetItem; default; //edit
  end;

//start of edit
function TItemContainer.Count: Integer;
begin
  Result := FItems.Count;
end;

function TItemContainer.GetItem(Index: Integer): TItem;
begin
  Result := FItems[Index];
end;

procedure TItemContainer.SetItem(Index: Integer; Item: TItem);
begin
  FItems[Index].Assign(Item);
end;

procedure TItemContainer.Assign(Source: TObject);
var
  I: Integer;
  Item: TItem;
  Cls: TClass;
begin
  if Source is TItemContainer then
  begin
    FItems.Clear;
    for I := 0 to TItemContainer(Source).Count - 1 do
    begin
      Item := TItemContainer(Source).Items[I];
      Cls := Item.ClassType;
      Item := TItemClass(Cls).Create;
      Item.Assign(TItemContainer(Source).Items[I]);
      FItems.Add(Item);
    end;
  end;
end;

function TItemContainer<T>.GetItem(Index: Integer): T;
begin
  Result := T(inherited GetItem(Index));
end;

procedure TItemContainer<T>.SetItem(Index: Integer; Item: T);
begin
  inherited SetItem(Index, Item);
end;
//end of edit

function TItemContainer<T>.ItemClass: TItemClass;
begin
  Result := TItemClass(GetTypeData(PTypeInfo(TypeInfo(T)))^.ClassType);
end;

function CopyGenericObject(Source: TItemContainer): TItemContainer;
var
  Cls: TItemClass;
begin
  Cls := Source.ItemClass;
  Result := TItemContainer<Cls>.Create; // compiler reports error "incompatible types"
  Result.Assign(Source);
end;

// edit:
procedure DoCopy;
var
  Source: TItemContainer<TEvenMoreSpecificItem>;
  Dest: TItemContainer;
begin
  Source := TItemContainer<TEvenMoreSpecificItem>.Create; // for example
  //add some items to Source
  Dest := CopyGenericObject(Source);
  //use the result somewhere
end;

我必须使用 Delphi XE。

我找到了 http://docwiki.embarcadero.com/RADStudio/XE6/en/Overview_of_Generics

动态实例化

不支持在运行时动态实例化。

这是我想做的吗？

Answer 1

如果我理解得很好，您正在寻找的是实现一个例程，该例程将创建与给定源相同类型的类的实例。可以这样做：

type
  TItemContainerclass = class of TItemContainer;

function CopyGenericObject(Source: TItemContainer): TItemContainer;
begin
  Result := TItemContainerclass(Source.ClassType).Create; 
end;

此外，您可以将 ItemClass 例程简化为

function TItemContainer<T>.ItemClass: TItemClass;
begin
  Result := T;
end;

请注意，这只会创建一个新的 instance 而不是源的 副本，但是由于您的代码没有显示任何复制对象的尝试，并且仅创建一个新实例，我认为这是您的预期结果。

注意：这在 Delphi 10 中有效，我无权访问 XE 来测试它。

Answer 2

线

Cls := Source.ItemClass;

只会在运行时创建TItemClass 实例。对于泛型，编译器需要在编译时知道类型。在不知情的情况下，编译器无法生成实现您特定TItemContainer<Cls> 的二进制代码。或者，换句话说，Cls 不能是变量，它必须是特定的类类型，在编译时就知道了。

例如，这些将编译：

Result := TItemContainer<TSpecificItem>.Create; 

或

Result := TItemContainer<TEvenMoreSpecificItem>.Create; 

但不是这个

Result := TItemContainer</* type will be known later */>.Create; 

因为编译器无法稍后返回并根据Cls的实际类型完成二进制应用程序代码。

Answer 3

您可以将 CopyGenericObject 函数作为通用对象的方法而不是独立函数：

TItemContainer<T: TItem> = class(TItemContainer)
  ...
  function Copy: TItemContainer<T>;
end;

在这种情况下，它在编译时“知道”要创建什么类，因为在编译器完成工作后现在有几个（每个实例化类型一个），每个都复制自己。

还有一个技巧可能对您有用：如何复制各种对象。例如，您有公共类 TAnimal 及其后代：TCat 和 TDog。您将它们存储在 TItemContainer 中，这就是您可以执行并普遍处理它们的全部继承点。现在，您想要实现创建此容器的副本，并且在编译时您不知道哪些元素是狗，哪些是猫。标准方法是在 TAnimal 中定义抽象函数 Copy：

TAnimal = class
  public
    ...
    function Copy: TAnimal; virtual; abstract;
end;

然后在每个后代中实现它，这样你就可以像这样复制你的 TItemContainer：

    function TItemContainer<T>.Copy: TItemContainer<T>;
    var i: T;
    begin
      Result:=TItemContainer<T>.Create;
      for i in Items do 
 //I don't know exact structure of your container,   
 //maybe that's more like
 // for j:=0 to Count-1 do begin
 //   i:=Items[j];
 //but I hope it's obvious what happens here
        Result.Add(i.copy as T);
    end;

所以如果你有猫的容器，那么 i.copy 将返回 TAnimal（但实际上是一只猫），它最终将被转换为 TCat。它有效，但有点难看。

在 delphi 中我想出了更好的解决方案：将 copy 设为构造函数，而不是函数：

TAnimal = class
  public
    ...
    constructor Copy(source: TAnimal); virtual;
end;

在这种情况下复制你的容器是这样的：

function TItemContainer<T>.Copy: TItemContainer<T>;
var i,j: T;
begin
  Result:=TItemContainer<T>.Create;
  for i in Items do
    Result.Add(T.Copy(i));
end;

没有额外的演员阵容，这很好。更重要的是，例如，您可以从 TPersistent 派生您的类并在您需要的任何地方实现分配过程（非常有用的东西），然后一劳永逸地编写一个复制构造函数：

TAnimal = class(TPersistent)
  public
    constructor Copy(source: TPersistent); //or maybe source: TAnimal
end;

//implementation
constructor TAnimal.Copy(source: TPersistent);
begin
  Create;
  Assign(source);
end;