How to call current level of a virtual method in Delphi? - delphi

Question

Let suppose two classes:
Parent = class
public
procedure virtFunc(); virtual;
procedure other();
end;
Child = class(Parent)
public
procedure virtFunc(); override;
end;
Usually, calling virtFunc on a Child instance from anywhere will call the Child implementation of that method. However, sometimes it's useful to call the same level implementation:
procedure Parent.other();
begin
virtFunc(); // I want to call Parent.virtFunc(), not Child.virtFunc()
end;
What did I tried?
Parent(Self).virtFunc()
(Self as Parent).virtFunc()
And obviously, I could (but this is not the question):
rename them differently (childFunc vs parentFunc),
remove the virtual.
How to call the current level (non-polymorphic) version of a method in Delphi?
For those who know c++, I would like some equivalent to Parent::virtFunc()

Answer 1

I think that the only way to do this is to:
Implement Parent.virtFunc by a call to a non-virtual method in Parent.
When you want to call virtFunc in a non-polymorphic way you call that non-virtual method rather than calling virtFunc.

Answer 2

ONE
{
получить доступ к предкам даж если их методы виртуальные
дети выполнятся не будут
пример
TV1 = class
public
A:integer;
function GetH:integer;virtual;
end;
TV2 =class (TV1)
public
B:integer;
function GetH:integer;override;
end;
//////////////////////////////////
function TV2.GetH:integer;
begin
Result:=inherited +B;
end;
function TV1.GetH:integer;
begin
Result:=A;
end;
procedure TForm1.Panel1Click(Sender: TObject);
var I:TV2;
s:integer;
begin
I:=TV2.Create;
I.B:=2;
I.A:=1;
//хочу получить доступ с формы к TV1.GetH что бы TV2.GetH не выполнялся
AmVirtual<TV2,TV1>.G(I,
procedure(X2:TV1)
begin
s:=X2.GetH;
end);
showmessage( s.ToString); // >> 1
showmessage( I.GetH.ToString);//>> 3
I.free;
end;
}
type
AmVirtual<T1,T2:class> =class
type
TProc = reference to procedure (X2:T2);
class procedure G(X1:T1;Proc:TProc);static;
end;
class procedure AmVirtual<T1,T2>.G(X1:T1;Proc:TProc);
type
PClass = ^TClass;
var
ClassOld: TClass;
begin
ClassOld := PClass(X1)^;
PClass(X1)^ := T2;
try
proc(X1 as T2);
finally
PClass(X1)^ := ClassOld;
end;
end;
TWO
type
TProc = procedure (arg:TObject) of object;
var Proc: TProc;
begin
TMethod(Proc).Data:=self;
TMethod(Proc).Code:=#TParent.Proc;
Proc(Sender);