通用工廠

假設我有一個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聲明。

我的問題：這是可能的，以建立100％的通用工廠爲我所有TModel後代，所以每次我創建一個TModel的後代，我沒有修改TModelFactory？

我試着玩Delphi 2009的泛型，但沒有找到有價值的信息，都與TList<T>等的基本用法有關。

更新很抱歉，但也許我不清楚或不理解你的答案（我還是個小白），但我想要實現的是：

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

來源

2009-07-09 Fred

如果我正確地理解你的問題，我寫到這裏http://www.malcolmgroves.com/blog/?p=331

來源

2009-07-10 00:27:17

Result := Model.Create;

也應該工作。

來源

2009-07-09 12:46:13

是的，這是最簡單的方法。可能需要基礎上的虛擬構造函數（但前提是後代具有自己的構造函數代碼）。 – 2009-07-09 12:48:10

好了，你可以寫

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

但你並不需要一個工廠了。通常會有一個不同類型的選擇器，如整數或字符串ID，以選擇工廠應創建的具體類。

編輯：

爲了回答關於如何添加新的類，而無需改變出廠您的評論 - 我會給你一個很老的德爾福版本的作品一些簡單的示例代碼，德爾福2009年應UPEN提供更好的方法來做到這一點。

每個新的後代類只需要在工廠註冊。可以使用多個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;

來源

2009-07-09 12:48:46 mghie

一個錯字？你可能是指Model.Create。 – 2009-07-09 12:59:50

是的，感謝您發現這一點。 – mghie 2009-07-09 13:02:11

如果構造函數是虛擬的，Model.Create的解決方案將工作。

如果使用德爾福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;

來源

2009-07-09 13:11:52

有可能做到這一點簡單的方法。我似乎記得找到處理這個的內置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');

來源

2009-07-09 15:31:34

類似你可以做一般的工廠是這樣的：但唯一的問題，您應該設置通用構建方法將其針對每個工廠最後一類這樣的：

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.

來源

2014-08-20 07:17:47

回答

相關問題