uses
Rtti;
type
TTestParent =
class
procedure VirtualProc;
virtual;
abstract;
procedure AbstractProc;
virtual;
abstract;
published
procedure PubVirtualProc;
virtual;
abstract;
procedure PubAbstractProc;
virtual;
abstract;
procedure PubCompareDummy;
virtual;
abstract;
end;
TTest =
class(TTestParent)
procedure VirtualProc;
override;
published
procedure PubVirtualProc;
override;
end;
procedure TTest.VirtualProc;
begin
end;
procedure TTest.PubVirtualProc;
begin
end;
procedure TForm21.FormCreate(Sender: TObject);
var
TestObj: TTest;
ErrorProc: Pointer;
Temp1, Temp2:
procedure of object;
TestC: TClass;
begin
TestObj := TTest.Create;
asm
//MOV &ErrorProc, @AbstractError
MOV &ErrorProc, OFFSET System.@AbstractError
end;
//if TestObj.MethodAddress('PubVirtualProc') = @System._AbstractError then
if TestObj.MethodAddress('
PubVirtualProc') = ErrorProc
then
ShowMessage('
boom 1');
// geht nicht .... wie was das nochmal mit den Adressen im Assembler?
//if TestObj.MethodAddress('PubAbstractProc') = @System._AbstractError then
if TestObj.MethodAddress('
PubAbstractProc') = ErrorProc
then
ShowMessage('
boom 2');
if TestObj.MethodAddress('
PubVirtualProc') = TTestParent.MethodAddress('
PubVirtualProc')
then
ShowMessage('
boom 3');
if TestObj.MethodAddress('
PubAbstractProc') = TTestParent.MethodAddress('
PubAbstractProc')
then
ShowMessage('
boom 4');
TestC := TTestParent;
Temp1 := TestObj.VirtualProc;
Temp2 := TTestParent(@TestC).VirtualProc;
if TMethod(Temp1).Code = TMethod(Temp2).Code
then
ShowMessage('
boom 5');
TestC := TTestParent;
Temp1 := TestObj.AbstractProc;
Temp2 := TTestParent(@TestC).AbstractProc;
if TMethod(Temp1).Code = TMethod(Temp2).Code
then
ShowMessage('
boom 6');
TestC := TTestParent;
Temp1 := TestObj.VirtualProc;
Temp2 := TTestParent(@TestC).VirtualProc;
if TMethod(Temp1).Code = TMethod(Temp2).Code
then
ShowMessage('
boom 7');
TestC := TTestParent;
Temp1 := TestObj.AbstractProc;
Temp2 := TTestParent(@TestC).AbstractProc;
if TMethod(Temp1).Code = TMethod(Temp2).Code
then
ShowMessage('
boom 8');
with TRttiContext.Create
do begin
if GetType(TTest).GetMethod('
VirtualProc').CodeAddress = GetType(TTestParent).GetMethod('
VirtualProc').CodeAddress
then
ShowMessage('
boom 9');
if GetType(TTest).GetMethod('
AbstractProc').CodeAddress = GetType(TTestParent).GetMethod('
AbstractProc').CodeAddress
then
ShowMessage('
boom 10');
end;
TestObj.VirtualProc;
TestObj.PubVirtualProc;
TestObj.AbstractProc;
TestObj.PubAbstractProc;