Instanzen von TClass erzeugen..[gelöst]

Für Fragen zur Programmiersprache auf welcher Lazarus aufbaut
Antworten
Benutzeravatar
corpsman
Lazarusforum e. V.
Beiträge: 1629
Registriert: Sa 28. Feb 2009, 08:54
OS, Lazarus, FPC: Linux Mint Mate, Lazarus GIT Head, FPC 3.0
CPU-Target: 64Bit
Wohnort: Stuttgart
Kontaktdaten:

Instanzen von TClass erzeugen..[gelöst]

Beitrag von corpsman »

Guten morgen allerseits,

Ich Versuche gerade eine Routine zu schreiben, welche Instanzen von Klassen erzeugt, die ich nicht direkt kenne..

Zur besseren Veranschaulichung habe ich das angehängte Programm gebastelt.

In Auszügen :

Code: Alles auswählen

 
Type
 
  { TDummy }
 
  TDummy = Class
  private
    fText: String;
  public
    Constructor create(); virtual;
    Procedure DialOut();
    Function Clone: TDummy;
  End;
 
  { TDummy1 }
 
  TDummy1 = Class(TDummy)
  private
  public
    Constructor create(); override;
  End;
 
  { TDummy2 }
 
  TDummy2 = Class(TDummy)
  private
  public
    Constructor create(); override;
  End;
 
  { TDummy3 }
 
  TDummy3 = Class(TDummy1)
  private
  public
    Constructor create(); override;
  End;     
 
  { TForm1 }
 
  TForm1 = Class(TForm)
  public
    { public declarations }
    Talker: TDummy;
    RegisteredClasses: Array Of TClass;
    RegisteredClasses2: Array Of TDummy;
    Procedure RegisterClass(Class_: TClass; Name_: String);
    Procedure RegisterClass2(Class_: TDummy; Name_: String);
 End;
 
Procedure TForm1.FormCreate(Sender: TObject);
Begin
  ComboBox1.Clear;
  Talker := Nil;
  RegisterClass(TDummy1, 'Dummy1');
  RegisterClass(TDummy2, 'Dummy2');
  RegisterClass(TDummy3, 'Dummy3');
  RegisterClass2(TDummy1.create, 'Dummy1');
  RegisterClass2(TDummy2.create, 'Dummy2');
  RegisterClass2(TDummy3.create, 'Dummy3');
End;
 
Procedure TForm1.Button1Click(Sender: TObject);
Begin
  If ComboBox1.ItemIndex <> -1 Then Begin
    If assigned(Talker) Then Talker.free;
    (*
     * Dieses Case will ich mittels des RegisteredClasses Array's realisieren, geht das ?
     *)
    Case ComboBox1.ItemIndex Of
      0: talker := TDummy1.create();
      1: talker := TDummy2.create();
      2: talker := TDummy3.create();
    End;
    (*
      talker := RegisteredClasses[0].Create As TDummy; // Das hier geht leider nicht
     *)
    talker.DialOut();
  End;
End;
 
Procedure TForm1.Button2Click(Sender: TObject);
Begin
  If ComboBox1.ItemIndex <> -1 Then Begin
    If assigned(Talker) Then Talker.free;
    (*
     * Das Clone geht leider auch nicht, da es ja immer eine Instanz von TDummy erzeugt und nicht von TdummyX
     *)
    Talker := RegisteredClasses2[ComboBox1.ItemIndex].Clone;
    talker.DialOut();
  End;
End;
 
 
Es geht nun darum, dass ich den Talker als Instanz von TDummy1, 2 oder 3 erstellen möchte. Dies soll aber rein über die RegisterClass Routine möglich sein. Sprich in meinen TButton Clicks "Weis" ich nicht mehr welche Klasse es war, durch die Combobox kenne ich lediglich die Position im RegisteredClasses Array.

Die einzige alternative die mir einfällt ist die variante mit der clone routine. Hierzu muss ich aber in jeder Kind Klasse die Clone Routine "Händisch" überschreiben/ neu machen. Wenns irgendwie geht würde ich auf diese Lösung gerne verzichten können.

Kann mir evtl. Jemand von euch helfen ?
Dateianhänge
oop_code.zip
Der komplette source
(2.95 KiB) 65-mal heruntergeladen
Zuletzt geändert von corpsman am Mo 8. Apr 2013, 12:37, insgesamt 1-mal geändert.
--
Just try it

Benutzeravatar
theo
Beiträge: 10899
Registriert: Mo 11. Sep 2006, 19:01

Re: Instanzen von TClass erzeugen..

Beitrag von theo »

Geht's denn nicht so?

Code: Alles auswählen

function TDummy.Clone: TDummy;
begin
 Result:=TDummy(Self.ClassType.Create);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var D:TDummy1;
  Du:TDummy;
begin
 D:=TDummy1.Create;
 Du:=D.Clone;
 Caption:=Du.ClassName;
end;  

Benutzeravatar
corpsman
Lazarusforum e. V.
Beiträge: 1629
Registriert: Sa 28. Feb 2009, 08:54
OS, Lazarus, FPC: Linux Mint Mate, Lazarus GIT Head, FPC 3.0
CPU-Target: 64Bit
Wohnort: Stuttgart
Kontaktdaten:

Re: Instanzen von TClass erzeugen..

Beitrag von corpsman »

Hm..

In der Caption steht der richtige Klassenname.

Die "DialOut" routine liefert allerdings einen Leerstring. Obwohl ich in beiden Constructoren ftext einen Wert zuweise.

So wie es aussieht, Ruft deine Variante das Create von TObject auf und nicht das von TDummy1.

Mit folgendem Code funktionierts zwar, aber den halte ich für gefährlich (zwecks dem theoretisch zweifachen aufruf des Constructors) :

Code: Alles auswählen

 
Procedure TForm1.Button4Click(Sender: TObject);
Var
  D: TDummy1;
  Du: TDummy;
Begin
  D := TDummy1.Create;
  Du := D.Clone;
//  du.create();
  Caption := Du.ClassName;
  du.DialOut();
End; 
 
[Edit]
Zwecks dem Clone Code, müsste ich da nicht schreiben :

Code: Alles auswählen

Function TDummy.Clone: TDummy;
Begin
  //Result := TDummy(Self.ClassType.Create);
  Result := Self.ClassType.Create As TDummy;
  Result.create; // Ist notwendig sonst ists nicht richtig initialisiert.
End;  
Zumindest hat mal jemand im Forum geschrieben, das die Nutzung des "as" operators hier besser sei, als ein einfacher Cast.
--
Just try it

grl
Beiträge: 36
Registriert: Fr 17. Okt 2008, 19:24
OS, Lazarus, FPC: Debian X64, Lazarus 1.1, FPC 2.7.1
CPU-Target: x86, ARM

Re: Instanzen von TClass erzeugen..

Beitrag von grl »

Also, ich würde das so lösen:

Code: Alles auswählen

 
TDummyClass=class of TDummy;
 
...
 
ClassArray=Array of TDummyClass;
 
...
 
//natürlich über RegisterClass oder so - hier extrem verkürzt
ClassArray[0]:=TDummy1;
ClassArray[1]:=TDummy2;
ClassArray[2]:=TDummy3;
 
...
 
Dummy:=ClassArray[Combobox.ItemIndex].Create;
 
 
Nur mal so schnell runtergetippt - das wichtige dabei ist der Typ TDummyClass als class of TDummy. Damit kannst du einen Typen und seine Nachfahren übergeben und musst zum .Create - Zeitpunkt nicht genau wissen, wie die Klasse heisst - sie muss nur ein Nachfahre von TDummy sein.

Gruß
Luggi

Benutzeravatar
theo
Beiträge: 10899
Registriert: Mo 11. Sep 2006, 19:01

Re: Instanzen von TClass erzeugen..

Beitrag von theo »

corpsman hat geschrieben: Zumindest hat mal jemand im Forum geschrieben, das die Nutzung des "as" operators hier besser sei, als ein einfacher Cast.
Was heisst besser? Wenn man weiss was man tut, ist "as" nur langsamer, weil es zusätzlich checkt, ob das Casting möglich ist (gemeinsame Basisklasse).
Das halte ich hier für unnötig.

Benutzeravatar
corpsman
Lazarusforum e. V.
Beiträge: 1629
Registriert: Sa 28. Feb 2009, 08:54
OS, Lazarus, FPC: Linux Mint Mate, Lazarus GIT Head, FPC 3.0
CPU-Target: 64Bit
Wohnort: Stuttgart
Kontaktdaten:

Re: Instanzen von TClass erzeugen..

Beitrag von corpsman »

Wenn man weiss was man tut,
So hatte ich das Damals auch gesehen *g*.

Und was sagst du zum Thema 2 * Constructor aufrufen?
In meinen Tests hier gehts und wenn ich die Beschreibung im Free Pascal 2 Buch richtig deute, dann initialisiert der Constructor lediglich die VMT neu. In meinem Fall wäre das ja genau was ich haben will. Mal abgesehen von der VMT Sache ist der Aufruf des Constructors dann doch ein Aufruf wie der jeder anderen Methode auch?

@grl

Hab deine Variante grad getestet, das funktioniert auch wunderbar, und sieht irgendwie "Sympatischer" aus. Dieses Class of kannte ich so noch nicht.
--
Just try it

Benutzeravatar
theo
Beiträge: 10899
Registriert: Mo 11. Sep 2006, 19:01

Re: Instanzen von TClass erzeugen..

Beitrag von theo »

corpsman hat geschrieben: Und was sagst du zum Thema 2 * Constructor aufrufen?
Hatten wir hier kürzlich: http://www.lazarusforum.de/viewtopic.php?p=60851#p60851

Ich muss zugeben, dass ich etwas verwirrt bin, dass Self.ClassType.Create zwar den Richtigen Typen created aber nicht mit dem dazugehörigen Konstruktor. Hab's jetzt aber nicht wirklich vertieft.

Benutzeravatar
corpsman
Lazarusforum e. V.
Beiträge: 1629
Registriert: Sa 28. Feb 2009, 08:54
OS, Lazarus, FPC: Linux Mint Mate, Lazarus GIT Head, FPC 3.0
CPU-Target: 64Bit
Wohnort: Stuttgart
Kontaktdaten:

Re: Instanzen von TClass erzeugen..[gelöst]

Beitrag von corpsman »

Vielen Dank für die Erklärungen, hab wieder was gelernt, und mein Problem ist nun auch gelöst *g*.
--
Just try it

Antworten