通用工厂答案

【问题标题】：Generic factory通用工厂
【发布时间】：2009-07-09 12:40:49
【问题描述】：

假设我有一个 TModel：

TModelClass = class of TModel;
TModel = class
  procedure DoSomeStuff;
end;

和 2 个后代：

TModel_A = class(TModel);
TModel_B = class(TModel);

还有一个工厂：

TModelFactory = class
  class function CreateModel_A: TModel_A;
  class function CreateModel_B: TModel_B;
end;

现在我想重构一下：

TModelFactory = class
  class function CreateGenericModel(Model: TModelClass) : TModel
end;

class function TModelFactory.CreateGenericModel(Model: TModelClass) : TModel
begin
  ...
  case Model of
    TModel_A: Result := TModel_A.Create;
    TModel_B: Result := TModel_B.Create;
  end;
  ...
end;

到目前为止还可以，但是每次创建TModel后代，我都要修改工厂case声明。

我的问题：这是否可以为我的所有 TModel 后代创建一个 100% 通用工厂，所以每次我创建 TModel 后代时我都不必修改 TModelFactory ？

我尝试使用Delphi 2009泛型但没有找到有价值的信息，都与TList<T>等的基本用法有关。

更新对不起，但也许我不清楚或不明白你的答案（我仍然是菜鸟），但我想要实现的是：

var
  M: TModel_A;
begin
  M: TModelFactory.CreateGenericModel(MY_CONCRETE_CLASS);

【问题讨论】：

标签： delphi generics delphi-2009 factory

【解决方案1】：

嗯，你可以写

class function TModelFactory.CreateGenericModel(AModelClass: TModelClass): TModel;
begin
  Result := AModelClass.Create;
end;

但是你不再需要工厂了。通常会有一个不同类型的选择器，比如整数或字符串 ID，来选择工厂应该创建的具体类。

编辑：

为了回答您关于如何在不更改工厂的情况下添加新类的评论 - 我将为您提供一些适用于非常旧的 Delphi 版本的简单示例代码，Delphi 2009 应该会提供更好的方法来做到这一点。

每个新的后代类只需要在工厂注册。可以使用多个 ID 注册同一类。该代码使用字符串 ID，但整数或 GUID 也可以。

type
  TModelFactory = class
  public
    class function CreateModelFromID(const AID: string): TModel;
    class function FindModelClassForId(const AID: string): TModelClass;
    class function GetModelClassID(AModelClass: TModelClass): string;
    class procedure RegisterModelClass(const AID: string;
      AModelClass: TModelClass);
  end;

{ TModelFactory }

type
  TModelClassRegistration = record
    ID: string;
    ModelClass: TModelClass;
  end;

var
  RegisteredModelClasses: array of TModelClassRegistration;

class function TModelFactory.CreateModelFromID(const AID: string): TModel;
var
  ModelClass: TModelClass;
begin
  ModelClass :=  FindModelClassForId(AID);
  if ModelClass <> nil then
    Result := ModelClass.Create
  else
    Result := nil;
end;

class function TModelFactory.FindModelClassForId(
  const AID: string): TModelClass;
var
  i, Len: integer;
begin
  Result := nil;
  Len := Length(RegisteredModelClasses);
  for i := 0 to Len - 1 do
    if RegisteredModelClasses[i].ID = AID then begin
      Result := RegisteredModelClasses[i].ModelClass;
      break;
    end;
end;

class function TModelFactory.GetModelClassID(AModelClass: TModelClass): string;
var
  i, Len: integer;
begin
  Result := '';
  Len := Length(RegisteredModelClasses);
  for i := 0 to Len - 1 do
    if RegisteredModelClasses[i].ModelClass = AModelClass then begin
      Result := RegisteredModelClasses[i].ID;
      break;
    end;
end;

class procedure TModelFactory.RegisterModelClass(const AID: string;
  AModelClass: TModelClass);
var
  i, Len: integer;
begin
  Assert(AModelClass <> nil);
  Len := Length(RegisteredModelClasses);
  for i := 0 to Len - 1 do
    if (RegisteredModelClasses[i].ID = AID)
      and (RegisteredModelClasses[i].ModelClass = AModelClass)
    then begin
      Assert(FALSE);
      exit;
    end;
  SetLength(RegisteredModelClasses, Len + 1);
  RegisteredModelClasses[Len].ID := AID;
  RegisteredModelClasses[Len].ModelClass := AModelClass;
end;

【讨论】：

错字？您可能指的是 Model.Create。
感谢您的回答：“选择工厂应该创建的具体类”这正是我想要做的，怎么做？（无需为每个新后代修改工厂）
我在几个项目中使用了这样的模式，其中对象的构造可能会根据接收到的数据而有所不同。 @Fred，只需使用 TModel.ClassName 作为 ID 调用和注册。
使用 TModel.ClassName 是可能的，是的，但如果 ID 用于对象持久性，我不会使用类名，因为稍后类名可能会更改，这可能会使旧的持久化数据无效.那时需要更改映射，所以为什么不从一开始就采用更松散的耦合。
感谢您的回答。我将尝试实施您的解决方案

【解决方案2】：

Result := Model.Create;

应该也可以。

【讨论】：

是的，这是最简单的方法。可能需要基础上的虚拟构造函数（但前提是后代有自己的构造函数代码）。

【解决方案3】：

如果构造函数是虚拟的，则使用 Model.Create 的解决方案有效。

如果你使用 delphi 2009，你可以使用泛型的另一个技巧：

type 
  TMyContainer<T: TModel, constructor> (...)
  protected
    function CreateModel: TModel;
  end;

function TMyContainer<T>.CreateModel: TModel;
begin
  Result := T.Create; // Works only with a constructor constraint.   
end;

【讨论】：

【解决方案4】：

如果我正确理解你的问题，我在这里写了类似的东西http://www.malcolmgroves.com/blog/?p=331

【讨论】：

您好马尔科姆，感谢您的回答。我试图实现您非常优雅的解决方案，但遇到了内存泄漏。我对你博客的帖子发表了评论
谢谢 Fred，是的，这是 TestGetInstance 测试中的错误，而不是工厂本身的错误。我已经修复了下载，所以你现在应该很好了。
@MalcolmGroves 我在我最近的项目中添加了这个通用工厂并在任何地方使用它。它工作得很好，从中学到了很多东西。谢谢马尔科姆！

【解决方案5】：

可能有一种更简单的方法可以实现这一点。我似乎记得找到了处理这个的内置 TClassList 对象，但是这一点我已经有了这个工作。 TClassList 没有办法通过字符串名称查找存储的对象，但它仍然很有用。

基本上，要完成这项工作，您需要使用全局对象注册您的类。这样，它可以为类名输入一个字符串，在列表中查找该名称以找到正确的类对象。

在我的例子中，我使用 TStringList 来保存已注册的类，并使用类名作为类的标识符。为了将类添加到字符串列表的“对象”成员中，我需要将类包装在一个真实的对象中。我承认我并不真正理解“类”，所以如果你把所有东西都投对了，这可能就不需要了。

  // Needed to put "Class" in the Object member of the
  // TStringList class
  TClassWrapper = class(TObject)
  private
    FGuiPluginClass: TAgCustomPluginClass;
  public
    property GuiPluginClass: TAgCustomPluginClass read FGuiPluginClass;
    constructor Create(GuiPluginClass: TAgCustomPluginClass);
  end;

我有一个全局“PluginManager”对象。这是注册和创建类的地方。 “AddClass”方法将类放在 TStringList 中，以便我稍后查找。


procedure TAgPluginManager.AddClass(GuiPluginClass: TAgCustomPluginClass);
begin
  FClassList.AddObject(GuiPluginClass.ClassName,
    TClassWrapper.Create(GuiPluginClass));
end;

在我创建的每个类中，我将其添加到“初始化”部分的类列表中。


initialization;
  AgPluginManager.AddClass(TMyPluginObject);

然后，当需要创建类时，我可以在字符串列表中查找名称，找到类并创建它。在我的实际函数中，我正在检查以确保条目存在并处理错误等。我还将更多数据传递给类构造函数。就我而言，我正在创建表单，因此我实际上并没有将对象返回给调用者（我在我的 PluginManager 中跟踪它们），但如果需要，这很容易做到。


procedure TAgPluginManager.Execute(PluginName: string);
var
  ClassIndex: integer;
  NewPluginWrapper: TClassWrapper;
begin
    ClassIndex := FClassList.IndexOf(PluginName);
    if ClassIndex > -1 then
    begin
      NewPluginWrapper := TClassWrapper(FClassList.Objects[ClassIndex]);
      FActivePlugin := NewPluginWrapper.GuiPluginClass.Create();
    end;
end;

自从我第一次写这篇文章以来，我不需要接触代码。我只是确保将我的新类添加到其初始化部分的列表中，一切正常。

创建一个我只是调用的对象


  PluginManger.Execute('TMyPluginObject');

【讨论】：

【解决方案6】：

你可以像这样做通用工厂：但唯一的问题是你应该为每个工厂最终类设置通用构造方法，如下所示：

type
  TViewFactory = TGenericFactory<Integer, TMyObjectClass, TMyObject>;
...
F := TViewFactory.Create;
F.ConstructMethod :=
  function(AClass: TMyObjectClass; AParams: array of const): TMyObject
  begin
    if AClass = nil then
      Result := nil
    else
      Result := AClass.Create;
  end;

工厂的单位是：

unit uGenericFactory;

interface

uses
  System.SysUtils, System.Generics.Collections;

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;

implementation

uses
  System.Rtti;

{ TGenericFactory<T, C, R> }

function TGenericFactory<T, C, R>.ClassForType(AType: T): C;
begin
  FType2Class.TryGetValue(AType, Result);
end;

function TGenericFactory<T, C, R>.Construct(AType: T; AParams: array of const): R;
begin
  if not Assigned(FConstructMethod) then
    Exit(nil);

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

constructor TGenericFactory<T, C, R>.Create(AConstructor: TGenericFactoryConstructor<C, R> = nil);
begin
  inherited Create;
  FType2Class := TDictionary<T, C>.Create;
  FConstructMethod := AConstructor;
end;

destructor TGenericFactory<T, C, R>.Destroy;
begin
  FType2Class.Free;
  inherited;
end;

procedure TGenericFactory<T, C, R>.RegisterClass(AType: T; AClass: C);
begin
  if FType2Class.ContainsKey(AType) then
    raise EGenericFactoryAlreadyRegistered.Create;
  FType2Class.Add(AType, AClass);
end;

procedure TGenericFactory<T, C, R>.SetConstructMethod(const Value: TGenericFactoryConstructor<C, R>);
begin
  FConstructMethod := Value;
end;

function TGenericFactory<T, C, R>.SupportsClass(AClass: TClass): Boolean;
var
  Key: T;
  Val: C;
begin
  for Key in FType2Class.Keys do
    begin
      Val := FType2Class[Key];
      if CompareMem(@Val, AClass, SizeOf(Pointer)) then
        Exit(True);
    end;

  Result := False;
end;

function TGenericFactory<T, C, R>.TypeForClass(AClass: TClass): T;
var
  Key: T;
  Val: TValue;
begin
  for Key in FType2Class.Keys do
    begin
      Val := TValue.From<C>(FType2Class[Key]);
      if Val.AsClass = AClass then
        Exit(Key);
    end;

  raise EGenericFactoryNotRegistered.Create;
end;

{ EGenericFactory }

constructor EGenericFactory.Create;
begin
  inherited Create(Self.ClassName);
end;

end.

【讨论】：