Delphi: How to call inherited inherited ancestor on a virtual method?

10,750

Solution 1

You can't in a regular language way, as this would break the object oriented aspects of the language.

You can fiddle around with pointers and clever casts to do this, but before even starting to answer that: is this really what you want?

As others mentioned: your need sounds like a serious "design smell" (which is similar to code smell, but more severe.

Edit:

Going down the pointer fiddling road might save you work in the short term, and cost you weeks of work in the long term.
This makes for some good reading on that: Upstream decisions, downstream costs.

Solution 2

You can do it using a hack of obtaining static address of virtual method:

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;

Solution 3

I remember I had to do something like this some years ago working around some design limitation of VCL hierarchy.

So it seems it was something like this:

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;

Not supper-elegant but still a solution :)

Solution 4

If you really want to do this then you should extract into a separate protected method the part of the inheritance hierarchy that you want to be able to reference directly. This will allow you to call it from anywhere without virtual method dispatch defeating you.

However, as I have commented, it seems like there is something awry with your class design.

Share:
10,750

Related videos on Youtube

mistertodd
Author by

mistertodd

Any code is public domain. No attribution required. జ్ఞా <sup>🕗</sup>🕗 Yes, i do write i with a lowercase i. The Meta Stackexchange answer that I am most proud of

Updated on May 15, 2022

Comments

  • mistertodd
    mistertodd about 2 years

    I'm overriding a virtual method, and I want to call inherited. But I don't want to call the immediate ancestor, I want to call the one before.

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

    I tried casting myself as the ancestor, and call the method on that, but it led to recursive stack overflow:

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

    i tried adding the inherited keyword, but that doesn't compile:

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

    Possible?

    • David Heffernan
      David Heffernan over 13 years
      @Ian I think the alarm bells should be ringing for you now! The design of this part of your system cannot be right.
    • mistertodd
      mistertodd over 13 years
      @David Heffernan And you're correct. But pretend the ancestor is TListView, i can't really redesign a class i have no control over.
    • David Heffernan
      David Heffernan over 13 years
      @Ian At what point do you have control? TADODatabaseObject? TCustomer?
    • mistertodd
      mistertodd over 13 years
      @David Heffernan i ask tough questions that nobody knows the answer to.
    • David Heffernan
      David Heffernan over 13 years
      @Ian LOL. I'd say though that I (and indeed others) answered your question stackoverflow.com/questions/4616535 but you didn't accept that......
    • mistertodd
      mistertodd over 13 years
      @David i was just looking at the question. Which answer would you say is the answer?
    • David Heffernan
      David Heffernan over 13 years
      @Ian Rob, Remy and myself offer 3 different but perfectly good solutions. I upvoted both Rob's and Remy's solutions. It's up to you which one you accept.
    • ZORRO_BLANCO
      ZORRO_BLANCO over 8 years
      Possible? yes,it is possible, you just don't know, see my answer... :)
    • Jaap Versteegh
      Jaap Versteegh over 8 years
      @DavidHeffernan Design smell for sure, but many times the design is not (entirely) up to you. Descending from an external base and overriding some of it's behaviour, but not that implemented by its parents is a perfectly sane use case imho. Particularly since the lack of multiple inheritance and templates in Delphi stimulates the creation of 'monster' classes of which many are around.
  • mistertodd
    mistertodd over 13 years
    To both: something is off with the design. But the ancestor is canned and functioning. i will probably end up completely gutting it, introducing many bugs in the process. i was hoping this one line of code would save me a few days of work.
  • Warren  P
    Warren P over 10 years
    I had a similar problem. The base classes are 30,000 lines of third party component code.
  • Warren  P
    Warren P over 10 years
    It is interesting to note that you can get an endless recursion (stack overflow time!) if you try to "jump up the class hierarchy" and you're invoking a virtual method.
  • faridSam
    faridSam about 10 years
    Yes, this is a serious design smell, but occasionally it might be justified, for instance when you know the class hierarchy but can't do anything about the class that's 'getting in the way'. (I had to do this once to hide certain Windows messages from TChart whilst still taking advantage of the default processing in TWinControl underneath.) user246408's answer below works and is the best way to achieve this.
  • Jeroen Wiert Pluimers
    Jeroen Wiert Pluimers about 10 years
    @IanGoldby interesting use case. Did you contact the TChart guys to have it resolved?
  • faridSam
    faridSam about 10 years
    @JeroenWiertPluimers I doubt that they would have been very interested in this particular special case. (It was changing the behaviour of mouse-clicks on the chart.)
  • Jeroen Wiert Pluimers
    Jeroen Wiert Pluimers about 10 years
    @IanGoldby some component vendors are really good in handling feedback, even for seemingly special cases. Just give it a try (;
  • Edwin Yip
    Edwin Yip almost 10 years
    This is a great trick, I used it in this scenario - I use a 3rd party framework, the inherited method does wrong thing - eats exceptions that I want to catch, so I need to skip it, re-implement a slightly modified logic of it, then call the "grandfather"( TBase)'s method.
  • Graymatter
    Graymatter almost 8 years
    I just had a use case for this related to another "hack". I needed to implement a code hook to change certain VCL behavior in a virtual method. Unfortunately the replacement needed to call the ancestor of the code it was replacing. user246408's option is the only way that I could find to accomplish it.