Delphi: ¿Cómo llamar antecesor heredado heredado en un método virtual?

Question

Estoy anulando un método virtual, y quiero llamar al heredado. Pero no quiero llamar al antecesor inmediato , quiero llamar al antes de.

TObject 
    TDatabaseObject 
     TADODatabaseObject <---call this guy 
     TCustomer  <---skip this guy 
      TVIP   <---from this guy 

He intentado fundición mi self como el antepasado, y llame al método de eso, sino que dio lugar a desbordamiento de pila recursiva:

procedure TVip.SetProperties(doc: IXMLDOMDocument); 
begin 
    TADODatabaseObject(Self).SetProperties(doc); //skip over TCustomer ancestor 
    ... 
end; 

He intentado añadir la palabra clave inherited, pero eso no lo hace compilar:

procedure TVip.SetProperties(doc: IXMLDOMDocument); 
begin 
    inherited TADODatabaseObject(Self).SetProperties(doc); //skip over TCustomer ancestor 
    ... 
end; 

Posible?

Answer 1

No puede hacerlo en un idioma normal, ya que esto rompería los aspectos orientados a objetos del idioma.

Puede jugar con punteros y moldes inteligentes para hacer esto, pero antes incluso de comenzar a responder eso: ¿esto es realmente lo que quiere?

Como otros mencionar:. Su necesidad suena como una grave "olor de diseño" (que es similar a code smell, pero más severa

Editar:

Bajando el puntero jugueteando carretera podría ahorrar trabajar en el corto plazo, y le puede costar semanas de trabajo en el largo plazo
Esto hace que para una buena lectura en la que:.. Upstream decisions, downstream costs

Answer 2

Si realmente desea hacer esto, debe extraer en un método protegido separado la parte de la jerarquía de herencia a la que desea poder hacer referencia directamente. Esto le permitirá llamar desde cualquier lugar sin que el envío de métodos virtuales lo derrote.

Sin embargo, como he comentado, parece que hay algo mal con su diseño de clase.

Answer 3

usted puede hacerlo usando un truco de obtener direcciones estáticas del método virtual:

type 
    TBase = class 
    procedure Foo; virtual; 
    end; 

    TAnsestor = class(TBase) 
    procedure Foo; override; 
    end; 

    TChild = class(TAnsestor) 
    procedure Foo; override; 
    procedure BaseFoo; 
    end; 

procedure TBase.Foo; 
begin 
    ShowMessage('TBase'); 
end; 

procedure TAnsestor.Foo; 
begin 
    ShowMessage('TAnsestor'); 
end; 

procedure TChild.Foo; 
begin 
    ShowMessage('TChild'); 
end; 

type 
    TFoo = procedure of object; 

procedure TChild.BaseFoo; 
var 
    Proc: TFoo; 

begin 
    TMethod(Proc).Code := @TBase.Foo; // Static address 
    TMethod(Proc).Data := Self; 
    Proc(); 
end; 

procedure TForm4.Button1Click(Sender: TObject); 
var 
    Obj: TChild; 
    Proc: TFoo; 

begin 
    Obj:= TChild.Create; 
    Obj.BaseFoo; 
// or else 
    TMethod(Proc).Code := @TBase.Foo; // Static address 
    TMethod(Proc).Data := Obj; 
    Proc(); 

    Obj.Free; 
end; 

Answer 4

recuerdo que tenía que hacer algo como esto hace algunos años trabajando en torno a algunos limitación de diseño de la jerarquía VCL.

por lo que parece que fue algo como esto:

type 
    TGrandParent = class(TObject) 
    public 
    procedure Show;virtual; 
    end; 

    TParent = class(TGrandParent) 
    public 
    procedure Show;override; 
    end; 

    THackParent = class(TGrandParent) 
    private 
    procedure CallInheritedShow; 
    end; 

    TMyObject = class(TParent) 
    public 
    procedure Show;override; 
    end; 


{ TGrandParent } 

procedure TGrandParent.Show; 
begin 
    MessageDlg('I''m the grandparent', mtInformation, [mbOk], 0); 
end; 

{ TParent } 

procedure TParent.Show; 
begin 
    inherited; 
    MessageDlg('I''m the parent', mtInformation, [mbOk], 0); 
end; 

{ THackParent } 

procedure THackParent.CallInheritedShow; 
begin 
    inherited Show; 
end; 

{ TVIP } 

procedure TMyObject.Show; 
begin 
    THackParent(Self).CallInheritedShow; 
end; 

procedure TForm6.Button6Click(Sender: TObject); 
var 
    VIP: TMyObject; 
begin 
    VIP:=TMyObject.Create; 
    try 
    VIP.Show; 
    finally 
    VIP.Free; 
    end; 
end; 

No es la cena-elegante pero sigue siendo una solución :)