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

Question

我正在重写一个虚拟方法，我想调用 inherited。但我不想调用立即祖先，我想调用之前。

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

我尝试将 myself 转换为祖先，并在其上调用方法，但它导致递归堆栈溢出：

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

您不能以常规语言方式，因为这会破坏语言的面向对象方面。

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

正如其他人所说：您的需求听起来像是一种严重的“设计气味”（类似于code smell，但更严重。

编辑：

沿着指针摆弄的道路前进可能会在短期内节省您的工作量，但从长远来看可能会花费您数周的工作时间。
这有助于阅读：Upstream decisions, downstream costs。

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;

不是超级优雅，但仍然是一个解决方案:)

Answer 4

如果您真的想这样做，那么您应该将您希望能够直接引用的继承层次结构部分提取到一个单独的受保护方法中。这将允许您从任何地方调用它，而不会破坏您的虚拟方法调度。

但是，正如我所评论的，您的班级设计似乎有问题。