Delphi: 如何在虚方法中调用继承的祖先函数?

25

我正在覆盖一个虚方法,并且我想调用 inherited。但我不想调用 直接的 祖先,我想调用 之前的那个

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;

可能吗?


9
@Ian 我认为现在你应该警觉起来了!你的系统中这部分的设计肯定有问题。 - David Heffernan
@Ian 你在哪个点上拥有控制权?TADODatabaseObject?TCustomer? - David Heffernan
1
@David Heffernan 我会问一些没有人知道答案的难题。 - Ian Boyd
可能吗?是的,这是可能的,你只是不知道,看看我的回答... :) - ZORRO_BLANCO
@DavidHeffernan 确实存在设计问题,但很多时候设计并不完全由您决定。从外部基础上继承并覆盖其中一些行为,但不包括其父类实现的行为,在我看来是一个非常合理的用例。特别是因为 Delphi 缺乏多重继承和模板,这促使创建许多“怪物”类。 - Jaap Versteegh
显示剩余4条评论
4个回答

32

你可以使用一个技巧来获取虚方法的静态地址:

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;

这是一个很棒的技巧,我在这种情况下使用它 - 我使用第三方框架,继承的方法做了错误的事情 - 吞噬了我想要捕获的异常,所以我需要跳过它,重新实现稍微修改后的逻辑,然后调用“祖父”(TBase)的方法。 - Edwin Yip

17

你不能以常规语言方式实现这一点,因为这将破坏语言的面向对象特性。

你可以通过调整指针和巧妙的类型转换来完成此操作,但在开始回答之前,你需要问自己:这真的是你想要的吗?

正如其他人提到的那样:你的需求听起来像一个严重的“设计异味”(类似于代码异味,但更严重)。

编辑:

沿着指针操作的路线走可能会在短期内节省你的工作量,但在长期内会造成几周的额外工作。
关于这一点,这篇文章值得一读:上游决策,下游成本


2
有趣的是,如果您尝试“跳跃类层次结构”并调用虚拟方法,则可能会出现无限递归(堆栈溢出时间!)。 - Warren P
1
是的,这是一个严重的设计问题,但有时可能是合理的,例如当您了解类层次结构但无法处理“妨碍”的类时。(我曾经不得不这样做,以隐藏某些 Windows 消息,同时仍然利用 TWinControl 下面的默认处理。)user246408 的下面的答案可行且是实现此目的的最佳方法。 - Ian Goldby
@IanGoldby 有趣的使用案例。你联系过TChart的人解决了吗? - Jeroen Wiert Pluimers
@JeroenWiertPluimers 我怀疑他们对这个特殊情况可能不会很感兴趣。(它改变了图表上鼠标点击的行为。) - Ian Goldby
@IanGoldby,一些组件供应商在处理反馈方面非常出色,即使是看似特殊的情况也能得到很好的解决。试试看吧 (; - Jeroen Wiert Pluimers
1
我刚刚遇到了一个与另一个“黑客”相关的用例。我需要实现一个代码钩子来更改虚方法中某些VCL行为。不幸的是,替换所需的内容需要调用其替换的代码的祖先。user246408的选项是我能找到的唯一实现它的方式。 - Graymatter

9

我记得几年前,我曾经因为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;

并不是特别优雅但仍然是一种解决方案 :)


3
如果您真的想这样做,那么您应该将您想要直接引用的继承层次结构部分提取到一个单独的受保护方法中。这将允许您从任何地方调用它,而不会被虚拟方法调度所打败。
然而,正如我所评论的,您的类设计似乎有些问题。

对于两个设计有些不对劲。但是原始版本已经是固定且可运行的。我可能最终会彻底重构它,在此过程中引入许多错误。我原本希望这一行代码可以为我节省几天的工作时间。 - Ian Boyd
我曾经遇到过类似的问题。基础类有三万行第三方组件代码。 - Warren P

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接