How to get a pointer to a method in a base class from a child class in Delphi?

Question

Here is my sample code:

type
  TMyBaseClass = class
  public
    procedure SomeProc; virtual;
  end;

  TMyChildClass = class(TMyBaseClass)
  public
    procedure SomeProc; override;
  end;

var
  SomeDelegate: procedure of object;

procedure TMyBaseClass.SomeProc;
begin
  ShowMessage('Base proc');
end;

procedure TMyChildClass.SomeProc;
begin
  ShowMessage('Child proc');
  // here i want to get a pointer to TMyBaseClass.SomeProc (NOT IN THIS CLASS!):
  SomeDelegate := SomeProc;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TMyChildClass.Create do
  try
    // there will be "Child proc" message:
    SomeProc;
  finally
    Free;
  end;
  // there i want to get "Base proc" message, but i get "Child proc" again
  // (but it is destroyed anyway, how coud it be?):
  SomeDelegate;
end;

Answer 1

In one way, I know:

procedure TMyChildClass.BaseSomeProc;
begin
  inherited SomeProc;
end;


procedure TMyChildClass.SomeProc;
begin
  ShowMessage('Child proc');
  SomeDelegate := BaseSomeProc;
end;

The second is to change the declaration SomeProcfrom overrideto reintroduce:

 TMyChildClass = class(TMyBaseClass)
 public
    procedure SomeProc; reintroduce;
 end;

and then enter selfas TMyBaseClass(do not use ascast):

 SomeDelegate := TMyBaseClass(self).SomeProc;

Also note that your code will give an access violation because you are calling SomeDelegateon an already freed object.

Answer 2

Adding a type declaration and some typecasting, but with some warning notes.

, somedelegate , , AV. , SomeProc , , , ShowMessage.

- , , . AV-.

:

• .
• , , .
• , , .

...
type
  TSomeDelegate = procedure of object;

var
  SomeDelegate: TSomeDelegate;

...

procedure TMyChildClass.SomeProc;
var
  method: TMethod;
begin
  ShowMessage('Child proc');
  // here i want to get a pointer to TMyBaseClass.SomeProc (NOT IN THIS CLASS!):
  method.Code :=  @TMyBaseClass.SomeProc;
  method.Data := Self;
  SomeDelegate := TSomeDelegate(method);
end;