Question

我有一些具有一些基本功能的泛型类，所有这一切都运行良好，直到我想跳过为简单工厂分配ConstructMethod时，只使用.Create构造对象（没有参数或任何细节）：

type
  EGenericFactory = class(Exception)
  public
    constructor Create; reintroduce;
  end;

  EGenericFactoryNotRegistered = class(EGenericFactory);
  EGenericFactoryAlreadyRegistered = class(EGenericFactory);

  TGenericFactoryConstructor<C: constructor; R: class> = reference to function(AClass: C; AParams: array of const): R;

  TGenericFactory<T; C: constructor; R: class> = class
  protected
    FType2Class: TDictionary<T, C>;
    FConstructMethod: TGenericFactoryConstructor<C, R>;
    procedure SetConstructMethod(const Value: TGenericFactoryConstructor<C, R>);
  public
    constructor Create(AConstructor: TGenericFactoryConstructor<C, R> = nil); reintroduce; overload; virtual;
    destructor Destroy; override;

    procedure RegisterClass(AType: T; AClass: C);
    function ClassForType(AType: T): C;
    function TypeForClass(AClass: TClass): T;
    function SupportsClass(AClass: TClass): Boolean;
    function Construct(AType: T; AParams: array of const): R;
    property ConstructMethod: TGenericFactoryConstructor<C, R> read FConstructMethod write SetConstructMethod;
  end;

然后我想编写默认构造函数，如：

function TGenericFactory<T, C, R>.Construct(AType: T; AParams: array of const): R;
var
  Cls: C;
begin
  Cls := ClassForType(AType);
  if not Assigned(FConstructMethod) then
    with TRttiContext.Create do
      Exit((GetType(Cls) as TRttiInstanceType).MetaclassType.Create);

  Result := FConstructMethod(ClassForType(AType), AParams);
end;

但是...我不能做任何类似TypeInfo（）或TRtiiContext.GetType（）的事情，结果是ClassForType（）函数！我试过其他方法也失败了：

function TGenericFactory<T, C, R>.Construct(AType: T; AParams: array of const): R;
var
  Cls: TValue;
begin
  if not Assigned(FConstructMethod) then
    begin
      Cls := TValue.FromVariant(ClassForType(AType));
      Exit(R((TRttiContext.Create.GetType(Cls.TypeInfo) as TRttiInstanceType).MetaclassType.Create));
    end;

  Result := FConstructMethod(ClassForType(AType), AParams);
end;

有关如何解决此问题的任何想法？现在我只是为ConstructMethod分配执行“复制粘贴”，如：

F := TViewFactory.Create;
F.ConstructMethod :=
  function(AClass: TConfigViewClass; AParams: array of const): TConfigView
  begin
    if AClass = nil then
      Result := nil
    else
      Result := AClass.Create;
  end;

Answer 1

我仍然无法指示编译器将ClassForType函数的结果理解为＆＃34;类的off＆＃34; （课堂参考）而不是＆＃34; class＆＃34; （实例），但我找到了如何至少调用默认构造函数的方法：

function TGenericFactory<T, C, R>.Construct(AType: T; AParams: array of const): R;
var
  ClsRaw: C;
  Cls: TClass;
begin
  if not Assigned(FConstructMethod) then
    begin
      ClsRaw := ClassForType(AType);
      Move(ClsRaw, Cls, SizeOf(C));
      Exit(R(Cls.Create));
    end;

  Result := FConstructMethod(ClassForType(AType), AParams);
end;

所有的魔力是我们只将ClassForType的结果保存到局部变量，然后将内存复制到TClass类型的变量。然后我们通常可以调用Create！

Answer 2

工厂模式（与GoF书中的许多其他模式一样）是一种语言缺失功能的解决方法（在这种情况下，Java中缺少虚拟构造函数）。

这通常在Delphi中完成的方式如下：

使用虚拟构造函数创建祖先类（可以包含参数）。
派生覆盖此构造函数的后代。
创建class of TAncestor TMetaclass。
使用Metaclass创建后代的实例。

完成。

一个例子：

type 
  TParent = class(TObject)
  public
    constructor Create; virtual;  //virtual-> system resolves the actual type at runtime
  end;

  TParentClass = class of TParent; //Meta class

  TChildA = class(TParent)
  public
    constructor Create; override; //Don't forget to call inherited in the body.      
  end;

  TChildB ....

  implementation

  var
    Input: TArray<TParentClass>;
    Output: TArray<TParent>;

  procedure CreateLotsOfObjects(const input: TArray<TParentClass>): TArray<TParent>;
  var
    X: TParentClass;
    i: integer;
  begin
    SetLength(Result, Length(input));
    i:= 0;
    for X in input do begin
      //because the constructor is virtual it will select the right one.
      //no need for a factory pattern or reflection.
      Result[i]:= X.Create; 
      Inc(i); 
    end;
  end;  

  procedure Test;
  begin
    SetLength(input,200);
    for i:= 0 to 199 do begin
      if Odd(i) then Input[i]:= TChildA else Input[i]:= TChildB;
    end; 
    Output:= CreateLotsOfObjects(input); //Creates 100 A's and 100 B's
  end;

泛型类型（XE4 +）中的构造函数约束问题

2 个答案: