Delphi:如何在虚方法上调用继承的继承祖先？

Question

我正在覆盖一个虚方法,我想调用继承.但我不想叫直接祖先,我想调用一个之前.

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

我尝试将我self作为祖先,然后调用该方法,但它导致递归堆栈溢出:

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

我尝试添加inherited关键字,但不编译:

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

可能？

Answer 1

您可以使用获取虚拟方法的静态地址来执行此操作:

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 2

你不能用常规的语言方式,因为这会破坏语言的面向对象方面.

你可以摆弄指针和聪明的演员来做到这一点,但在开始回答之前:这真的是你想要的吗？

正如其他人所说:你的需要听起来像一个严肃的"设计气味"(类似于代码气味,但更严重.

编辑:

走下指针摆弄道路可能会在短期内节省你的工作,并且从长远来看你需要花费数周时间.
这可以很好地解读:上游决策,下游成本.

Answer 3

我记得几年前我必须做一些这样的事情来解决VCL层次结构的一些设计限制.

所以它似乎是这样的:

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;

不是晚餐优雅,但仍然是一个解决方案:)