Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.071 Beiträge
 
Delphi 12 Athens
 
#39

AW: FormularArray den richtigen Create aufrufen! Wie?

  Alt 4. Feb 2014, 15:22
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 Delphi-Referenz durchsuchenTObject.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;
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PoSex im Delphi viel seltener praktiziert.

Geändert von himitsu ( 4. Feb 2014 um 15:25 Uhr)
  Mit Zitat antworten Zitat