Ich habe jetz mal eine kleine Demo für so eine Factory gebaut, vielleicht lichtet das die Verständnisprobleme ein wenig. Stevie kann das zwar mit Sicherheit besser als ich, aber meins funktioniert bislang auch ganz manierlich. Zunächst also das Interface, um das es gehen soll:
Delphi-Quellcode:
unit TierIntf;
interface
type
ITier =
interface
['
{9DC595F6-9026-4C4B-9FAC-5CCC5437C8A5}']
procedure GibLaut;
end;
implementation
end.
Das ist auch das einzige, was alle beteiligten Parteien später kennen werden. Jetzt kommt auch schon der schwierigste Teil, die Factory. Es handelt sich dabei um einen Singleton mit 2 öffentlichen Methoden: Registrierung einer das o.a. Interface implementierenden Klasse für ein String-Kriterium und Rückgabe einer Instanz einer der registrierten Klassen anhand eines String-Kriteriums. Letzteres ist eine recht haarige Angelegenheit, da man möglichst den passenden Konstruktor der jeweiligen Klasse ermitteln muss. Ein einfaches Create ruft nämlich den Konstruktor von TObject auf, der nützt uns herzlich wenig. Ich gehe daher per
RTTI die Methoden der Klasse durch und suche nach dem ersten Konstruktor. Besitzt dieser Parameter, werden diese einfach mit Null-Entsprechungen befüllt, anschließend wird der Konstruktor dann aufgerufen.
Delphi-Quellcode:
unit TierFactory;
interface
uses System.Generics.Collections, System.SysUtils, System.Rtti, TierIntf;
type
EMismatchingClass =
class(
Exception);
TTierFactory =
class abstract
private
class var FCollection: TDictionary<
string, TClass>;
class constructor Create;
class destructor Destroy;
public
class procedure RegisterClassFor(Description:
string;
AClass: TClass);
static;
class function GetRegisteredInstanceFor(Description:
string): ITier;
static;
end;
implementation
{ TTierFactory }
class constructor TTierFactory.Create;
begin
FCollection := TDictionary<
string, TClass>.Create;
end;
class destructor TTierFactory.Destroy;
begin
FCollection.Free;
end;
class function TTierFactory.GetRegisteredInstanceFor
(Description:
string): ITier;
var
TheClass: TClass;
TheInstance: TObject;
Tier: ITier;
ctx: TRttiContext;
AType: TRttiType;
Value: TValue;
TheMethod: TRttiMethod;
ParamList: TList<TValue>;
TheParam: TRttiParameter;
begin
Result :=
nil;
if FCollection.TryGetValue(AnsiLowerCase(Description), TheClass)
then
begin
ctx := TRttiContext.Create;
try
AType := ctx.GetType(TheClass);
for TheMethod
in AType.GetMethods
do
if TheMethod.IsConstructor
then
begin
ParamList := TList<TValue>.Create;
try
for TheParam
in TheMethod.GetParameters
do
begin
TValue.Make(0, TheParam.ParamType.Handle, Value);
ParamList.Add(Value);
end;
TheInstance := TheMethod.Invoke(TheClass,
ParamList.ToArray).AsObject;
Supports(TheInstance, ITier, Tier);
Result := Tier;
finally
ParamList.Free;
end;
break;
end;
finally
ctx.Free;
end;
end;
end;
class procedure TTierFactory.RegisterClassFor(Description:
string;
AClass: TClass);
begin
if not Supports(AClass, ITier)
then
raise EMismatchingClass.CreateFmt
('
Klasse %s implementiert das ITier-Interface nicht', [AClass.ClassName]);
FCollection.AddOrSetValue(AnsiLowerCase(Description), AClass);
end;
end.
Jetzt noch eine Beispielklasse. Diese muss (natürlich) das Interface kennen, das sie implementieren soll, sowie die Factory, an der sie sich registriert. Die Registrierung selbst nehme ich im Initialization-Abschnitt vor, dann genügt das Einbinden der
Unit, um die Klasse bekannt zu machen.
Delphi-Quellcode:
unit Hund;
interface
uses TierIntf, TierFactory;
type
THund =
class(TInterfacedObject, ITier)
public
procedure GibLaut;
end;
implementation
uses Dialogs;
{ THund }
procedure THund.GibLaut;
begin
ShowMessage('
Ich bin ein ' + ClassName);
end;
initialization
TTierFactory.RegisterClassFor('
Hund', THund);
end.
Für weitere Tierarten kann man diese
Unit einfach kopieren und alle Vorkommen von "Hund" einfach durch "Katze", "Vogel", "Fisch" oder sonstwas ersetzen.
Zum Schluss noch das Hauptprogramm. Die MainUnit muss das Interface und die Factory kennen, aber
nicht die zu instanzierenden Klassen. Ich habe einfach ein Edit und einen Button auf das Formular geklatscht.
Delphi-Quellcode:
unit TestMain;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls;
type
TfrmFactoryTest =
class(TForm)
edtTierart: TEdit;
btnInstanz: TButton;
procedure btnInstanzClick(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
frmFactoryTest: TfrmFactoryTest;
implementation
{$R *.dfm}
uses TierFactory, TierIntf;
procedure TfrmFactoryTest.btnInstanzClick(Sender: TObject);
var
Tier: ITier;
begin
Tier := TTierFactory.GetRegisteredInstanceFor(edtTierart.Text);
if Assigned(Tier)
then
Tier.GibLaut
else
ShowMessage(Format('
Keine registrierte Klasse für "%s" gefunden', [edtTierart.Text]));
end;
end.
Das war alles, wer grobe Fehler finden sollte, bitte korrigieren.