Если метод в классе предка объявлен как виртуальный (virtual) или динамический (dynamic), вам необходимо перекрыть его во всех классах-наследниках. Если вы объявляете унаследованный метод виртуальным или динамическим, вы начинаете строить его новое виртуальное/динамическое дерево наследования. Допустим, у нас есть следующая иерархия: A (родитель) - B - C - D. Если вы объявляете метод как виртуальный (или динамический) в A, перекрываете в B, создаете виртуальным в C и перекрываете в D, вот что получается:

 

 

фактический класс, используемый класс, использующий

класс для доступа к методу метод

-----------+---------------------+--------------------

D D D

D C D

D B B

D A B

 

C C C

C B B

C A B

 

B B B

B A B

 

Вывод: работа виртуального/динамического наследования прекращается в момент создания одноименного виртуального/динамического метода наследниками класса.

Mark

 

 

Взято из Советов по Delphi отВалентина Озерова

Сборник Kuliba

Добавить комментарий
Подробности
Родительская категория: Объектное ориентирование
Категория: Методы

Согласно онлайновой документации, динамические и виртуальные методы семантически идентичны, единственно различие заключается в их реализации, нижеследующий код генерирует указанную ошибку компиляции:

 

Code:

type t = class

function a: integer; {статический}

function b: integer; virtual;

function c: integer; dynamic;

property i: integer read a; { ok }

property j: integer read b; { ok }

property k: integer read c;{ ОШИБКА: type mismatch (не совпадение типа) }

end;

 

 

 

 

Взято из Советов по Delphi от Валентина Озерова

Сборник Kuliba

Добавить комментарий
Подробности
Родительская категория: Объектное ориентирование
Категория: Методы

 

Code:

unit EditorVMTandDMTTables;

 

interface

 

// функция служит для выяснения существования VMT у класса

// возвращает True, если класс имеет VMT и False - если нет

function IsVMTExist(Cls: TClass): Boolean;

 

// процедура служит для замены адреса метода в VMT класса со смещением

// Offset(должно быть кратно 4) новым адресом, хранящимся в NewMet

// примечание: перед вызовом этой процедуры проверяйте существование

// VMT у класса функцией IsVMTExist

procedure VirtMethodReplace(Cls: TClass; Offset: LongWord; NewMet: Pointer); overload;

 

// процедура служит для замены адреса метода, хранящегося в OldMet,

// в VMT класса новым адресом, хранящимся в NewMet

// примечание: перед вызовом этой процедуры проверяйте существование

// VMT у класса функцией IsVMTExist

procedure VirtMethodReplace(Cls: TClass; OldMet, NewMet: Pointer); overload;

 

// функция служит для замены адреса динамического метода класса с индексом,

// хранящимся в Index, новым адресом, хранящимся в NewMet

// возвращает True, если метод с данным индексом найден и False - если нет

function DynMethodReplace(Cls: TClass; Index: Word; NewMet: Pointer): Boolean; overload;

 

// функция служит для замены адреса динамического метода класса, хранящегося

// в OldMet, новым адресом, хранящимся в NewMet

// возвращает True, если метод с данным адресом найден и False - если нет

function DynMethodReplace(Cls: TClass; OldMet, NewMet: Pointer): Boolean; overload;

 

implementation

 

// функция служит для получения указателя на байт, следующий за адресом

// последнего метода в VMT класса

// возвращает nil в случае, если у класса нет VMT

// функция является "внутренней" в модуле

// (используется другими подпрограммами и не объявлена в секции interface)

// , поэтому используйте её только если

// Вы полностью уверены в своих действиях(она изменяет "рабочие" регистры

// ECX и EDX)

function GetVMTEnd(Cls: TClass): Pointer;

asm

// Вход: Cls --> EAX

// Выход: Result --> EAX

 

PUSH EBX

MOV ECX, 8

MOV EBX, -1

MOV EDX, vmtSelfPtr

@@cycle:

ADD EDX, 4

CMP [EAX + EDX], EAX

JE @@vmt_not_found

JB @@continue

CMP [EAX + EDX], EBX

JAE @@continue

MOV EBX, [EAX + EDX]

@@continue:

DEC ECX

JNZ @@cycle

MOV EAX, EBX

JMP @@exit

@@vmt_not_found:

XOR EAX, EAX

@@exit:

POP EBX

end;

 

function IsVMTExist(Cls: TClass): Boolean;

asm

// Вход: Cls --> EAX

// Выход: Result --> AL

 

CALL GetVMTEnd

TEST EAX, EAX

JZ @@vmt_not_found

MOV AL, 1

@@vmt_not_found:

end;

 

procedure VirtMethodReplace(Cls: TClass; Offset: LongWord; NewMet: Pointer); overload;

asm

// Вход: Cls --> EAX, Offset --> EDX, NewMet --> ECX

MOV [EAX + EDX], ECX

end;

 

procedure VirtMethodReplace(Cls: TClass; OldMet, NewMet: Pointer); overload;

asm

// Вход: Cls --> EAX, OldMet --> EDX, NewMet --> ECX

PUSH EDI

MOV EDI, EAX

PUSH ECX

PUSH EDX

PUSH EAX

CALL GetVMTEnd

POP EDX

SUB EAX, EDX

SHR EAX, 2

POP EDX

POP ECX

PUSH ECX

MOV ECX, EAX

MOV EAX, EDX

POP EDX

REPNE SCASD

JNE @@OldMet_not_found

MOV [EDI - 4], EDX

@@OldMet_not_found:

POP EDI

end;

 

function DynMethodReplace(Cls: TClass; Index: Word; NewMet: Pointer): Boolean; overload;

asm

// Вход: Cls --> EAX, Index --> DX, NewMet --> ECX

// Выход: Result --> AL

 

PUSH EDI

PUSH ESI

MOV ESI, ECX

XOR EAX, EDX

XOR EDX, EAX

XOR EAX, EDX

JMP @@start

@@cycle:

MOV EDX, [EDX]

@@start:

MOV EDI, [EDX].vmtDynamicTable

TEST EDI, EDI

JZ @@get_parent_dmt

MOVZX ECX, WORD PTR [EDI]

PUSH ECX

ADD EDI, 2

REPNE SCASW

JE @@Index_found

POP ECX

@@get_parent_dmt:

MOV EDX, [EDX].vmtParent

TEST EDX, EDX

JNZ @@cycle

JMP @@Index_not_found

@@Index_found:

POP EAX

SHL EAX, 1

SUB EAX, ECX

MOV [EDI + EAX * 2 - 4], ESI

MOV AL, 1

JMP @@exit

@@Index_not_found:

XOR AL, AL

@@exit:

POP ESI

POP EDI

 

end;

 

function DynMethodReplace(Cls: TClass; OldMet, NewMet: Pointer): Boolean; overload;

asm

// Вход: Cls --> EAX, OldMet --> EDX, NewMet --> ECX

// Выход: Result --> AL

 

PUSH EDI

PUSH ESI

MOV ESI, ECX

XOR EAX, EDX

XOR EDX, EAX

XOR EAX, EDX

JMP @@start

@@cycle:

MOV EDX, [EDX]

@@start:

MOV EDI, [EDX].vmtDynamicTable

TEST EDI, EDI

JZ @@get_parent_dmt

MOVZX ECX, WORD PTR [EDI]

LEA EDI, EDI + 2 * ECX + 2

REPNE SCASD

JE @@OldMet_found

@@get_parent_dmt:

MOV EDX, [EDX].vmtParent

TEST EDX, EDX

JNZ @@cycle

JMP @@OldMet_not_found

@@OldMet_found:

MOV [EDI - 4], ESI

MOV AL, 1

JMP @@exit

@@OldMet_not_found:

XOR AL, AL

@@exit:

POP ESI

POP EDI

 

end;

 

end.

 

 

 

Автор ___ALex___ Форум:https://forum.pascal.dax

Добавить комментарий
Подробности
Родительская категория: Объектное ориентирование
Категория: Методы

1) Есть Class1, с методом Mtd.

2) Есть Class2 унаследованный от Class1, метод Mtd перезаписан

3) В программе используется переменная типа Class2

Можно ли из программы вызвать Mtd от Class1, Другими словами, можно ли вызвать перезаписанный метод класса-предка?

 

Способ 1(только для не виртуальных методов)

Code:

{©Drkb v.3(2007): www.drkb.ru}

var

a:class2;

begin

a:=class2.Create;

class1(a).mtd;

....

end;

 

 

 

 

 

Автор:Fantasist

Взято с Vingrad.ruhttps://forum.vingrad

 

 

 

Способ со статическим приведением годится только для

не виртуальных методов, имеющих одно имя.

Вызов же виртуальных методов от статического типа не зависит.

В твоём простейшем случае достаточно написать inherited Mtd;

(ты его можешь вызвать из любого метода TClass2, не только из Mtd).

Трудности возникнут, когда нужно вызвать метод "дедушки" или "прадедушки" и т.д.

Один из способов, описанных в литературе, - временная замена

VMT объекта на "дедушку" и обратно. Но если у дедушки такого метода не было - будет облом.

Я предпочитаю такой способ:

 

Code:

type

{©Drkb v.3(2007): www.drkb.ru}

 

TProc = procedureofobject;

procedure TClassN.SomeMethod;

var

Proc: TProc;

begin

TMethod(Proc).Code := @TClass1.Mtd; // Статический адрес

TMethod(Proc).Data := Self;

Proc();

end;

 

 

 

Автор ответа:Le Taon

 

Взято с Vingrad.ruhttps://forum.vingrad

Добавить комментарий
Подробности
Родительская категория: Объектное ориентирование
Категория: Методы

Проблема в следующем. Допустим, есть иерархия классов, у которых перекрывается один и тот же виртуальный (или динамический - не важно) метод и в одной из реализаций этого метода вы хотите вызвать виртуальный метод предка своего предка. Новая объектная модель Delphi допускает только вызов методов предка (с помощью ключевого слова inherited) либо вызов методов класса с префиксом - типом класса (например, TLevel1.ClassName).

 

Эта проблема стандартными средствами не решается. Но сделать требуемый вызов можно. Причем способом, показанным ниже, можно вызвать любой метод для любого класса, однако, в этом случае вся ответственность за правильность работы с методами и полями ложится на программиста. Ниже в методе VirtualFunction класса TLevel3 вызывается метод класса TLevel1, а в функции Level1Always всегда вызывается метод класса TLevel1 для любого его наследника.

 

Code:

 

TLevel1 = class(TComponent)

public

function VirtualFunction: string; virtual;

end;

 

TLevel2 = class(TLevel1)

public

function VirtualFunction: string; override;

end;

 

TLevel3 = class(TLevel2)

public

function VirtualFunction: string; override;

end;

 

function Level1Always(MyLevel: TLevel1): string;

 

implementation

 

type

PClass = ^TClass;

 

function TLevel1.VirtualFunction: string;

begin

Result := 'Level1';

end;

 

function TLevel2.VirtualFunction: string;

begin

Result := inherited VirtualFunction+' Level2';

end;

 

function TLevel3.VirtualFunction: string;

var

ClassOld: TClass;

begin

ClassOld := PClass(Self)^;

PClass(Self)^ := TLevel1;

Result := VirtualFunction + ' Level3';

PClass(Self)^ := ClassOld;

end;

 

function Level1Always(MyObject: TObject): string;

var

ClassOld: TClass;

begin

ClassOld := PClass(MyObject)^;

PClass(MyObject)^ := TLevel1;

Result := (MyObject as TLevel1).VirtualFunction;

PClass(MyObject)^ := ClassOld;

end;

 

Как же это работает? Стандартные так называемые объектные типы (object types - class of ...) на самом деле представляют из себя указатель на VMT (Virtual Method Table) - таблицу виртуальных методов, который (указатель) лежит по смещению 0 в экземпляре класса. Воспользовавшись этим, мы сначала сохраняем 'старый тип класса' - указатель на VMT, присваиваем ему указатель на VMT нужного класса, делаем вызов и восстанавливаем все как было. Причем нигде не требуется, чтобы один из этих классов был бы порожден от другого, т.е. функция Level1Always вызовет требуемый метод вообще для любого экземпляра любого класса.

 

Если в функции Level1Always сделать попробовать вызов

 

Code:

Result := MyObject.VirtualFunction;

 

 

то будет ошибка на стадии компиляции, так как у класса TObject нет метода VirtualFunction. Другой вызов

 

Code:

Result := (MyObject as TLevel3).VirtualFunction;

 

 

 

 

будет пропущен компилятором, но вызовет Run-time ошибку, даже если передается экземпляр класса TLevel3 или один из его потомком, так как информация о типе объекта меняется. Динамически распределяемые (dynamic) методы можно вызывать точно таким же образом, т.к. информация о них тоже хранится в VMT. Статические методы объектов вызываются гораздо более простым способом, например

 

Code:

var

MyLevel3: TLevel3;

...

(MyLevel3 as TLevel1).SomeMethode;

 

 

вызовет метод класса TLevel1 даже если у MyLevel3 есть свой такой же метод.

 

 

Copyright © 1996 Epsylon Technologies

Взято из FAQ Epsylon Technologies

Добавить комментарий
Подробности
Родительская категория: Объектное ориентирование
Категория: Методы

Code:

// Converting method pointers into function pointers

// Often you need a function pointer for a callback function. But what, if you want to specify a method as

// an callback? Converting a method pointer to a function pointer is not a trivial task; both types are

// incompatible with each other. Although you have the possibility to convert like this "@TClass.SomeMethod",

// this is more a hack than a solution, because it restricts the use of this method to some kind of a class

// function, where you cannot access instance variables. If you fail to do so, you'll get a wonderful gpf.

// But there is a better solution: run time code generation! Just allocate an executable memory block, and

// write 4 machine code instructions into it: 2 instructions loads the two pointers of the method pointer

// (code & data) into the registers, one calls the method via the code pointer, and the last is just a return

// Now you can use this pointer to the allocated memory as a plain function pointer, but in fact you are

// calling a method for a specific instance of a Class.

 

 

 

type TMyMethod = procedureofobject;

 

 

function MakeProcInstance(M: TMethod): Pointer;

begin

// allocate memory

GetMem(Result, 15);

asm

// MOV ECX,

MOV BYTE PTR [EAX], $B9

MOV ECX, M.Data

MOV DWORD PTR [EAX+$1], ECX

// POP EDX

MOV BYTE PTR [EAX+$5], $5A

// PUSH ECX

MOV BYTE PTR [EAX+$6], $51

// PUSH EDX

MOV BYTE PTR [EAX+$7], $52

// MOV ECX,

MOV BYTE PTR [EAX+$8], $B9

MOV ECX, M.Code

MOV DWORD PTR [EAX+$9], ECX

// JMP ECX

MOV BYTE PTR [EAX+$D], $FF

MOV BYTE PTR [EAX+$E], $E1

end;

end;

 

 

procedure FreeProcInstance(ProcInstance: Pointer);

begin

// free memory

FreeMem(ProcInstance, 15);

end;

 

 

 

Взято с сайтаhttps://www.swissdelphicenter.ch/en/tipsindex

Добавить комментарий
Подробности
Родительская категория: Объектное ориентирование
Категория: Методы

Кто-нибудь знает, в чем разница между перекрытием (OVERRIDING) виртуального метода и заменой (REPLACING) его? Я немного запутался.

 

Допустим у вас есть класс:

Code:

TMyObject = class (TObject)

 

и его наследник:

Code:

TOverrideObject = class (TMyObject)

 

К примеру, TMyObject имеет метод Wiggle:

 

Code:

procedure Wiggle; virtual;

 

а TOverrideObject перекрывает Wiggle:

 

Code:

procedure Wiggle; override;

 

и, естественно, вы реализовали оба метода.

 

Теперь вы создаете TList, содержащий целую кучу MyObjects и OverrideObjects в свойстве TList.Items[n]. Свойство Items является указателем, поэтому для вызова метода Wiggle вам достаточно вызвать необходимый элемент списка. Например так:

 

Code:

if TObject(Items[1]) is TMyObject then

TMyObject(Items[1]).Wiggle

else

if TObject(Items[1]) is TOverrideObject then

TOverrideObject(Items[1]).Wiggle;

 

но возможности полиморфизма и директива override позволяют вам сделать так:

 

Code:

TMyObject(Items[1]).Wiggle;

 

Ваше приложение посмотрит на экземпляр специфического объекта, ссылка на который содержится в Items[1] и скажет: "Да, это - TMyObject, но, точнее говоря, это TOverrideObject; но поскольку метод Wiggle является виртуальным методом и TOverrideObject переопределил метод Wiggle, я собираюсь выполнить метод TOverrideObject.Wiggle, а не метод TMyObject.Wiggle."

 

Теперь представьте себе, что при декларации метода вы пропустили директиву override, попробуйте это выполнить теперь:

 

Code:

TMyObject(Items[1]).Wiggle;

 

 

Приложение и в этом случае должно "видеть" данный метод, даже если Items[1] - TOverrideObject; но у него отсутствует перекрытая версия метода Wiggle, поэтому приложение выполнит TMyObject.Wiggle, а не TOverrideObject.Wiggle (поведение, которое вы можете как хотеть, так и избегать).

 

Так, перекрытый метод функционально может отличаться от декларированного метода, содержащего директиву virtual (или dynamic) в базовом классе, и объявленный с директивой override в классе-наследнике. Для замены метода необходимо объявить его в классе-наследнике без директивы override. Перекрытые методы могут выполняться даже тогда, когда специфический экземпляр класса-предка является точной копией базового класса. "Замененные" методы могут выполняться только тогда, когда специфический экземпляр является "слепком" только этого класса.

 

 

Взято из Советов по Delphi отВалентина Озерова

Сборник Kuliba

Добавить комментарий
Подробности
Родительская категория: Объектное ориентирование
Категория: Методы