usine générique

Question

suppose que j'ai TModel:

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

et 2 descendants:

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

et une usine:

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

Maintenant, je veux factoriser un peu:

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; 

Jusqu'ici tout va bien, mais chaque fois que je crée un descendant TModel, je dois modifier l'instruction d'usine case.

Ma question: Est-ce possible de créer une usine générique 100% pour tous mes TModel descendants, donc chaque fois que je crée un TModel descendants Je n'ai pas modifier TModelFactory?

J'ai essayé de jouer avec Delphi 2009 génériques, mais n'a pas trouvé de précieuses informations, tous sont liés à l'utilisation de base de TList<T> et ainsi de suite.

Mise à jour Désolé, mais peut-être que je ne suis pas clair ou ne comprends pas votre réponse (je suis encore un noob), mais ce que je suis en train de réaliser est:

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

Answer 1

Si je comprends bien votre question, je l'ai écrit quelque chose de similaire ici http://www.malcolmgroves.com/blog/?p=331

Answer 2

Result := Model.Create; 

devrait aussi fonctionner.

Answer 3

Eh bien, vous pouvez écrire

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

mais vous ne pas besoin de plus d'une usine. Habituellement, on aurait un sélecteur d'un type différent, comme un ID entier ou chaîne, pour sélectionner la classe concrète que l'usine devrait créer.

Edit:

Pour répondre à votre commentaire sur la façon d'ajouter de nouvelles classes sans qu'il soit nécessaire de changer l'usine - code que je vais vous donner quelques exemple simple qui fonctionne pour les très anciennes versions Delphi, Delphi 2009 devrait UPEN de meilleurs moyens de le faire.

Chaque nouvelle classe descendante doit uniquement être enregistrée en usine. La même classe peut être enregistrée en utilisant plusieurs ID. Le code utilise un ID de chaîne, mais les entiers ou les GUID fonctionneraient aussi bien.

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

La solution avec Model.Create fonctionne si le constructeur est virtuel.

Si vous utilisez delphi 2009, vous pouvez utiliser une autre astuce en utilisant les génériques:

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

Il y a probablement un moyen plus simple d'y arriver. Je me souviens d'avoir trouvé l'objet TClassList intégré qui gérait cela, mais que j'avais déjà travaillé sur ce point. TClassList n'a pas un moyen de rechercher les objets stockés par le nom de la chaîne, mais cela pourrait être utile.Fondamentalement, pour faire ce travail, vous devez enregistrer vos classes avec un objet global. De cette façon, il peut prendre une entrée de chaîne pour le nom de classe, recherchez ce nom dans une liste pour trouver l'objet de classe correct.

Dans mon cas, j'ai utilisé une TStringList pour stocker les classes enregistrées et j'utilise le nom de classe comme identifiant pour la classe. Afin d'ajouter la classe au membre "object" de la liste de chaînes j'ai dû envelopper la classe dans un objet réel. J'admettrai que je ne comprends pas vraiment la "classe" donc cela ne sera peut-être pas nécessaire si vous jetez tout bien.

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

J'ai un objet global "PluginManager". C'est ici que les classes sont enregistrées et créées. La méthode "AddClass" place la classe dans la TStringList afin que je puisse la rechercher plus tard.

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

Dans chaque classe que je crée, je l'ajoute à la liste des classes dans la section "initialisation".

initialization; 
    AgPluginManager.AddClass(TMyPluginObject); 

Puis, quand vient le temps de créer la classe je peux rechercher le nom dans la liste de chaînes, trouver la classe et créer. Dans ma fonction actuelle, je vérifie que l'entrée existe et traite les erreurs, etc. Je transmets également plus de données au constructeur de la classe. Dans mon cas, je crée des formulaires, donc je ne retourne pas l'objet à l'appelant (je les retrouve dans mon PluginManager), mais ce serait facile à faire si nécessaire.

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; 

Depuis que j'ai écrit ceci, je n'ai pas besoin de toucher le code. Je m'assure juste d'ajouter mes nouvelles classes à la liste dans leur section d'initialisation et tout fonctionne.

Pour créer un objet que je viens d'appeler

    PluginManger.Execute('TMyPluginObject'); 

Answer 6

Vous pouvez faire usine générique comme ceci: Mais la seule question que vous devez définir la méthode de construction générique pour chacune de la classe finale d'usine comme celui-ci:

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; 

et l'unité de l'usine est:

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.