Interfaces, Factory- und Singletonpattern

[Ghostwalker]

Guten Morgen :)

Ich versuch mir grad eine Factory zu bauen, die mir verschiedene Dialoge handeln soll. Dazu hab ich mir zuerstmal ein einfaches Interfaces gebaut:

Delphi-Quellcode:

Type
  IVTDialogCall = Interface
    ['{6EB35D36-EE58-43A3-814E-1173DCA9CBCF}']
    function Call(var value:TValue):boolean;
  End;

Dafür dann eine Basis-Klasse die wie folgt aussieht:

Delphi-Quellcode:

  TVTDialogBase = Class(TInterfacedPersistent,IVTDialogCall)
    private
    protected
      //Must be overridend by a descend class
      Procedure BeforeCall(sender:TVTDialogBase;var value:TValue);virtual;
      Procedure AfterCall(sender:TVTDialogBase;var value:TValue;callresult:boolean);virtual;
      function Execute(var value:TValue):boolean;virtual;abstract;
    public
      function Call(var value:TValue):boolean;
    published
  End;

Jeder spezifische Dialog leitet sich von dieser Basisklasse ab:

Delphi-Quellcode:

  TVTColorDialog = Class(TVTDialogBase)
    private
      fdlg : TColorDialog;
    protected
      Procedure BeforeCall(sender:TVTDialogBase;var value:TValue);override;
      procedure AfterCall(sender:TVTDialogBase;var value:TValue;CallResult:boolean);override;
      function Execute(var value:TValue):boolean;override;
    public
    published
  End;

Jede Klasse registriert sich im Initialization abschnitt bei der Factory-Klasse. Soweit tut das ganze.

Delphi-Quellcode:

Class function DialogManager.CallDialog(AName: string; var value: TValue):boolean;
var
  intf : IVTDialogCall;
  dm : TDialogItem;
begin
  result := false;
  if not (fdialogs.ContainsKey(AName)) then exit;
  dm := fdialogs[AName];
  if (dm.Ainst = NIL) then
  begin
    dm.AInst := CreateInstance(dm.AClass);
    fdialogs.AddOrSetValue(Aname,dm);
  end;
  if (dm.AInst <> NIL) then
  begin
    dm.AInst := CreateInstance(dm.AClass);
    fdialogs.AddOrSetValue(Aname,dm);
  end;
  Supports(dm.Ainst,IVTDialogCall,intf);
  if (intf <> NIL) then
    result := intf.Call(value);
end;

Diese Methode der Factory implentiert jetzt den Aufruf des Dialoges. Dabei ruft CreateInstance via RTTI den Constructor der Dialog-Klasse auf. Diese wird gespeichert, um zu vermeiden das die Klasse jedesmal neu erzeugt
werden muss. Nu kracht es allerdings beim Supports mit einer Zugriffsverletzung, was ich so nicht ganz
nachvollziehen kann. Den dm.AInst ist definitiv eine Instanz der Klasse TVTColorDialog (sagt mir der Debugger).

Zusatzinfo:

Das Problem tritt auf, seit ich TVTBaseDialog nicht mehr von TInterfacedObject sonder jetzt von TInterfacedPersistent ableite. Der Grund dafür ist schlicht das ich die Instanzen selbst verwalte und mir die automatische Verwaltung (Referenzzählung usw.) nicht brauche.

Hier noch die Methode CreateInstanz:

Delphi-Quellcode:

var
  ctx : TRttiContext;
  rt  : TRttiType;
  rm  : TRttiMethod;

begin
  ctx := TRttiContext.create;
  rt := ctx.GetType(AClass.ClassInfo);
  for rm in rt.GetDeclaredMethods do
  begin
    if (rm.IsConstructor) then
    begin
      result := rm.Invoke(AClass,[]).AsObject as TInterfacedPersistent;
      break;
    end;
  end;
  ctx.Free;
end;

Kann mir jemand sagen wo das Problem liegt ?

[Der schöne Günther]

Oh Gott, entweder ist es für mich noch zu früh am Morgen, oder das ist schon nicht mehr leicht verständlich.

Ich habe kein Delphi mit Quelltext vor mir, aber nicht dass du den falschen Konstruktor per Rtti erwischt? Hat TInterfacedPersistent wirklich einen parameterlosen Konstruktur (wegen der Owner-Geschichte würde ich tippen dass er einen Konstuktor mit einem optionalen Parameter hat, aber keinen ohne).


PS: In deinem TVDialogBase hätte ich für deine Hook-Methode AfterCall eigentlich erwartet dass "CallResult" ein var-Parameter ist, oder?

PPS: Was ist der Rückgabetyp von deiner letzten Methode?

PPPS: Hast du ein Minimalbeispiel zum selbst ausführen?

[Ghostwalker]

Jap...hat einen Parameterlosen auch lt. Doku.

Callresult ist der Rückgabewert der Execute-Methode und letztlich der Rückgabewert von z.B. TColorDialog.Execute;

Er zeigt lediglich an ob der User mit OK oder Abbruch reagiert hat. :)

Der Rückgabewert von CreateInstanze ist TInterfacedPersistent, also eine Instanz selbiger Klasse.

Delphi-Quellcode:

Class function DialogManager.CreateInstance(AClass:TClass):TInterfacedPersistent;

hat ich wohl beim C&P nicht mit kopiert.

Ich werd mal ein Minimalbeispiel zurechtzimmern :)

[Schokohase]

Du suchst doch nach dem nächsten Konstruktor ohne Parameter, oder?

Wenn deine Klasse aber keine Konstruktor deklariert, dann wirst du in

Delphi-Quellcode:

rt.GetDeclaredMethods

keine Konstruktoren finden.

Wegen mir müsste man sich also durch die Vererbung wühlen und das sähe dann so aus:

Delphi-Quellcode:

function CreateInstance(AClass: TClass): TObject;
var
  ctx: TRttiContext;
  rt : TRttiInstanceType;
  rm : TRttiMethod;
begin
  ctx := TRttiContext.create;
  try
    rt := ctx.GetType(AClass.ClassInfo).AsInstance;

    while Assigned(rt) do
      begin
        for rm in rt.GetDeclaredMethods do
          begin
            if (rm.IsConstructor) and (Length(rm.GetParameters)=0)
            then
              begin
                result := rm.Invoke(AClass, [ ]).AsObject;
                Exit;
              end;
          end;

        rt := rt.BaseType;
      end;

    raise Exception.create('Fehlermeldung');

  finally
    ctx.Free;
  end;
end;

Und statt

Delphi-Quellcode:

  Supports(dm.Ainst,IVTDialogCall,intf);
  if (intf <> NIL) then
    result := intf.Call(value);

könntest du auch

Delphi-Quellcode:

  if Supports(dm.Ainst,IVTDialogCall,intf) then
    result := intf.Call(value);

schreiben (ist nur eine Kleinigkeit)

[Ghostwalker]

So...Minimal Beispiel anbei.

Edit: Hatte das falsche Beispiel drann.

[Mavarik]

Willst Du jedes mal über die RTTI den Constructor suchen?

[Ghostwalker]

Ja, da eine abgeleitet Dialogklasse auch einen eigenen Constructor haben kann.

Das Problem scheint in der Tat das finden des Richtigen Constructors zu sein.

[Ghostwalker]

Arrrggg.

Er hat tatsächlich den falschen Constructor erwischt.

Lösung:

- Basisklasse erhält einen (virtuellen) Constructor
- statt rt.GetDeclaredMethods muss es dann rt.GetMethods heißen, damit auch der "Parent"-Konstruktor gefunden wird


Danke euch für die Mühen :)

[Schokohase]

Zitat:

Zitat von Ghostwalker (Beitrag 1401331)

Er hat tatsächlich den falschen Constructor erwischt.

Nein, er hatte gar keinen erwischt

Änderungen:

Delphi-Quellcode:

Class function DialogManager.CreateInstance(AClass:TClass):TInterfacedPersistent;
var
  ctx : TRttiContext;
  rt  : TRttiInstanceType;
  rm  : TRttiMethod;

begin
  if not AClass.InheritsFrom(TInterfacedPersistent) then
    raise EArgumentException.Create('AClass muss von TInterfacedPersistend abgeleitet sein');

  ctx := TRttiContext.create;
  try
    rt := ctx.GetType(AClass.ClassInfo).AsInstance;
    while Assigned(rt) do
    begin
      for rm in rt.GetMethods do
      begin
        if (rm.IsConstructor) and (Length(rm.GetParameters)=0) then
        begin
          result := rm.Invoke(AClass,[]).AsObject as TInterfacedPersistent;
          Exit;
        end;
      end;
      rt := rt.BaseType;
    end;
    raise Exception.Create('Fehlermeldung');
  finally
    ctx.Free;
  end;
end;

und es läuft.

Verstehen muss man diesen Part, wie?

Delphi-Quellcode:

Class function DialogManager.CallDialog(AName: string; var value: TValue):boolean;
var
  intf : IVTDialogCall;
  dm : TDialogItem;
begin
  ...

  // Wenn es keine Instanz gibt, dann eine erzeugen und eintragen

  if (dm.Ainst = NIL) then
  begin
    dm.AInst := CreateInstance(dm.AClass);
    fdialogs.AddOrSetValue(Aname,dm);
  end;

  // Wenn es eine gibt, dann eine erzeugen und eintragen (wozu?)

  if (dm.AInst <> NIL) then
  begin
    dm.AInst := CreateInstance(dm.AClass);
    fdialogs.AddOrSetValue(Aname,dm);
  end;
  ...
end;

Wenn es keine Instanz gibt, dann eine erzeugen und eintragen, ok.
Wenn es eine gibt, dann eine erzeugen und eintragen :shock:
(wenn es keine Instanz gibt, dann wird der zweite Part auch immer durchlaufen, also eine Instanz wird entweder doppelt oder immer wieder neu erzeugt)

[Ghostwalker]

Wenn ich das so mache, erwischt er TObject....nicht gut.

Die zweite Abfrage war ein Fehler und blödsinn :)