ジェネリック工場

Question

は、私がTModelのがあるとし

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>などです。

更新 申し訳ありませんが、多分私は明確ではないですか（私はまだnoobのだ）、あなたの答えを理解していない、しかし、私は何を達成しようとしていることである：

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

Answer 1

を呼び出すオブジェクトを作成するには、私はあなたがこのような一般的な工場を行うことができ、ここでhttp://www.malcolmgroves.com/blog/?p=331

Answer 2

Result := Model.Create; 

も有効です。

Answer 3

さて、あなたは

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

を書くことができますが、あなたはそれ以上の工場を必要としません。通常は、ファクトリが作成する具体的なクラスを選択するために、整数または文字列IDのような異なる型のセレクタがあります。

編集：

工場を変更することなく、新しいクラスを追加する方法についてのあなたのコメントに答えるために - 私はあなたに非常に古いDelphiのバージョンで動作し、いくつかの単純なサンプルコードを与える、Delphi 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; 

Answer 4

コンストラクタが仮想の場合、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; 

Answer 5

。これを処理する組み込みのTClassListオブジェクトを見つけるのを覚えているようですが、この時点で私はすでにこの作業をしていました。 TClassListには、格納されたオブジェクトを文字列名でルックアップする方法はありませんが、それでも便利な場合があります。

基本的にこの作業を行うには、クラスをグローバルオブジェクトで登録する必要があります。こうすることで、クラス名の文字列入力を受け取り、リスト内のその名前を検索して正しいクラスオブジェクトを見つけることができます。

私の場合は、登録されたクラスを保持するためにTStringListを使用しましたが、そのクラスの識別子としてクラス名を使用します。文字列リストの "object"メンバーにクラスを追加するために、クラスを実際のオブジェクトにラップする必要がありました。私は本当に "クラス"を理解していないことを認めますので、すべてを正しく投げれば必要ないかもしれません。

// 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'); 

Answer 6

似た何かを書いた：しかし、唯一の問題は、あなたが設定する必要がありますこのような工場finalクラスごとに、それまでの一般的な構造方法：

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.