Generic завод

Question

предположим, у меня есть 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> и так далее.

Update Извините, но, может быть, я не ясно, или не понимаю ваш ответ (я еще нуб), но то, что я пытаюсь достичь:

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; 

, но тогда вам не нужен завод больше. Как правило, для выбора конкретного класса, который должен создать завод, можно было бы выбрать селектор другого типа, например целочисленный или строковый идентификатор.

Edit:

Чтобы ответить на ваш комментарий о том, как добавлять новые классы без необходимости изменить завод - я дам вам несколько простых примеров кода, который работает на очень старых версиях Delphi, Delphi 2009 должна upen намного лучшие способы сделать это.

Каждый новый класс потомков должен быть зарегистрирован только на заводе-изготовителе. Один и тот же класс может быть зарегистрирован с использованием нескольких идентификаторов. Код использует идентификатор строки, но целые числа или идентификаторы 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

Вы можете сделать общий завод, как это: Но единственная проблема, вы должны установить общий метод конструкт к нему для каждого конечного класса фабрики, как это:

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.