interface
Type
Tfactory =
Class(TInterfacedObject)
Strict Private
Class Function Getclass(Classname:
String;
Out Index: Tcount;
Out Constr: Pointer): TClass;
Overload;
Static;
Class Var Fclassregister: Iclassregister;
// implementation of ifactory interface
Public
Class Constructor Create;
Reintroduce;
Class Destructor Destroy;
Reintroduce;
// Class Procedure Reg(Cl: TClass; Aconstr: Pointer = Nil); Overload; Virtual;
Class Procedure Reg(Cl: Tclass);
Overload;
Static;
Class Procedure Reg(Classes:
Array Of TClass);
Overload;
Static;
Class Procedure UnReg(Cl: TClass);
Overload;
Static;
Class Procedure UnReg(Classes:
Array Of TClass);
Overload;
Static;
Class Procedure Unregall;
Virtual;
Class Function New<T: Iinterface>(Classname:
String;
Parameters:
Array Of Tvalue; Customconstructorname:
String = '
create')
: T;
Overload;
Class Function New<T: Iinterface>(Classname:
String): T;
Overload;
Class Function IsRegistered(Classname:
String): Boolean;
Virtual;
Class Function Getclass(Classname:
String): TClass;
Overload;
Static;
Class Function GetDecendents(Classname:
String;
Childrenonly: Boolean = True): Tstringlist;
Static;
End;
{
============================================================================
Instantiated factory and interface
============================================================================
}
Ifactory<T: Iinterface> =
Interface
['
{2DA05708-FB1B-426E-8FED-02A46A7F57B7}']
Procedure Reg(Cl: Tclass);
Overload;
Procedure Reg(Classes:
Array Of Tclass);
Overload;
Procedure UnReg(Cl: Tinterfacedclass);
Overload;
Procedure UnReg(Classes:
Array Of Tclass);
Overload;
Function New(Classname:
String; Parameters:
Array Of Tvalue;
Customconstructorname:
String = '
create'): T;
Overload;
Function New(Classname:
String): T;
Overload;
Function IsRegistered(Classname:
String): Boolean;
// Function Getclass(Classname: String): TClass; Overload;
End;
// instantiable Tfactory class
TFactory<T: Iinterface> =
Class(Tfactory, Ifactory<T>)
Private
Procedure Reg(Cl: Tclass);
Overload;
Procedure Reg(Classes:
Array Of Tclass);
Overload;
Procedure UnReg(Cl: Tinterfacedclass);
Overload;
Procedure UnReg(Classes:
Array Of Tclass);
Overload;
Function New(Classname:
String; Parameters:
Array Of Tvalue;
Customconstructorname:
String = '
create'): T;
Overload;
Function New(Classname:
String): T;
Overload;
Function IsRegistered(Classname:
String): Boolean;
End;
{
============================================================================
A sample class to be created
============================================================================
Ihello = Interface
Procedure Hello;
End;
Thelloworld = Class(TInterfacedObject, Ihello)
Procedure Hello;
End;
}
implementation
//Base class and class register
{...}
Class Function Tfactory.New<T>(Classname:
String; Parameters:
Array Of Tvalue;
Customconstructorname:
String = '
create'): T;
Var
Ctx: TRttiContext;
Method: Trttimethod;
Aclass: Tclass;
Atype: Trttitype;
Begin
Result :=
Nil;
Try
Aclass := Getclass(Classname);
Atype := Ctx.GetType(Aclass);
Method := Atype.GetMethod(Customconstructorname);
If Assigned(Method)
Then
Result := Method.Invoke(Aclass, Parameters).AsType<T>;
Except
On E:
Exception Do
Showmessage(Self.Classname + '
: Error constructing <' + Aclass.ClassName
+ '
> - ' + E.
Message + '
.')
End;
End;
{...}
//instantiated
Function TFactory<T>.IsRegistered(Classname:
String): Boolean;
Begin
Result :=
Inherited IsRegistered(Classname);
End;
Function TFactory<T>.New(Classname:
String; Parameters:
Array Of Tvalue;
Customconstructorname:
String): T;
Begin
Result :=
Inherited New<T>(Classname, Parameters, Customconstructorname)
End;
Function TFactory<T>.New(Classname:
String): T;
Begin
Result :=
Inherited New<T>(Classname);
End;
Procedure TFactory<T>.Reg(Cl: Tclass);
Begin
Inherited Reg(Cl);
End;
Procedure TFactory<T>.Reg(Classes:
Array Of Tclass);
Begin
Inherited Reg(Classes);
End;
Procedure TFactory<T>.UnReg(Cl: Tinterfacedclass);
Begin
Inherited UnReg(Cl);
End;
Procedure TFactory<T>.UnReg(Classes:
Array Of Tclass);
Begin
Inherited UnReg(Classes);
End;