2

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);
4

6 に答える 6

6

さて、あなたは書くことができます

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

しかし、それならもう工場は必要ありません。通常、ファクトリが作成する具体的なクラスを選択するために、整数や文字列IDなどの異なるタイプのセレクターがあります。

編集：

ファクトリを変更せずに新しいクラスを追加する方法についてのコメントに答えるために、非常に古いDelphiバージョンで機能する簡単なサンプルコードをいくつか紹介します。Delphi2009は、これを行うためのはるかに優れた方法を強化する必要があります。

新しい子孫クラスはそれぞれ、ファクトリに登録する必要があるだけです。複数の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-09T12:48:46.227 に答える
5 
Result := Model.Create;

動作するはずです。

于 2009-07-09T12:46:13.700 に答える
5

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;
于 2009-07-09T13:11:52.070 に答える
2

おそらくこれを達成するためのより簡単な方法があります。これを処理する組み込みの 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-09T15:31:34.400 に答える
1

次のようにジェネリック ファクトリを実行できます。

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-20T07:17:47.770 に答える