Delphi子类调用祖父类的虚函数

type
  TA = class
    procedure ShowMsg; virtual;
  end;

  TAClass = class of TA;

  TB = class(TA)
    procedure ShowMsg; override;
  end;

  TShowMsg = procedure of object;

  TC = class(TB)
  private
    FGrandFatherShowMsg: TShowMsg;
    procedure ShowMsg; override;
  public
    constructor Create;
  end;

procedure TForm2.Button1Click(Sender: TObject);
var
  C: TC;
begin
  C := TC.Create;
  C.ShowMsg;
  C.Free;
end;
    
{ TC }

constructor TC.Create;
var
  AMethod:TShowMsg;
  ACode: TMethod absolute AMethod;
  A: TA;
begin
  inherited Create;
  A := TA.Create;
  FGrandFatherShowMsg := A.ShowMsg;
  AMethod:= FGrandFatherShowMsg;
  ACode.Data := Self;
  A.Free;
end;

procedure TC.ShowMsg;
begin
  FGrandFatherShowMsg;
  ShowMessage(‘TC‘);
end;

{ TA }

procedure TA.ShowMsg;
begin
  ShowMessage(‘TA‘);
end;

{ TB }

procedure TB.ShowMsg;
begin
  inherited;
  ShowMessage(‘TB‘);
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;