TVirtualMethodInterceptor

[yasic]

Всем привет! Может кто знает, когда перехвачиваешь virtual метод, что происходит в override методах? Можно ли перехватить override метод? Такая ситуация. Есть базовый класс с методом. И есть производный класс с перегруженым методом. При одном условии нужно выполнить базовый метод, а при другом производный.

[Sibedir]

Тогда не нужно делать данный метод виртуальным. В том то и смысл виртуальных методов. Адрес виртуального метода хранится в самом экземпляре объекта. Но спасает inherited/
Теоретически можно динамически создать новый экземпляр предка (...ClassParent.Create) "эдентичный" существующему экземпляру-потомка и выполнить его метод (бред полный). Можно получить адрес виртуального метода предка и выполнить его (гемор и бред).
Лучше просто не далать его виртуальным.

Но если уж надо (или предок - не ваше творение ), то как вариант ППниПП (реализовано 2 варианта: inherited и экземпляр предка):

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TObjPredPred = class;

  TObjPredPred = class (TObject)
    F: string;
    function Func: string; virtual;
    procedure AfterConstruction; override;
    procedure Assign (a: TObjPredPred);
  end;

  TObjPred = class (TObjPredPred)
    function PredFunc: string; virtual;
  end;

  TObj1 = class (TObjPred)
    function Func: string; override;
    procedure AfterConstruction; override;
  end;

  TObj2 = class (TObjPred)
    function Func: string; override;
    procedure AfterConstruction; override;
  end;

var
  Form1: TForm1;

implementation

var
  obj1: TObj1;
  obj2: TObj2;

{ TObjPredPred }

procedure TObjPredPred.AfterConstruction;
begin
  f := 'TObjPredPred';
end;

procedure TObjPredPred.Assign(a: TObjPredPred);
begin
  F := a.F;
end;

function TObjPredPred.Func: string;
begin
  Result := ClassName + #13 + 'F = ' + F;
end;

{ TObjPred }

function TObjPred.PredFunc: string;
begin
  Result := inherited Func;
end;

{ TObj1 }

procedure TObj1.AfterConstruction;
begin
  F := 'TObj1';
end;

function TObj1.Func: string;
begin
  Result := ClassName + #13 + 'F = ' + F + #13 + 'АААААААААААААААААААА';
end;

{ TObj2 }

procedure TObj2.AfterConstruction;
begin
  F := 'TObj2';
end;

function TObj2.Func: string;
begin
  Result := ClassName + #13 + 'F = ' + F + #13 + 'BBBBBBBBBBBBBBBBBBBB';
end;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if RadioButton1.Checked then
    ShowMessage (obj1.Func)
  else
    ShowMessage (obj1.PredFunc);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  rabobj: TObjPredPred;
begin
  if RadioButton1.Checked then begin
    ShowMessage (obj2.Func);
  end
  else begin
    rabobj := TObjPredPred.Create;
    rabobj.Assign (obj2);
    ShowMessage ((rabobj as TObjPredPred).Func);
    FreeAndNil (rabobj);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  obj1 := TObj1.Create;
  obj2 := TObj2.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil (obj1);
  FreeAndNil (obj2);
end;

end.