Как наследовать метод не родителя, а родителя родителя?

← →
Юрий Зотов (2001-12-21 12:34) [9]

Привожу работающий пример (см. книгу Сергея Орлика "Секреты Delphi на примерах"). В проекте - три формы, отнаследованные одна от другой по цепочке. При нажатии на кнопку показывается сообщение с именем формы. В классе TForm3 перед этим вызывается виртуальный метод "деда" (именно так, сразу "деда" - напрямую, а не через "отца"). Что мы и видим на экране.

Фокус в том, что перед вызовом метода подменяется вход в VMT (потом он, конечно, должен быть восстановлен). В итоге класс TForm3 как бы временно становится классом TForm1. Причем таким образом можно вызвать вообще любой метод любого класса, независимо от отношений наследования.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, PInfoViewer, Grids, DBGrids;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
public
procedure VirtualMethod; virtual;
end;

var
Form1: TForm1;

implementation

uses
Unit2, Unit3;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
VirtualMethod
end;

procedure TForm1.VirtualMethod;
begin
ShowMessage("Form1")
end;

procedure TForm1.FormShow(Sender: TObject);
begin
Form2.Show;
Form3.Show
end;

end.

=========================================================================

unit Unit2;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Unit1, StdCtrls;

type
TForm2 = class(TForm1)
public
procedure VirtualMethod; override;
end;

var
Form2: TForm2;

implementation

{$R *.DFM}

procedure TForm2.VirtualMethod;
begin
ShowMessage("Form2")
end;

end.

=========================================================================

unit Unit3;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Unit2, StdCtrls;

type
TForm3 = class(TForm2)
public
procedure VirtualMethod; override;
end;

var
Form3: TForm3;

implementation

{$R *.DFM}

type
PClass = ^TClass;

procedure TForm3.VirtualMethod;
var
OldClass: TClass;
begin
OldClass := PClass(Self)^;
PClass(Self)^ := ClassParent.ClassParent;
try
VirtualMethod
finally
PClass(Self)^ := OldClass
end;
ShowMessage("Form3")
end;

end.

Как наследовать метод не родителя, а родителя родителя? Найти похожие ветки