There are two objects: TFoo, TFoo2.
There is also a class reference : TFooClass = class of TFoo;
Both are descendants from TPersistent.
They have their own constructors:
type
TFoo = class(TPersistent)
private
FC:Char;
public
constructor Create; virtual;
published
property C:Char read FC write FC;
end;
TFoo2 = class(TFoo)
public
constructor Create; override;
end;
TFooClass = class of TFoo;
...
constructor TFoo.Create;
begin
inherited Create;
C :=' 1';
end;
constructor TFoo2.Create;
begin
inherited Create;
C := '2';
end;
I want to create a TFoo2 object from a string, which is actually its class name : 'TFoo2'
Here is the procedure, which works fine:
procedure Conjure(AClassName:string);
var
PClass : TPersistentClass;
p :TPersistent;
begin
PClass := TPersistentClass(FindClass(AClassName))
p := TFooClass(PClass).Create; // <-- here is called appropriate constructor
end;
Now, I want to have similar objects like: TBobodo, TBobodo2.
And a class reference of course : TBobodoClass = class of TBobodo;
And so on...
Now, how can I pass a class reference as a parameter into a procedure, in order to secure the right constructor is called?
procedure Conjure(AClassName:string; ACLSREF: ???? ); // <-- something like that
var
PClass : TPersistentClass;
p :TPersistent;
begin
PClass := TPersistentClass(FindClass(AClassName))
p := ACLSREF(PClass).Create; // <-- something like that
end;
Is it possible?
There is no way to do what you want in Delphi 7. The metaclass reference has to be explicit at compile-time at the call site, not handled at runtime.
In Delphi 2009 and later, you may 1 be able to do something with Generics, eg:
1: I have not tried this myself yet.
type
TConjureHelper = class
public
class procedure Conjure<TClassType>(const AClassName: string);
end;
class procedure TConjureHelper.Conjure<TClassType>(const AClassName: string);
var
PClass : TPersistentClass;
p : TPersistent;
begin
PClass := TPersistentClass(FindClass(AClassName));
p := TClassType(PClass).Create;
...
end;
...
TConjureHelper.Conjure<TFooClass>('TFoo2');
TConjureHelper.Conjure<TBobodoClass>('TBobodo2');
...
But Delphi 7 certainly does not support Generics.
I had the same problem and after some struggles, I found a quite simple solution: metaclass is invented exactly for this purpose!
In your case, you can pass the metaclass as parameter and use it directly without the cumbersome finding class and type casting.
type
TFooClass = class of TFoo;
procedure Conjure(aFooClass : TFooClass); // <-- something like that
var
p :TPersistent;
begin
p := aFooClass.Create; // it will work!
end;
and by calling, you simply use:
Conjure(TFoo); // <- for Foo class or
Conjure(TFoo2); // <- for Foo2 class and so on
Related
I want to define three base classes, TMyBaseClass that keeps data, TMyBaseClassList that holds a list of instances of TMyBaseClass, and TMyBaseClassReader that scrolls through a dataset and fills a TMyBaseClassList object. This is my code:
TMyBaseClass = class
public
// properties
constructor Create;
end;
TMyBaseClassList<T: TMyBaseClass, constructor> = class(TObjectList<TMyBaseClass>)
public
function AddNew: T;
end;
TMyBaseClassReader<T: TMyBaseClass> = class
public
class procedure ReadProperties(const DataSet: TCustomADODataSet;
const Item: T); virtual; abstract;
class procedure ReadDataSet(const DataSet: TCustomADODataSet;
const List: TMyBaseClassList<T>);// <- E2513
end;
...
constructor TMyBaseClass.Create;
begin
inherited;
end;
function TMyBaseClassList<T>.AddNew: T;
begin
Result := T.Create;
Add(Result);
end;
class procedure TMyBaseClassReader<T>.ReadDataSet;
var
NewItem: T;
begin
while not DataSet.Eof do
begin
NewItem := List.AddNew;
ReadProperties(DataSet, NewItem);
DataSet.Next;
end;
end;
Then I want to derive child classes and only implement ReadProperties method. But I'm getting an E2513 error:
E2513 Type parameter 'T' must have one public parameterless constructor named Create
What is the problem and how can I fix it?
The error means that the compiler cannot be sure that T meets the requirements. Declare the derived class like so
TMyBaseClassReader<T: TMyBaseClass, constructor>
I have CObject as main class and CRock, CDesk, CComputer as derivates from CObject. I would like to write a function that reads a class enumeration (integer probably like OBJECT_COMPUTER) and returns the specific type.
Example:
function createObject( iType : Integer ) : CObject;
begin
case iType of
OBJECT_ROCK : Result := CRock.Create();
OBJECT_DESK : Result := CDesk.Create();
end;
end;
so I can use it like this: myRock := createObject( OBJECT_ROCK );
Now my problem is that the object returned is the main class parent and I can't use Rock functions on 'myRock' without type casting 'createObject( OBJECT_ROCK )' from CObject to CRock and I don't want to have 3 functions for each sub-class. Any ideas? Thanks in advance.
If I understood correct, you'd declare a skeleton of derived functionality on the base class with abstract methods, then override and implement the method in each derived class.
type
CObject = class
procedure DoIt; virtual; abstract;
end;
CRock = class(CObject)
procedure DoIt; override;
end;
CDesk = class(CObject)
procedure DoIt; override;
end;
var
myRock: CObject;
begin
myRock := createObject(OBJECT_ROCK);
myRock.DoIt;
myRock.Free;
end;
In the above example, 'DoIt' call on the 'myRock' instance would be correctly resolved to the method of that class.
If this is relevant at all read about abstract methods here.
Like the previous example, but rather like this. We call it Inheritance, Polymorphism.
type
TcObject = class
procedure DoIt; virtual; abstract;
end;
TcRock = class(CObject)
procedure DoIt; override;
end;
TcDesk = class(CObject)
procedure DoIt; override;
end;
var
myRock: TcObject;
begin
myRock := TcRock.Create; //Inherits from TcObject and instantiate TcRock class.
myRock.DoIt; //Will automaticall call TcRock.Doit --Polymorphism
myRock.Free;
end;
Using Delphi 2010, let's say I've got a class declared like this:
TMyList = TList<TMyObject>
For this list Delphi kindly provides us with an enumerator, so we can write this:
var L:TMyList;
E:TMyObject;
begin
for E in L do ;
end;
The trouble is, I'd like to write this:
var L:TMyList;
E:TMyObject;
begin
for E in L.GetEnumerator('123') do ;
end;
That is, I want the ability to provide multiple enumerators for the same list, using some criteria. Unfortunately the implementation of for X in Z requires the presence of a function Z.GetEnumerator, with no parameters, that returns the given enumerator! To circumvent this problem I'm defining an interface that implements the "GetEnumerator" function, then I implement a class that implements the interface and finally I write a function on TMyList that returns the interface! And I'm returning an interface because I don't want to be bothered with manually freeing the very simple class... Any way, this requires a LOT of typing. Here's how this would look like:
TMyList = class(TList<TMyObject>)
protected
// Simple enumerator; Gets access to the "root" list
TSimpleEnumerator = class
protected
public
constructor Create(aList:TList<TMyObject>; FilterValue:Integer);
function MoveNext:Boolean; // This is where filtering happens
property Current:TTipElement;
end;
// Interface that will create the TSimpleEnumerator. Want this
// to be an interface so it will free itself.
ISimpleEnumeratorFactory = interface
function GetEnumerator:TSimpleEnumerator;
end;
// Class that implements the ISimpleEnumeratorFactory
TSimpleEnumeratorFactory = class(TInterfacedObject, ISimpleEnumeratorFactory)
function GetEnumerator:TSimpleEnumerator;
end;
public
function FilteredEnum(X:Integer):ISimpleEnumeratorFactory;
end;
Using this I can finally write:
var L:TMyList;
E:TMyObject;
begin
for E in L.FilteredEnum(7) do ;
end;
Do you know a better way of doing this? Maybe Delphi does support a way of calling GetEnumerator with a parameter directly?
Later Edit:
I decided to use Robert Love's idea of implementing the enumerator using anonymous methods and using gabr's "record" factory to save yet an other class. This allows me to create a brand new enumerator, complete with code, using just a few lines of code in a function, no new class declaration required.
Here's how my generic enumerator is declared, in a library unit:
TEnumGenericMoveNext<T> = reference to function: Boolean;
TEnumGenericCurrent<T> = reference to function: T;
TEnumGenericAnonim<T> = class
protected
FEnumGenericMoveNext:TEnumGenericMoveNext<T>;
FEnumGenericCurrent:TEnumGenericCurrent<T>;
function GetCurrent:T;
public
constructor Create(EnumGenericMoveNext:TEnumGenericMoveNext<T>; EnumGenericCurrent:TEnumGenericCurrent<T>);
function MoveNext:Boolean;
property Current:T read GetCurrent;
end;
TGenericAnonEnumFactory<T> = record
public
FEnumGenericMoveNext:TEnumGenericMoveNext<T>;
FEnumGenericCurrent:TEnumGenericCurrent<T>;
constructor Create(EnumGenericMoveNext:TEnumGenericMoveNext<T>; EnumGenericCurrent:TEnumGenericCurrent<T>);
function GetEnumerator:TEnumGenericAnonim<T>;
end;
And here's a way to use it. On any class I can add a function like this (and I'm intentionally creating an enumerator that doesn't use a List<T> to show the power of this concept):
type Form1 = class(TForm)
protected
function Numbers(From, To:Integer):TGenericAnonEnumFactory<Integer>;
end;
// This is all that's needed to implement an enumerator!
function Form1.Numbers(From, To:Integer):TGenericAnonEnumFactory<Integer>;
var Current:Integer;
begin
Current := From - 1;
Result := TGenericAnonEnumFactory<Integer>.Create(
// This is the MoveNext implementation
function :Boolean
begin
Inc(Current);
Result := Current <= To;
end
,
// This is the GetCurrent implementation
function :Integer
begin
Result := Current;
end
);
end;
And here's how I'd use this new enumerator:
procedure Form1.Button1Click(Sender: TObject);
var N:Integer;
begin
for N in Numbers(3,10) do
Memo1.Lines.Add(IntToStr(N));
end;
See DeHL ( http://code.google.com/p/delphilhlplib/ ). You can write code that looks like this:
for E in List.Where(...).Distinct.Reversed.Take(10).Select(...)... etc.
Just like you can do in .NET (no syntax linq of course).
You approach is fine. I don't know of any better way.
Enumerator factory can also be implemented as a record instead of an interface.
Maybe you'll get some ideas here.
Delphi For in loop support requires on of the following: (From the Docs)
Primitive types that the compiler
recognizes, such as arrays, sets or
strings
Types that implement
IEnumerable
Types that implement the
GetEnumerator pattern as documented
in the Delphi Language Guide
If you look at Generics.Collections.pas you will find the implementation for TDictionary<TKey,TValue> where it has three enumerators for TKey, TValue, and TPair<TKey,TValue> types. Embarcadero shows that they have used verbose implementation.
You could do something like this:
unit Generics.AnonEnum;
interface
uses
SysUtils,
Generics.Defaults,
Generics.Collections;
type
TAnonEnumerator<T> = class(TEnumerator<T>)
protected
FGetCurrent : TFunc<TAnonEnumerator<T>,T>;
FMoveNext : TFunc<TAnonEnumerator<T>,Boolean>;
function DoGetCurrent: T; override;
function DoMoveNext: Boolean; override;
public
Constructor Create(aGetCurrent : TFunc<TAnonEnumerator<T>,T>;
aMoveNext : TFunc<TAnonEnumerator<T>,Boolean>);
end;
TAnonEnumerable<T> = class(TEnumerable<T>)
protected
FGetCurrent : TFunc<TAnonEnumerator<T>,T>;
FMoveNext : TFunc<TAnonEnumerator<T>,Boolean>;
function DoGetEnumerator: TEnumerator<T>; override;
public
Constructor Create(aGetCurrent : TFunc<TAnonEnumerator<T>,T>;
aMoveNext : TFunc<TAnonEnumerator<T>,Boolean>);
end;
implementation
{ TEnumerable<T> }
constructor TAnonEnumerable<T>.Create(aGetCurrent: TFunc<TAnonEnumerator<T>, T>;
aMoveNext: TFunc<TAnonEnumerator<T>, Boolean>);
begin
FGetCurrent := aGetCurrent;
FMoveNext := aMoveNext;
end;
function TAnonEnumerable<T>.DoGetEnumerator: TEnumerator<T>;
begin
result := TAnonEnumerator<T>.Create(FGetCurrent,FMoveNext);
end;
{ TAnonEnumerator<T> }
constructor TAnonEnumerator<T>.Create(aGetCurrent: TFunc<TAnonEnumerator<T>, T>;
aMoveNext: TFunc<TAnonEnumerator<T>, Boolean>);
begin
FGetCurrent := aGetCurrent;
FMoveNext := aMoveNext;
end;
function TAnonEnumerator<T>.DoGetCurrent: T;
begin
result := FGetCurrent(self);
end;
function TAnonEnumerator<T>.DoMoveNext: Boolean;
begin
result := FMoveNext(Self);
end;
end.
This would allow you declare your Current and MoveNext methods anonymously.
You can do away with the factory and the interface if you add a GetEnumerator() function to your enumerator, like this:
TFilteredEnum = class
public
constructor Create(AList:TList<TMyObject>; AFilterValue:Integer);
function GetEnumerator: TFilteredEnum;
function MoveNext:Boolean; // This is where filtering happens
property Current: TMyObject;
end;
and just return self:
function TFilteredEnum.GetEnumerator: TSimpleEnumerator;
begin
result := Self;
end;
and Delphi will conveniently clean up your instance for you, just like it does any other enumerator:
var
L: TMyList;
E: TMyObject;
begin
for E in TFilteredEnum.Create(L, 7) do ;
end;
You can then extend your enumerator to use an anonymous method, which you can pass in the constructor:
TFilterFunction = reference to function (AObject: TMyObject): boolean;
TFilteredEnum = class
private
FFilterFunction: TFilterFunction;
public
constructor Create(AList:TList<TMyObject>; AFilterFunction: TFilterFunction);
...
end;
...
function TFilteredEnum.MoveNext: boolean;
begin
if FIndex >= FList.Count then
Exit(False);
inc(FIndex);
while (FIndex < FList.Count) and not FFilterFunction(FList[FIndex]) do
inc(FIndex);
result := FIndex < FList.Count;
end;
call it like this:
var
L:TMyList;
E:TMyObject;
begin
for E in TFilteredEnum.Create(L, function (AObject: TMyObject): boolean
begin
result := AObject.Value = 7;
end;
) do
begin
//do stuff here
end
end;
Then you could even make it a generic, but I wont do that here, my answer is long enough as it is.
N#
I use this approach...where the AProc performs the filter test.
TForEachDataItemProc = reference to procedure ( ADataItem: TDataItem; var AFinished: boolean );
procedure TDataItems.ForEachDataItem(AProc: TForEachDataItemProc);
var
AFinished: Boolean;
ADataItem: TDataItem;
begin
AFinished:= False;
for ADataItem in FItems.Values do
begin
AProc( ADataItem, AFinished );
if AFinished then
Break;
end;
end;
Consider an interface like
IMyInterface = interface
procedure DoSomethingRelevant;
procedure Load (Stream : TStream);
procedure Save (Stream : TStream);
end;
and several classes that implement the interface:
TImplementingClass1 = class (TInterfacedObject, IMyInterface)
...
end;
TImplementingClass2 = class (TInterfacedObject, IMyInterface)
...
end;
...
I have a class that has a list of IMyInterface implementors:
TMainClass = class
strict private
FItems : TList <IMyInterface>;
public
procedure LoadFromFile (const FileName : String);
procedure SaveToFile (const FileName : String);
end;
Now to the question: how can I load the main class and especially the item list in an object-oriented manner? Before I can call the virtual Load method for the items, I have to create them and thus have to know their type. In my current implementation I store the number of items and then for each item
a type identifier (IMyInterface gets an additional GetID function)
call the Save method of the item
But that means that during loading I have to do something like
ID := Reader.ReadInteger;
case ID of
itClass1 : Item := TImplementingClass1.Create;
itClass2 : Item := TImplementingClass2.Create;
...
end;
Item.Load (Stream);
But that doesn't seem to be very object-oriented since I have to fiddle with existing code every time I add a new implementor. Is there a better way to handle this situation?
One solution would be to implement a factory where all classes register themselve with a unique ID.
TCustomClassFactory = class(TObject)
public
procedure Register(AClass: TClass; ID: Integer);
function Create(const ID: Integer): IMyInterface;
end;
TProductionClassFactory = class(TCustomClassFactory)
public
constructor Create; override;
end;
TTestcase1ClassFactory = class(TCustomClassFactory);
public
constructor Create; override;
end;
var
//***** Set to TProductionClassFactory for you production code,
// TTestcaseXFactory for testcases or pass a factory to your loader object.
GlobalClassFactory: TCustomClassFactory;
implementation
constructor TProductionClassFactory.Create;
begin
inherited Create;
Register(TMyImplementingClass1, 1);
Register(TMyImplementingClass2, 2);
end;
constructor TTestcase1ClassFactory.Create;
begin
inherited Create;
Register(TMyImplementingClass1, 1);
Register(TDoesNotImplementIMyInterface, 2);
Register(TDuplicateID, 1);
Register(TGap, 4);
...
end;
Advantages
You can remove the conditional logic from your current load method.
One place to check for duplicate or missing ID's.
You need a class registry, where you store every class reference together with their unique ID. The classes register themselves in the initialization section of their unit.
TImplementingClass1 = class (TInterfacedObject, IMyInterface)
...
end;
TImplementingClass2 = class (TInterfacedObject, IMyInterface)
...
end;
TMainClass = class
public
procedure LoadFromFile (const FileName : String);
procedure SaveToFile (const FileName : String);
end;
Edit: moved the class registry into a separate class:
TMyInterfaceContainer = class
strict private
class var
FItems : TList <IMyInterface>;
FIDs: TList<Integer>;
public
class procedure RegisterClass(TClass, Integer);
class function GetMyInterface(ID: Integer): IMyInterface;
end;
procedure TMainClass.LoadFromFile (const FileName : String);
...
ID := Reader.ReadInteger;
// case ID of
// itClass1 : Item := TImplementingClass1.Create;
// itClass2 : Item := TImplementingClass2.Create;
// ...
// end;
Item := TMyInterfaceContainer.GetMyInterface(ID);
Item.Load (Stream);
...
initialization
TMyInterfaceContainer.RegisterClass(TImplementingClass1, itClass1);
TMyInterfaceContainer.RegisterClass(TImplementingClass2, itClass2);
This should point you into the direction, for a very good introduction into these methods read the famous Martin Fowler article, esp. the section about Interface Injection
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);
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;
Result := Model.Create;
should work, too.
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;
If I understand your question properly, I wrote something similar here http://www.malcolmgroves.com/blog/?p=331
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');
You can do generic factory like this: But the only issue you should set the generic construct method to it for each of the factory final class like this:
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;
and the unit for the factory is:
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.