Generic factory

Question

Hi all,

suppose I have a TModel:

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

and 2 descendants:

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

and a factory :

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

Now I want to refactor a bit :

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;

So far it's ok, but every time I create a TModel descendant, I have to modify the factory case statement.

My question: Is this possible to create a 100% generic factory for all my TModel descendants, so every time I create a TModel descendants I don't have to modify TModelFactory ?

I tried to play with Delphi 2009 generics but didn't find valuable information, all are related to basic usage of TList<T>and so on.

Update Sorry, but maybe I'm not clear or don't understand your answer (I'm still a noob), but what i'm trying to achieve is :

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

Answer 1

Result := Model.Create;

should work, too.

Answer 2

Well, you could write

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

but then you don't need a factory any more. Usually one would have a selector of a different type, like an integer or string ID, to select the concrete class the factory should create.

Edit:

To answer your comment on how to add new classes without the need to change the factory - I will give you some simple sample code that works for very old Delphi versions, Delphi 2009 should upen up much better ways to do this.

Each new descendant class only needs to be registered with the factory. The same class can be registered using several IDs. The code uses a string ID, but integers or GUIDs would work just as well.

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 3

The solution with Model.Create works if the constructor is virtual.

If you use delphi 2009, you can use another trick using generics:

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 4

There is probably a simpler way to accomplish this. I seem to remember finding the built-in TClassList object that handled this, but that this point I already had this working. TClassList does not have a way to look up the stored objects by the string name, but it could still be useful.

Basically to make this work you need to register your classes with a global object. That way it can take a string input for the class name, lookup that name in a list to find the correct class object.

In my case I used a TStringList to hold the registered classes and I use the class name as the identifier for the class. In order to add the class to the "object" member of the string list I needed to wrap the class in a real object. I'll admit that I don't really understand the "class" so this may not be needed if you cast everything right.

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

I have a global "PluginManager" object. This is where classes get registered and created. The "AddClass" method puts the class in the TStringList so I can look it up later.

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

In each class that I create I add it to the class list in the "initialization" section.

initialization;
  AgPluginManager.AddClass(TMyPluginObject);

Then, when it comes time to create the class I can lookup the name in the string list, find the class and create it. In my actual function I am checking to make sure the entry exists and deal with errors, etc. I am also passing in more data to the class constructor. In my case I am creating forms so I don't actually return the object back to the caller (I track them in my PluginManager), but that would be easy to do if needed.

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;

Since I first wrote this I have not needed to touch the code. I just make sure to add my new classes to the list in their initialization section and everything works.

To create an object I just call

  PluginManger.Execute('TMyPluginObject');

Answer 5

I'm not rated high enough to comment on Mark Elder's post, but I just wanted to add that I think it's Delphi's TPersistent that he was referring to. It does something very similar to what he is doing. Look in Classes at the RegisterClass and FindClass global procedures.

Answer 6

If I understand your question properly, I wrote something similar here http://www.malcolmgroves.com/blog/?p=331