FormularArray den richtigen Create aufrufen! Wie?

[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