FormularArray den richtigen Create aufrufen! Wie?

[himitsu]

Zitat von Mavarik:

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;