FormularArray den richtigen Create aufrufen! Wie?

[Mavarik]

Neuer Versuch!

Gegeben sein TForm42,TForm43

Delphi-Quellcode:

type 
   TF : Array[1..2] of TForm;

Um jetzt ein Formular zu erzeugen, fehlt mir aber der Typ (TForm32.Create(Self)). Den bekomme ich doch sicher aus der RTTI oder?

Habe es jetzt umgesetzt mit:

Delphi-Quellcode:

type
  TShowForm = reference to Function(Owner : TComponent):TForm;
var
  F : Array [1..2] of TShowForm;
begin
  F[1] := Function(Owner:TComponent):TForm
            begin
              Result := TForm42.Create(Owner);
            end;
  F[2] := Function(Owner:TComponent):TForm
            begin
              result := TForm43.Create(Owner);
            end;
  F[1](self).Show;
end;

Jemand ne schönere Idee?

Mavarik

[himitsu]

Delphi-Quellcode:

var
  F : Array [1..2] of TFormClass;
begin
  F[1] := TForm42;
  F[2] := TForm43;
  F[1].Create(Self).Show;
end;

So?

Nja, und wie du schon erkannt hasst:
Via TRTTI die Klasse suchen, als TFormClass casten und dann

Delphi-Quellcode:

F.Create(Self).Show;

.

[Sir Rufo]

Delphi-Quellcode:

var
  F : Array [1..2] of TFormClass;
begin
  F[1].Create( Self ).Show;
end;

Und wenn du deine Forms registrierst mit RegisterClass oder RegisterClassAlias dann kannst du dir die über den Namen suchen FindClass

[Jumpy]

Geht das nicht irgendwie in Richtung factory patterns? Quasi eine "Formfactory"?


Edit: Wahrsch. hab ich die Frage nicht verstanden, dann vergesst den ganzen Rest.


Sowas hab ich mit Tips von hier mal für Frames gemacht.

Delphi-Quellcode:

unit uFrameFactory;

interface

uses Projekt,
     fBaseFrame, fLAFrame, fKSTFrame, fSTOFrame,
     Controls, Classes, ADODB;

Type TBaseFrameClass = class of TBaseFrame;

Type TBaseFrameClassRec = record
  Name:String;
  Header:String;
  Klasse:TBaseFrameClass;
  end;

const FrameClassList: Array[0..8{ggf. erhöhen}] of TBaseFrameClassRec =
      (
       (Name: 'LA';   Header: 'Lohnarten'; Klasse: TLAFrame),
       (Name: 'KST'; Header: 'Kostenstellen'; Klasse: TKSTFrame),
       //...
      );

Type
  TFrameFactory = class
    private
      fParent : TWinControl;
      fOwner : TComponent;
      fCon : TADOConnection;
      //...
      function GetClassFromName(FrameName:String):TBaseFrameClass;
      function GetHeaderFromName(FrameName:String):String;
    public
      constructor create(Owner:TWinControl);overload;
      property Owner:TComponent read fOwner;
      property Parent:TWinControl read fParent write fParent;
      property Con:TADOConnection read fCon write fCon;
      function GetFrame(FrameName:String):TBaseFrame;
  end;


implementation

{ TFrameFactory }

constructor TFrameFactory.create(Owner: TWinControl);
begin
  inherited create;
  fOwner:=Owner;
end;

function TFrameFactory.GetClassFromName(FrameName: String): TBaseFrameClass;
var
  i: Integer;
begin
  Result:=nil;
  for i := 0 to High(FrameClassList) do
    if FrameClassList[i].Name = FrameName then
      begin
      Result := FrameClassList[i].Klasse;
      break;
      end;
end;

function TFrameFactory.GetHeaderFromName(FrameName: String): String;
var
  i: Integer;
begin
  Result:='';
  for i := 0 to High(FrameClassList) do
    if FrameClassList[i].Name = FrameName then
      begin
      Result := FrameClassList[i].Header;
      break;
      end;
end;

function TFrameFactory.GetFrame(FrameName: String): TBaseFrame;
var f:TBaseFrame;
begin
  f:=GetClassFromName(FrameName).Create(Owner);
  f.Parent:=Parent;
  f.Align:=alClient;
  f.Con:=Con;
  f.Header:=GetHeaderFromName(FrameName);
  //...
  Result:=f;
end;


end.

[Bummi]

Delphi-Quellcode:

uses unit4,unit5;
{$R *.dfm}


type
  TShowForm = Reference to Function(Owner : TComponent):TForm;
const
  FC: Array [1..2] of TFormClass=(Tform4,Tform5);
var
  F : Array [1..2] of TShowForm;




procedure TForm3.Button1Click(Sender: TObject);
var
 s:TShowForm;
begin
    s := F[2];
    s(self).Show;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
F[1] :=    Function(Owner:TComponent):TForm
              begin
              Result := FC[1].Create(Owner);
              end;
F[2] :=    Function(Owner:TComponent):TForm
              begin
              Result := FC[2].Create(Owner);
              end

end;

[Sir Rufo]

@Jumpy

Warum nicht RegisterClass bzw. RegisterClassAlias und FindClass?

[Medium]

Kann man Konstruktoren nicht ggf. virtuell deklarieren? Das wäre ja quasi ein Paradebeispiel. (Oder sind sie es eventuell sogar schon? Kann's grad nicht selber prüfen.)

Edit: Ansonsten halt über eine virtuelle Init-Methode, die jede Form-Klasse selbst implementiert.

[Sir Rufo]

Zitat:

Zitat von Medium (Beitrag 1245969)

Kann man Konstruktoren nicht ggf. virtuell deklarieren? Das wäre ja quasi ein Paradebeispiel. (Oder sind sie es eventuell sogar schon? Kann's grad nicht selber prüfen.)

Ab TComponent ist der auf jeden Fall

Delphi-Quellcode:

virtual

[Medium]

Dann sollte ein Aufruf des Konstruktors über eine Basisklasse ab TComponent immer den richtigen liefern, wie Sir Rufo es oben schon hingeschrieben hat.

[Mavarik]

SUPER! Danke...

TFormClass kannte ich bisher noch nicht...:stupid:

Hab das bis heute auch noch nie gebraucht...

Danke auf für das FormFactry Beispiel. Soll so was ähnliches werden.

Grüsse Mavarik

[Sir Rufo]

Zitat:

Zitat von Mavarik (Beitrag 1245982)

TFormClass kannte ich bisher noch nicht...:stupid:

Wenn es das nicht geben würde, dann würde es man sich einrichten - was man auch macht, wenn man vererbte Klassen ohne Standard-Konstruktor hat

Delphi-Quellcode:

type
  TFoo = class;

  TFooClass = class of TFoo;

  TFoo = class
    constructor Create( ABar : TBar ); virtual;
    class function CreateFoo( AFooClass : TFooClass; ABar : TBar  ) : TFoo; overload;
    // Registrieren von Nachfahren und erzeugen über den Klassen- oder Alias-Namen
    class procedure RegisterClass( AFooClass : TFooClass ); overload;
    class procedure RegisterClass( const AAlias : string; AFooCLass : TFooClass );
    class function CreateFoo( const AName : string; ABar : TBar ) : TFoo; overload;
  end;

  TSomeFoo = class( TFoo )
  end;

  TConcreteFoo = class( TFoo )
    constructor Create( Bar : TBar ); override;
  end;

class function TFoo.CreateFoo( AFooCLass : TFooClass; ABar : TBar ) : TFoo;
begin
  Result := AFooCLass.Create( ABar );
end;

function CreateFooInstance( AFooClass : TFooClass; ABar : TBar ) : TFoo;
begin
  Result := AFooClass.Create( ABar );
end;

var
  LFoo : TFoo;
  LBar : TBar;

// Erzeugt eine TConcreteFoo-Instanz
LFoo := CreateFooInstance( TConcreteFoo, LBar );
LFoo := TFoo.CreateFoo( TConcreteFoo, LBar );
// Erzeugt eine TSomeFoo-Instanz
LFoo := CreateFooInstance( TSomeFoo, LBar );
LFoo := TFoo.CreateFoo( TSomeFoo, LBar );

[himitsu]

TFormClass selber mußt du nicht unbedingt kennen.

Delphi-Quellcode:

type
  TFormClass = class of TForm;

Das ist ein Typ, in den keine Instantzen des Typs reinkommen (wie bei TForm, wo TForm.Create und Nachkommen rein kommt),
sondern wo Typen reinkommen, welche z.B. davon abgeleitet sind.

Das Wichtigste dabei ist nur, daß die gewünschte Methode (wie z.B. Create) im Basistyp virtual oder dynamic sein muß.

[Jumpy]

Zitat:

Zitat von Sir Rufo (Beitrag 1245968)

@Jumpy
Warum nicht RegisterClass bzw. RegisterClassAlias und FindClass?

Was man nicht kennt, kann man nicht benutzen :oops:

Und weil es bei einem Problem meist schnell gehen muss, nimmt man die erst beste Idee, die man zur Lösung finden kann, auch wenn's bei weiterer Suche oder mehr Erfahrung vllt. einfacheres oder schöneres gegeben hätte.

Hab die Hilfe dazu grad nur mal überflogen und gesehen, dass es das in D6 ja auch schon gibt, muss mir das aber auch nochmal in Ruhe angucken, genau wie das Beispiel in #11, wo mir noch nicht ganz klar ist, was das macht. Sieht aber auf jeden Fall interessant aus.

Zu RegisterClass und FindClass:
Verstehe ich das so, dass ich damit die Konstruktion mit dem Record und dem Array nicht brauchen würde? Aber wo/wie benutzt man dann RegisterClass? Sprich, das muss doch wahrscheinlich für jede Klasse einmal aufgerufen werden, oder? Im Constructor der Factory?

[Sir Rufo]

Zitat:

Zitat von Jumpy (Beitrag 1245998)

Zu RegisterClass und FindClass:
Verstehe ich das so, dass ich damit die Konstruktion mit dem Record und dem Array nicht brauchen würde? Aber wo/wie benutzt man dann RegisterClass? Sprich, das muss doch wahrscheinlich für jede Klasse einmal aufgerufen werden, oder? Im Constructor der Factory?

Das RegisterClass kommt am Besten in den

Delphi-Quellcode:

initialization

Abschnitt, wo diese Klasse auch definiert wurde.

Das FindClass kann dann irgendwo aufgerufen werden.

Dadurch kann man z.B. der MainForm Zugriff auf alle vorhandenen Formular-Klassen ermöglichen ohne die ganzen Formular-Units dort einzubinden.

Ich baue mal ein kleines Beispiel zusammen ... stay tuned

[Jumpy]

Zitat:

Zitat von Sir Rufo (Beitrag 1246001)

Dadurch kann man z.B. der MainForm Zugriff auf alle vorhandenen Formular-Klassen ermöglichen ohne die ganzen Formular-Units dort einzubinden.

Irgendwas entgeht mir hier, denn wenn ich die nicht irgendwo einbinde, wird doch initialization nie durchlaufen?

Zitat:

Zitat von Sir Rufo (Beitrag 1246001)

Ich baue mal ein kleines Beispiel zusammen ... stay tuned

Da hab ich heut Abend ja einen Grund nochmal hier reinzugucken.

[Sir Rufo]

Zitat:

Zitat von Jumpy (Beitrag 1246005)

Zitat:

Zitat von Sir Rufo (Beitrag 1246001)

Dadurch kann man z.B. der MainForm Zugriff auf alle vorhandenen Formular-Klassen ermöglichen ohne die ganzen Formular-Units dort einzubinden.

Irgendwas entgeht mir hier, denn wenn ich die nicht irgendwo einbinde, wird doch initialization nie durchlaufen?

Formulare müssen eh irgendwo im Projekt (

Delphi-Quellcode:

.dpr

) eingebunden sein, aber wenn die Klassen registriert sind, dann brauchen diese Units nirgendwo anders mit eingebunden werden.

Zitat:

Zitat von Jumpy (Beitrag 1246005)

Zitat:

Zitat von Sir Rufo (Beitrag 1246001)

Ich baue mal ein kleines Beispiel zusammen ... stay tuned

Da hab ich heut Abend ja einen Grund nochmal hier reinzugucken.

Jo, fertig ...

Hier der Code der MainForm

Delphi-Quellcode:

unit FormMain;

interface

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

type
  TMainForm = class( TForm )
    FormNames_ListBox : TListBox;
    Form_Panel : TPanel;
    procedure FormNames_ListBoxClick( Sender : TObject );
  private
    FForm : TForm;
    procedure CreateFormFromName( const FormName : string; Parent : TWinControl );
  public
    { Public-Deklarationen }
  end;

var
  MainForm : TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.CreateFormFromName( const FormName : string; Parent : TWinControl );
var
  LClass : TPersistentClass;
begin
  if Assigned( FForm ) then
  begin
    FForm.Release;
    FForm := nil;
  end;

  // Wirft eine Exception, wenn die Klasse nicht gefunden wird
  // LClass := FindClass( FormName );

  // Liefert einfach nur nil, wenn die Klasse nicht gefunden wird
  LClass := GetClass( FormName );
  if Assigned( LClass ) and LClass.InheritsFrom( TForm ) then
  begin
    // Form-Instanz erzeugen
    FForm := TFormClass( LClass ).Create( Self );
    // Ein bisschen Zucker drüber
    FForm.Parent := Parent;
    FForm.BorderStyle := bsNone;
    FForm.Align := alClient;
    // fertig
    FForm.Show;
  end;
end;

procedure TMainForm.FormNames_ListBoxClick( Sender : TObject );
begin
  CreateFormFromName( ( Sender as TListBox ).Items[( Sender as TListBox ).ItemIndex], Form_Panel );
end;

initialization

// In der Regel eigentlich nicht, aber hier ist es lustig :o)
RegisterClass( TMainForm );

end.

[himitsu]

Zitat:

Zitat von Sir Rufo (Beitrag 1246010)

Formulare müssen eh irgendwo im Projekt (

Delphi-Quellcode:

.dpr

) eingebunden sein, aber wenn die Klassen registriert sind, dann brauchen diese Units nirgendwo anders mit eingebunden werden.

Da sind wir auch schon drauf reingefallen.

Eine Unit war in der DPR für eine BPL eingebunden, aber da diese Unit sonst in keiner anderen Unit aufgerufen wurde und auch nichts "direkt" aus der Unit verwendet wurde...
Es sollte da auch nur etwas registriert werden.
- In einer EXE einkompilert funktioniert es.
- In einer BPL einkompiliert wurde diese Unit nicht initialisiert. Das passerte erst, nachdem die Unit explizit in einer anderen Unit eingebunden wurde.

[Sir Rufo]

Zitat:

Zitat von himitsu (Beitrag 1246011)

Zitat:

Zitat von Sir Rufo (Beitrag 1246010)

Formulare müssen eh irgendwo im Projekt (

Delphi-Quellcode:

.dpr

) eingebunden sein, aber wenn die Klassen registriert sind, dann brauchen diese Units nirgendwo anders mit eingebunden werden.

Da sind wir auch schon drauf reingefallen.

Eine Unit war in der DPR für eine BPL eingebunden, aber da diese Unit sonst in keiner anderen Unit aufgerufen wurde und auch nichts "direkt" aus der Unit verwendet wurde...
Es sollte da auch nur etwas registriert werden.
- In einer EXE einkompilert funktioniert es.
- In einer BPL einkompiliert wurde diese Unit nicht initialisiert. Das passerte erst, nachdem die Unit explizit in einer anderen Unit eingebunden wurde.

Wer will schon mit BPLs arbeiten :mrgreen:

[Jumpy]

Danke.

Kriegs in D6 kompiliert und gestartet, muss aber in den initialization Abschnitten jeweils eines der RegisterClassAlias auskommentieren sonst bekomme ich einen Laufzeitfehler. Siehe Bild. Woran könnte das liegen?

Da ich auch ReportMemoryLeaksOnShutdown := True; auskommentieren musste:
Wenn ich X mal hintereinander so das MainForm erzeuge und dann das vorderste wieder wechsele, werden dann die restlichen alle gelöscht (owner ist ja jeweils angegeben)?

[himitsu]

Es kann nur einen geben.
Es darf immer nur eine Klasse, mit dem selben Namen, zur gleichen Zeit registriert sein.

Nochmal was Gleichnamiges registrieren knallt demnach.

[Sir Rufo]

Bei Delphi6 wird wohl bei

Delphi-Quellcode:

RegisterClassAlias

der Alias und der Klassenname registriert.

Das machen neuere Delphis nicht mehr. Müsstest du aber im Code (

Delphi-Quellcode:

RegisterClassAlias

) nachschauen können.

Ja, die Forms werden ja mit einem Owner erzeugt, und selbst wenn nicht, es wird ja ein Parent angegeben und der würde auch dafür sorgen, dass die Instanz aufgeräumt wird ;)

[himitsu]

Es wird nur über den Owner (Besitzer) freigegeben ... der Parent ist nur für die Darstellung.

Application.CreateForm setzt aber überall den Owner auf die Application, also löscht Application das dann, wenn die Anwendung beendet wird.

[Sir Rufo]

Zitat:

Zitat von himitsu (Beitrag 1246020)

Es wird nur über den Owner (Besitzer) freigegeben ... der Parent ist nur für die Darstellung.

Application.CreateForm setzt aber überall den Owner auf die Application, also löscht Application das dann, wenn die Anwendung beendet wird.

Delphi-Quellcode:

LForm := TForm.Create( nil );
LForm.Parent := Panel1;
Panel1.Release;

Und schwupps ist auch die LForm-Instanz futsch ;)

[himitsu]

Ist das ein Sonderfall bei den TCustomForms
oder werden alle TWinControl-Instanzen bei Sowas freigegeben? :shock:


OK, wenn das ARC mir nun Objekte unterm Arsch wegklaut, warum dann nicht auch die VCL.


[edit]
Ich dachte bisher eigentlich immer nur, daß bei .Parent nur die Anordnung gilt, das aber nicht für die Freigabe genutzt wird.
Jedenfalls gibt die VCL da selber nirgendwo etwas frei.

Aber wenn ich grade nochmal drüber nachdenke ... joaar, in der WinAPI hängen die nur via Parent zusammen, womöglich wird das dann über WM_DESTROY gelöscht.
Obwohl ich da eigentlich eher davon ausgegangen, daß dann nur Handle (HWND) gelöscht wird, aber die Objektinstanz noch da bleibt.

[Jumpy]

Zitat:

Zitat von Sir Rufo (Beitrag 1246018)

Bei Delphi6 wird wohl bei

Delphi-Quellcode:

RegisterClassAlias

der Alias und der Klassenname registriert.

Jo, scheint so zu sein. Hab mich auf TRegGroup.RegisterClassAlias runtergehangelt und da wird RegisterClass aufgerufen und ein FAliasList.AddObject. Da fehlt die Prüfung, ob die Klasse schonmal regisriert ist.

Damit wird RegisterClassAlias aber doch sinnfrei? Oder?

Edit: Ach neh. Ich kann es ja so wenigstens 1x mit einem beliebeigen Alias registrieren und muss nicht den Default Classname wie bei RegisterClass nehmen.

[Sir Rufo]

Zitat:

Zitat von himitsu (Beitrag 1246023)

Ist das ein Sonderfall bei den TCustomForms
oder werden alle TWinControl-Instanzen bei Sowas freigegeben? :shock:


OK, wenn das ARC mir nun Objekte unterm Arsch wegklaut, warum dann nicht auch die VCL.

Das ist gefühlt schon immer so gewesen bei TControl
Steht auch so in der Doku zu TControl.Parent

[himitsu]

Zitat:

Zitat von Sir Rufo (Beitrag 1246025)

Das ist gefühlt schon immer so gewesen bei TControl

Hatte meine Antwort nochmal überdacht und etwas erweitert.

Innerhalb der VCL gibt es da ja keine Probleme, da sich dort die Referenzen bei Parent, Owner, Controls und Components selber aufräumen.

Hmmm, dann dürfte das ja nun im ARC "richtig" funktionieren?
Solange noch eine externe Referenz existiert, düfte dann das Objekt eigentlich nicht mehr entsorgt werden. :gruebel:

Bei deinem Code würde LForm am Ende ja eine ungültige Referenz enthalten.
(OK, nicht sofort, da Release ja verzögert löscht)

[Sir Rufo]

Ähm, das war doch nur kurz und knapp als Beispiel.

Diesen Code wirst du bei mir aktiv niemals finden, denn wer sägt sich schon den Ast ab auf den er gerade geklettert ist ;)

BTW ein try..finally fehlt auch in dem Code ... :mrgreen:

[Mavarik]

OK Nochmal!

Eine Frage aus der Kategorie noch keinen Kaffee, wo liegt mein Denkfehler?

Delphi-Quellcode:

type
    TVater = Class(TForm)
      public
        Procedure SetFoo(A:TComponent);Virtual,Abstract;
    end;

    TMyForm = class(TVater)
      public
        Procedure SetFoo(A:TComponent);
   end;

   FC : Class of TForm;

var
  AktForm : TVater;

begin
  FC := GetForm('FormName'); // holt die Registriere Formclass TMyForm... (Source verkürzt)
  AktForm := TVater(FC.Create(Self)); // Blödes Typecast?!

  AktForm.SetFoo(Self); // <- Abstracter Fehler
end;

Stehe gerade auf dem schlauch..

Mavarik

[Sir Rufo]

Du hast

Delphi-Quellcode:

override

vergessen ;)

BTW

Delphi-Quellcode:

TFormClass

ist definiert als

Delphi-Quellcode:

class of TForm

;)
Was du da machst mit dem

Delphi-Quellcode:

FC

ist nicht falsch, aber überflüssig

Nachtrag
So macht es Sinn

Delphi-Quellcode:

type
    TVater = Class( TForm )
      public
        Procedure SetFoo( A : TComponent ); Virtual; Abstract;
    end;

   TVaterClass = Class of TVater;

    TMyForm = class( TVater )
      public
        Procedure SetFoo( A : TComponent ); override;
   end;

var
  AktForm : TVater;
  FC : TFormClass;
begin
  FC := GetForm('FormName'); // holt die Registriere Formclass TMyForm... (Source verkürzt)

  if FC.InheritsFrom( TVater ) then
  begin
    AktForm := TVaterClass( FC ).Create( Self ); // Kein Typecast mehr!
    AktForm.SetFoo(Self); // <- Abstracter Fehler ist weg
  end;
end;

[Mavarik]

Zitat:

Zitat von Sir Rufo (Beitrag 1246338)

Du hast

Delphi-Quellcode:

override

vergessen ;)

:wall: OK ich schreibe 100 mal... Nicht programmieren vor dem 1. Kaffee!

Zitat:

Zitat von Sir Rufo (Beitrag 1246338)

BTW

Delphi-Quellcode:

TFormClass

ist definiert als

Delphi-Quellcode:

class of TForm

;)
Was du da machst mit dem

Delphi-Quellcode:

FC

ist nicht falsch, aber überflüssig

TFormClass ist VCL Only... nicht definiert in FMX!

Mavarik

[Sir Rufo]

Zitat:

Zitat von Mavarik (Beitrag 1246339)

Zitat:

Zitat von Sir Rufo (Beitrag 1246338)

Du hast

Delphi-Quellcode:

override

vergessen ;)

:wall: OK ich schreibe 100 mal... Nicht programmieren vor dem 1. Kaffee!

Warum benutzt du denn nicht CodeCompletion ?
Das geht auch nach dem 10. Bier noch :mrgreen:

Zitat:

Zitat von Mavarik (Beitrag 1246339)

Zitat:

Zitat von Sir Rufo (Beitrag 1246338)

BTW

Delphi-Quellcode:

TFormClass

ist definiert als

Delphi-Quellcode:

class of TForm

;)
Was du da machst mit dem

Delphi-Quellcode:

FC

ist nicht falsch, aber überflüssig

TFormClass ist VCL Only... nicht definiert in FMX!

Die spinnen doch, die Römer ...

[Mavarik]

Zitat:

Zitat von Sir Rufo (Beitrag 1246341)

Warum benutzt du denn nicht CodeCompletion ?

Ok die Tasten funktionieren... Aber ich nutze noch die IDE-Klassic Tastatur und da gehen einige Sachen nicht. oder ggf. anders.

Daher habe ich mich mit diesen Funktionen nie beschäftigt.

Mavarik

[Mavarik]

Zitat:

Zitat von Sir Rufo (Beitrag 1246338)

Delphi-Quellcode:

type
    TVater = Class( TForm )
      public
        Procedure SetFoo( A : TComponent ); Virtual; Abstract;
    end;

   TVaterClass = Class of TVater;

    TMyForm = class( TVater )
      public
        Procedure SetFoo( A : TComponent ); override;
   end;

var
  AktForm : TVater;
  FC : TFormClass;
begin
  FC := GetForm('FormName'); // holt die Registriere Formclass TMyForm... (Source verkürzt)

  if FC.InheritsFrom( TVater ) then
  begin
    AktForm := TVaterClass( FC ).Create( Self ); // Kein Typecast mehr!
    AktForm.SetFoo(Self); // <- Abstracter Fehler ist weg
  end;
end;

Kann ich auch noch testen, ob AktForm.SetFoo(Self); in TMyForm überladen wurde?
Nach dem Motto AktForm hasImplemented(SetFoo), oder so?

[himitsu]

Grundsätzlich meckert der Compilier, wenn man eine Instanz 'ner Klasse erstellen will, wo noch abstrakte Methoden drin sind.
Demnach könnte man sagen, daß es garnicht nötig ist, das zu prüfen.

Aber schau mal bei TStream in den Quellcode.
Dort gibt es zwei Varianten für Seek (einmal 32 und nochmal für 64 Bit).

Dort drin wird geschaut, ob die andere Variante überladen wurde, falls sie selber nicht überladen sind und rufen dann entweder das Andere auf, oder werfen eine Exception.

[Mavarik]

Zitat:

Zitat von himitsu (Beitrag 1246520)

Grundsätzlich meckert der Compilier, wenn man eine Instanz 'ner Klasse erstellen will, wo noch abstrakte Methoden drin sind.
Demnach könnte man sagen, daß es garnicht nötig ist, das zu prüfen.

Nein, da ich ja nur den Klassentype als Class of habe...

[himitsu]

Da ja nur der Compiler prüft, kann er nur auf direkte Typen prüfen.
Im laufenden Programm ist es ja nicht verboten ... es gibt halt nur eine Exception, wenn man diese Methoden aufrufen will.

Der Code im TStream macht eigentlich nichts Anderes, als die Procedur-Adressen zu vergleichen.

Für abstrakte Mtehoden leitet Delphi das auf eine Dummy-Methode um, wo die EAbstract-Exception dann ausgelöst wird. (wäre schöner gewesen, wenn Delphi dort auch noch den Methoden Namen übergeben hätte, damit man auch erfährt wo es knallt).

Also der holt sich die Eintrittspunkte einmal aus seiner Instanz, bzw. aus der VMT des Typs, welcher grade der Objektinstanz zugeordnet ist.
Und dann noch die Adresse der Vergleichsmethode, direkt aus dem gewünschten Typ, welche dann Beide verglichen werden ... wenn gleich, dann wurde nicht überschrieben.
(es sei den jemand trickst, ändert auch die RTTI des Ursprungstypen und verschleiert so die Änderung, aber sowas macht man ja nicht :angel2: )

[Mavarik]

Zitat:

Zitat von himitsu (Beitrag 1246526)

Und dann noch die Adresse der Vergleichsmethode, direkt aus dem gewünschten Typ, welche dann Beide verglichen werden ... wenn gleich, dann wurde nicht überschrieben.

Wo steht das Beispiel?

Mavarik


PS: Gibt es echt kein "hasImplemented(SetFoo)"

[himitsu]

Zitat:

Zitat von Mavarik (Beitrag 1246615)

PS: Gibt es echt kein "hasImplemented(SetFoo)"

Nicht daß ich wüsste.

Da aber vermutlich alle abstrakten Methoden auf die selbe Methode zeigen, könnte man das damit vergleichen.


Man kann über die neue große RTTI gehen und genauer nachsehn was wie wo implementiert ist.

Wenn du von beiden Typen eine Instanz hast, dann ganz billig so.

Delphi-Quellcode:

if @Self.MyProc = @Vorfahr.MyProc then  // Wobei man hier natürlich noch den Self-Pointer aus dem Vergleich ausschließen muß.
  ShowMessage('boom');

// also

if TMethod(@Self.MyProc).Code = TMethod(@Vorfahr.MyProc).Code then  // OK, und für den Typecast muß alles noch in Variablen kopiert werden.
  ShowMessage('boom');

Bei Published-Methoden könnte man auch einfach über TObject.MethodAddress gehen.

Delphi-Quellcode:

uses
  Rtti;

type
  TTestParent = class
    procedure VirtualProc;  virtual; abstract;
    procedure AbstractProc; virtual; abstract;
  published
    procedure PubVirtualProc;  virtual; abstract;
    procedure PubAbstractProc; virtual; abstract;
    procedure PubCompareDummy; virtual; abstract;
  end;

  TTest = class(TTestParent)
    procedure VirtualProc; override;
  published
    procedure PubVirtualProc; override;
  end;

procedure TTest.VirtualProc;
begin
end;

procedure TTest.PubVirtualProc;
begin
end;

procedure TForm21.FormCreate(Sender: TObject);
var
  TestObj: TTest;
  ErrorProc: Pointer;
  Temp1, Temp2: procedure of object;
  TestC: TClass;
begin
  TestObj := TTest.Create;

  asm
    //MOV &ErrorProc, @AbstractError
    MOV &ErrorProc, OFFSET System.@AbstractError
  end;
  //if TestObj.MethodAddress('PubVirtualProc') = @System._AbstractError then
  if TestObj.MethodAddress('PubVirtualProc') = ErrorProc then
    ShowMessage('boom 1');  // geht nicht .... wie was das nochmal mit den Adressen im Assembler?
  //if TestObj.MethodAddress('PubAbstractProc') = @System._AbstractError then
  if TestObj.MethodAddress('PubAbstractProc') = ErrorProc then
    ShowMessage('boom 2');

  if TestObj.MethodAddress('PubVirtualProc') = TTestParent.MethodAddress('PubVirtualProc') then
    ShowMessage('boom 3');
  if TestObj.MethodAddress('PubAbstractProc') = TTestParent.MethodAddress('PubAbstractProc') then
    ShowMessage('boom 4');

  TestC := TTestParent;
  Temp1 := TestObj.VirtualProc;
  Temp2 := TTestParent(@TestC).VirtualProc;
  if TMethod(Temp1).Code = TMethod(Temp2).Code then
    ShowMessage('boom 5');
  TestC := TTestParent;
  Temp1 := TestObj.AbstractProc;
  Temp2 := TTestParent(@TestC).AbstractProc;
  if TMethod(Temp1).Code = TMethod(Temp2).Code then
    ShowMessage('boom 6');

  TestC := TTestParent;
  Temp1 := TestObj.VirtualProc;
  Temp2 := TTestParent(@TestC).VirtualProc;
  if TMethod(Temp1).Code = TMethod(Temp2).Code then
    ShowMessage('boom 7');
  TestC := TTestParent;
  Temp1 := TestObj.AbstractProc;
  Temp2 := TTestParent(@TestC).AbstractProc;
  if TMethod(Temp1).Code = TMethod(Temp2).Code then
    ShowMessage('boom 8');

  with TRttiContext.Create do begin
    if GetType(TTest).GetMethod('VirtualProc').CodeAddress = GetType(TTestParent).GetMethod('VirtualProc').CodeAddress then
      ShowMessage('boom 9');
    if GetType(TTest).GetMethod('AbstractProc').CodeAddress = GetType(TTestParent).GetMethod('AbstractProc').CodeAddress then
      ShowMessage('boom 10');
  end;

  TestObj.VirtualProc;
  TestObj.PubVirtualProc;
  TestObj.AbstractProc;
  TestObj.PubAbstractProc;

[Mavarik]

Untested!

Delphi-Quellcode:

function MethodIsImplemented(const AClass:TClass;MethodName : string): Boolean;
var
  m   : TRttiMethod;
begin
  Result := False;
  m:=TRttiContext.Create.GetType(AClass.ClassInfo).GetMethod(MethodName);
  if m<>nil then
   Result:=CompareText(AClass.ClassName,m.Parent.Name)=0; 
end;

Mavarik