Problem mit Klassendesign

[DeddyH]

Wenn Du einen besseren Vorschlag hast, immer her damit.

[jus]

@DeddyH
Vielen Dank für deine Demo!
Mit der Demo wurde mir die konkrete Anwendung für die Factory erst klar, bisher wars eher theoretisch...

Hätte jemand eine Idee wie man das Demo von DeddyH unter Delphi 2007 zum Laufen bekommt, da die noch keine System.Generics.Collections und System.Rtti kennt?

lg,
jus

[Mavarik]

Zitat von DeddyH:

Wenn Du einen besseren Vorschlag hast, immer her damit.

Ich mache es so:

Mit und ohne Parameter:

Delphi-Quellcode:

initialization
  TAnyFactory.Default.RegisterObj<ICanHandleTiere,THund>('Hund');
  TAnyFactory.Default.RegisterObj<ICanHandleTiere,TKatze>('Katze');
  TAnyFactory.Default.RegisterObj<ICanHandleTiere>(Function : TSchwein
    begin
      Result := TSchwein.Create('ImDreck');
    end,'Schwein');

  TAnyFactory.Default.RegisterObj<ICanHandleTiere>(Function : TVogel
    begin
      Result := TVogel.Create(TAppGlobal.Factory.Get<boolean>('Kannfliegen')); // Externer Parameter
    end,'Vogel');
end.


// Andere Unit...

Uses
  MyInterfaces; // Kein Link zur Implementation

var
  Hund,Katze,Schwein,Pinguin : ICanHandleTiere;
begin
  Hund := TAnyFactory.Default.CreateObj<ICanhandleTiere>('Hund');

  TAppGlobal.Factory.SetTo<Boolean>('Kannfliegen',false);
  Pinguin := TAnyFactory.Default.CreateObj<ICanHandleTiere>('Vogel');
  
  // oder - Falls nicht klar ist, ob die Implementation schon enthalten ist

  if TAnyFactory.Default.TryCreateObj<ICanHandleTiere>(Katze,'Katze') then
    Katze.GibLaut;
 
  
  TAnyFactory.Default.CallIfExists<ICanHandleTiere>(Procedure ALöwe : ICanHandleTiere) 
     begin
       ALöwe.GibLaut;
     end,'Löwe');
end;

Nix verlinkt, kein RTTI...

Grüsse

Mavarik

[Stevie]

Zitat von Mavarik:

Zitat von DeddyH:

Wenn Du einen besseren Vorschlag hast, immer her damit.

Ich mache es so:

Gruselig, weil (siehe auch https://youtu.be/RlfLCWKxHJ0?t=8m43s)

[jus]

ok, es scheint so zu sein, dass die TypeInfo nicht so viele Infos in Delphi2007 hergibt. Kann man eigentlich diese Entkopplung mit registerclass auch lösen?

lg,
jus

[jus]

Hallo,

mich fasziniert die Lösung von DeddyH. Da ich in Delphi2007 den Code von DeddyH nicht kompilieren kann, habe ich mal folgendes mit Hilfe von Codeschnipsel aus dem Internet zusammengeschustert:

Delphi-Quellcode:

unit TierIntf;

interface

type
  ITier = interface
    ['{9DC595F6-9026-4C4B-9FAC-5CCC5437C8A5}']
    procedure GibLaut;
  end;

implementation

end.

Delphi-Quellcode:

unit TierFactory;

interface

uses Classes,TierIntf;

type
  TTier = class(TInterfacedPersistent, ITier)
  public
    class function CreateInstance(Name: string): TTier; overload;
    procedure  GibLaut; virtual; abstract;
  end;

implementation

{ TTier }

class function TTier.CreateInstance(Name: string): TTier;
var
  AClass: TPersistentClass;
begin
  Result := nil;
  AClass := GetClass(Name);
  if Assigned(AClass) then
  begin
    Result := AClass.NewInstance as TTier;
    Result.Create;
  end
  else
    { error handle }
end;

end.

Delphi-Quellcode:

unit Hund;

interface

uses Dialogs, Classes, TierFactory;

type
  THund = class(TTier)
  public
    procedure GibLaut; override;
  end;

implementation

{ THund }

procedure THund.GibLaut;
begin
  inherited;
  showmessage('Ich bin ein'+ Classname);
end;

initialization
  RegisterClass(THund);

end.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

uses TierFactory;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Tier: TTier;
begin
  Tier := TTier.CreateInstance('THund');
  if Assigned(Tier) then
  begin
    Tier.GibLaut;
    Tier.Free;
  end;
end;

end.

Meine Frage an die Experten, ist der obige Code noch Factory konform, oder ist es nur irgendwas?

Lg,
jus

[mjustin]

Zitat von jus:

Meine Frage an die Experten, ist der obige Code noch Factory konform, oder ist es nur irgendwas?

Sieht interessant aus - spannend ist zu klären, ob ein Konstruktor aufgerufen würde. Angenommen, THund hat einen parameterlosen Konstruktor. Wird er aufgerufen?

In diesem ähnlichen Code würde der Konstruktor nicht aufgerufen:

Delphi-Quellcode:

type
   TMyClass = class(TObject)
     MyStrings: TStrings;
     constructor Create; virtual;
   end;

constructor TMyClass.Create;
begin
   MyStrings := TStringList.Create;
end;

procedure Test;
var
   Clazz: TClass;
   Instance: TObject;
begin
   Clazz := TMyClass;
   Instance := Clazz.Create;
end;

Dieses negative Resultat kann ich mir auch bei einem THund Konstruktor vorstellen.

[jus]

@mjustin hast recht, in diesem Fall wird es nicht aufgerufen. Ich muß zugeben, dass ich bisher nicht soviel mit Objekten gearbeitet habe. Wenn ich dann absichtlich die TTier Klasse um einen Konstruktor wie folgt erweitere, merke ich, dass dieser abgearbeitet wird. Wäre es dann so in Ordnung?

Delphi-Quellcode:

unit TierFactory;

interface

uses Classes, TierIntf, Dialogs;

type
  TTier = class(TInterfacedPersistent, ITier)
  public
    constructor Create; virtual; abstract; 
    class function CreateInstance(Name: string): TTier; overload;
    procedure  GibLaut; virtual; abstract;
  end;

implementation

{ TTier }

class function TTier.CreateInstance(Name: string): TTier;
var
  AClass: TPersistentClass;
begin
  Result := nil;
  AClass := GetClass(Name);
  if Assigned(AClass) then
  begin
    Result := AClass.NewInstance as TTier;
    Result.Create;
  end
  else
    { error handle }

end;

end.

Delphi-Quellcode:

unit Hund;

interface

uses Dialogs, Classes, TierFactory;

type
  THund = class(TTier)
  public
    constructor Create; override;
    procedure GibLaut; override;
  end;

implementation

{ THund }

constructor THund.Create;
begin
  inherited;

end;

procedure THund.GibLaut;
begin
  inherited;
  showmessage('Ich bin ein '+ Classname);
end;

initialization
  RegisterClass(THund);

finalization
  UnRegisterClass(THund);

end.