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

Delphi:如何在虚拟方法上调用继承的祖先?,delphi,inheritance,Delphi,Inheritance,我正在重写一个虚拟方法,我想调用继承的。但是我不想叫直系祖先,我想叫前面的那个 TObject TDatabaseObject TADODatabaseObject <---call this guy TCustomer <---skip this guy TVIP <---from this guy 我尝试添加继承的关键字,但无法编译: procedure TVip.SetProp

我正在重写一个虚拟方法,我想调用继承的。但是我不想叫直系祖先,我想叫前面的那个

TObject
   TDatabaseObject
      TADODatabaseObject <---call this guy
         TCustomer        <---skip this guy
            TVIP           <---from this guy
我尝试添加
继承的
关键字,但无法编译:

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

可能吗?

如果确实要这样做,那么应该将继承层次结构中希望直接引用的部分提取到单独的受保护方法中。这将允许您从任何地方调用它,而不会使虚拟方法调度失败


但是,正如我所评论的,您的类设计似乎有点不对劲。

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

你可以摆弄指针和聪明的演员来做这件事,但在开始回答这个问题之前:这真的是你想要的吗

正如其他人提到的:您的需求听起来像是一种严重的“设计气味”(类似于,但更为严重)

编辑:

沿着指针摆弄的道路走下去可能会在短期内节省你的工作,在长期内会花费你数周的工作时间。

这有助于更好地阅读以下内容:。

您可以使用获取虚拟方法静态地址的技巧:

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;

我记得几年前我不得不做一些类似的事情来解决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;
不是非常优雅,但仍然是一个解决方案:)

使用tgrandsentor(self.DoSomething()


@伊恩,我想警钟现在应该为你敲响了!系统这一部分的设计不可能是正确的。@David Heffernan,你是对的。但是假设祖先是
TListView
,我真的不能重新设计一个我无法控制的类。@Ian你在什么时候有控制权?TADODatabaseObject?t顾客?@David Heffernan我问了一些没有人知道答案的棘手问题。@Ian LOL。我想说,虽然我(以及其他人)回答了你的问题,但你没有接受……对双方来说:设计出了问题。但是,祖先是罐装的,并发挥作用。我可能最终会彻底删除它,在这个过程中引入许多bug。我希望这一行代码能帮我省下几天的工作。我也有类似的问题。基类是30000行第三方组件代码。有趣的是,如果您尝试“跳转到类层次结构上”,并且调用虚拟方法,您可能会得到无休止的递归(堆栈溢出时间!)。是的,这是一种严重的设计气味,但有时可能是合理的,例如,当您知道类的层次结构,但无法对“碍事”的类执行任何操作时。(我不得不这样做一次,以从TChart隐藏某些Windows消息,同时仍然利用下面TWinControl中的默认处理。)user246408下面的答案很有效,是实现这一点的最佳方法。@IanGoldby有趣的用例。你联系过TChart的人解决了吗?@Jeroenwiertplumers我怀疑他们会对这个特殊的案子很感兴趣。(它改变了鼠标点击图表的行为。)我刚刚有一个与另一个“黑客”相关的用例。我需要实现一个代码钩子来更改虚拟方法中的某些VCL行为。不幸的是,替换需要调用它正在替换的代码的祖先。user246408的选项是我能找到的实现它的唯一方法。这是一个很棒的技巧,我在这个场景中使用了它——我使用了第三方框架,继承的方法做了错误的事情——吃掉了我想要捕获的异常,所以我需要跳过它,重新实现稍微修改过的逻辑,然后调用“祖父”(TBase)的方法。
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;
TCar = class
    procedure Ride();
TBlueCar = class(TCar)
    procedure Ride();
TCar1 = class(TBlueCar)
    procedure Ride();

procedure TCar.Ride();
begin
  writeln('Riding')
end;
procedure TBlueCar.Ride();
begin
  writeln('I am blue')
  inherited Ride();
end;
procedure TCar1.Ride();
begin
  writeln('I am car1')
  TCar(self).Ride();
end;