Форум: "Основная";
Текущий архив: 2002.04.11;
Скачать: [xml.tar.bz2];
ВнизИ снова про вызовы функций-членов Найти похожие ветки
← →
Толик (2002-03-27 16:11) [0]В догонку к своему вопросу про вызовы ф-й членов от 26.03. А как быть в том случае, если надо через указатель вызывать виртуальные функции? Например:
TParent = class(TObject)
private
i: longint;
public
functon Mem_fnc(): longint; virtual; abstract;
end;
TChild_1 = class(TParent)
public
function Mem_fnc(): longint; override; //одна реализация
end;
TChild_2 = class(TParent)
public
function Mem_fnc(): longint; override; //другая реализация
end;
Что бы хотелось сделать:
- получить указатель на ф-ю Mem_fnc класса TParent (именно
РОДИТЕЛЬСКОГО класса, чтобы использовать разные реализации
этой ф-и в разных потомках)
- вызвать её для объектов типа TChild_1 и TChild_2
соответственно в СВОЕЙ РЕАЛИЗАЦИИ (а не получить AbstractError
как в случае использования TMethod).
TProc = procedure()of object;
var
Proc: TProc;
Par, Ch1, Ch2: TParent;
begin
Par := TParent.Create(0); //понятно, что будет warning, но меня интересует только указатель на ф-ю и ничего более...
Ch1 := TChild_1.Create(1);
Ch2 := TChild_2.Create(2);
Proc := Par.mem_fnc;
TMethod(Proc).Data := Ch1;
ShowMessage(IntToStr(Proc())); {вызов Mem_fnc, реализованной в
TParent (отсюла и AbstractError), но с данными Ch2, а
хотелось бы, чтобы для объекта каждого типа вызывалась своя
реализация ф-и Mem_fnc}
Par.Free();
Ch1.Free();
Ch2.Free();
end;
Причём в С++"ном примере от 26.03 всё работает замечательно...
Возможно ли вообще такое реализовать в Делфях???
← →
vuk (2002-03-27 16:31) [1]type
TFunc = function : longint;
var
func : TFunc;
.....
func := Par.mem_munc;
...
func := Ch1.mem_func;
....
func := Ch2.mem_func;
← →
reonid (2002-03-27 17:08) [2]Такая задача, насколько я её понял, стандартными языковыми средствами не предусмотрена.
Но можно найти положение виртуального метода в VMT и соответственно получить его адрес для любого производного класса:
type
PPtrArray = ^TPtrArray;
TPtrArray = array[0..MaxInd div 16] of Pointer;
TBase = class
function F; virtual; abstract;
end;
var vmt, pf: Pointer;
i, vmtIdx: Integer;
meth: TMethod;
derived: TBase;// Потомок
pf := @TBase.F;
vmtIdx := -1; // Ищем позицию метода в VMT
i := 0;
vmt := TBase;
repeat
if PPtrArray(vmt)^[i] = pf then
begin
vmtIdx := i;
Break;
end;
Inc(i);
until False;
meth.data := derived;
meth.code := PPtrArray(derived.ClassType)^[vmtIdx]; // находждениее адреса метода по индексу в VMT
meth(); // Выполнение
← →
vuk (2002-03-27 17:21) [3]То ли я все не правильно понимаю, то ли куда-то обсуждение не в ту сторону уходит...
to Толик:
Это случайно не то, что Вы хотели?
program Project1;
uses
SysUtils;
{$APPTYPE CONSOLE}
type
TFunc = function : longint of object;
TParent = class(TObject)
private
i: longint;
public
function Mem_fnc(): longint; virtual; abstract;
end;
TChild_1 = class(TParent)
public
constructor Create;
function Mem_fnc(): longint; override;
end;
TChild_2 = class(TParent)
public
constructor Create;
function Mem_fnc(): longint; override;
end;
{ TChild_1 }
constructor TChild_1.Create;
begin
inherited Create;
i := 1;
end;
function TChild_1.Mem_fnc: longint;
begin
Result := $FF000000 + i; //от балды
end;
{ TChild_2 }
constructor TChild_2.Create;
begin
inherited Create;
i := 2;
end;
function TChild_2.Mem_fnc: longint;
begin
Result := i;
end;
var
c1, c2 : TParent;
F : TFunc;
begin
c1 := TChild_1.Create;
c2 := TChild_2.Create;
F := c1.Mem_fnc;
writeln( Format( "%x", [F]) );
F := c2.Mem_fnc;
writeln( Format( "%x", [F]) );
C1.Free;
C2.Free;
readln; //созерцаем результаты
end.
← →
MBo (2002-03-27 17:37) [4]трудно бывает Сишников понять :)
мне кажется, что имеется в виду тривиальное наследование с перекрытием вирт. методов
TAnimal=class
constructor create;
function Say:string;virtual;abstract;
end;
TBird=class(TAnimal)
function Say:string;virtual;override;
end;
TMouse=class(TAnimal)
function Say:string;virtual;override;
end;
function TBird.Say;
begin
Result:="KuKu";
end;
function TMouse.Say;
begin
Result:="PiPi";
end;
var Animal:TAnimal;
if edit1.text="Mouse"
then Animal:=TMouse.Create
else Animal:=TBird.Create;
Animal.Say;// KuKu или PiPi
← →
MBo (2002-03-27 17:39) [5]ага, и Vuk то же пишет
← →
Толик (2002-03-27 17:45) [6]to reonid:
похоже что и правда придётся работать через vmt, я сам склоняюсь к такому решению, спасибо за пример.
to vuk:
это не совсем то, что я хотел. Допустим, есть массив неких объектов, причём разных типов, но унаследованных от некоего класса TMyClass. Я хочу написать ф-ю, которая бы пробегала в цикле по этому массиву и вызывала бы их виртуальную функцию-член, полученную в качестве параметра типа "указатель на ф-ю класса". Т.к. эта ф-я для каждого унаследованного класса реализована по своему, то и действия для каждого оюъекта будут свои. Например на С++ это делается так:
typedef void (TMyClass::*pmf)();
pmf p = &TMyClass::mem_fnc;
call_member(p);
/*Здесь я хочу заметить, что получаю адрес ф-и члена без создания экземпляра объекта, причём это НЕ СТАТИЧЕСКАЯ ф-я член, ну или выражаясь языком Делфей не class function!!!*/
void call_member(pmf p){
TMyClass1* pMC1 = new TMyClass1(1);
/*вызов через указатель ф-и mem_fnc для pMC1*/
(pMC1->*p)();
delete pMC1;
TMyClass2* pMC2 = new TMyClass2(2);
/*вызов через указатель ф-и mem_fnc для pMC2*/
(pMC2->*p)();
delete pMC2;
}
← →
reonid (2002-03-27 18:08) [7]>Толик ©
Я сейчас проверил - с абстракнными методами такое не пройдёт.
В VMT они все имеют одинаковый адрес.
(То, что дает взятие адреса @TBase.F - это какая-то фикция).
А не с абстрактными - вполне проходит.
Кстати, тот примерчик я писал с ходу и он не совсем корректен
Вот работающий пример:
TFunc = function: Integer of object;
PPtrArray = ^TPtrArray;
TPtrArray = array[0..MaxInt div 16] of Pointer;
TVirtMethod = record
BaseClass: TClass;
Index: Integer;
end;
TBase = class
function F: Integer; virtual;
end;
TDerived = class (TBase)
function F: Integer; override;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function TBase.F: Integer;
begin
Result := 0;
end;
function TDerived.F: Integer;
begin
Result := 123;
end;
function AddressToVMTIndex(VMT, Meth: Pointer): Integer;
var i: Integer;
begin
Result := -1;
i := 0;
repeat
if PPtrArray(vmt)^[i] = Meth then
begin
Result := i;
Exit;
end;
Inc(i);
until i = 100000;
end;
function VMTIndexToAddress(VMT: Pointer; Index: Integer): Pointer;
begin
Result := PPtrArray(VMT)^[Index];
end;
function GetVirtMethod(VMT, Meth: Pointer): TVirtMethod;
begin
Result.BaseClass := TClass(VMT);
Result.Index := AddressToVMTIndex(VMT, Meth);
end;
function GetStaticMethod(Instance: TObject; VirtMethod: TVirtMethod): TMethod;
begin
Result.Code := nil;
Result.Data := nil;
if Instance.InheritsFrom(VirtMethod.BaseClass) then
begin
Result.Data := Instance;
Result.Code := VMTIndexToAddress(Instance.ClassType, VirtMethod.Index);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var vmt, pf: Pointer;
VirtMeth: TVirtMethod;
meth: TFunc;
derived: TBase;// Потомок
begin
pf := @TBase.F;
VirtMeth := GetVirtMethod(TBase, pf);
derived := TDerived.Create;
try
TMethod(meth) := GetStaticMethod(derived, VirtMeth);
if Assigned(meth) then Caption := IntToStr(meth);
finally
derived.Free;
end;
end;
← →
vuk (2002-03-27 18:15) [8]При решении подобной задачи я пошел бы другим путем.
Допустим, что
TBase = class
procedure A;
procedure B;
end;
type
TActionProc = ptocedure( Instance : TBase );
procedure WalkAray( A: array of TBase; ActionProc : TActionProc );
var
i : integer;
begin
if Assigned( ActionProc ) then
for i := Low( A ) to High(A) do
ActionProc( a[i] );
end;
И потом уже
procedure CallA( Instance : TBase );
begin
if instance <> nil then
Instance.A;
end;
procedure CallB( Instance : TBase );
begin
if instance <> nil then
Instance.B;
end;
var
ar : array of TBase;
....
WalkArray( ar, CallA );
WalkArray( ar, CallB );
← →
Набережных С. (2002-03-27 20:04) [9]
> Толик © (27.03.02 17:45)
Это как раз то, что написали MBo © (27.03.02 17:37) и vuk © (27.03.02 17:21).
TMyClass = class...
function MyFunction...;virtual;abstract;
Наследуешь классы от него и в них перекрываешь MyFunction. Массив, например, такой(или любой другой):
MyObjArray : array of TMyClass;
Заполняешь массив потомками TMyClass и вызываешь такую процедуры:
procedure MyEnumProc(A: array of TMyClass);
var
n:integer;
begin
for n:=0 to Length(A)-1 do
A[n].MyFunction...
end;
Для каждого объекта будет вызван метод именно его класса или унаследованный, если в классе он не переопределен. В этом и состоит смысл виртуальных и динамических методов.
А создавать экземпляры классов с абстрактными методами не следует. Никогда.
← →
Толик (2002-03-28 10:01) [10]for all:
Меня интересует не то как вызывать виртуальные функции-члены, а то как их вызывать через УКАЗАТЕЛИ!!! Улавливаете разницу? Не важно на какую ф-ю указывает указатель, главное, чтобы принимаемые и возвращаемые параметры совпадали. А вот с этим-то и проблема: невозможно (пожалуй кроме как через vmt) имея указатель на ф-ю в классе-родителе вызвать её реализацию для класса-потомка.
← →
vuk (2002-03-28 11:08) [11]to Толик:
Я понял Вашу проблему еще вчера. У меня вызывает сомнение надежность такго подхода. Потому как придется копаться в VMT, и при этом если вруг окажется, что в одном из элементов массива находится экземпляр какого-то не того класса, то о последствиях можно будет только догадываться. Я Вам предложил технику, которая является компромиссом - для каждого элемента вызывается callback функция, которая может варьироваться.
← →
Shaman_Naydak (2002-03-28 11:58) [12]Мда, любит у нас народ создавать себе трудности, чтобы потом их с восторгом преодолевать...
← →
Набережных С. (2002-03-28 16:09) [13]
> Толик © (28.03.02 10:01)
Я просто полагал, что остальное понятно и без слов. Не нужно так делать. Такой подход корректен на низком уровне, но он в корне противоречит принципам и полиморфизма, и инкапсуляции, а среда делфи строго их придерживается, и проблемы не заставят себя долго ждать. Тем более что задачу можно решить множеством нормальных способов. Например, передачей в качестве параметра не метода, а условия, по которому он выбирается. Ну и т.д.
← →
Толик (2002-03-28 17:47) [14]to Набережных С.
Ну насчёт строгого соответствия требованиям инкапсуляции в Делфях я бы не был столь категоричен. Вы ни когда не пробовали присваивать значение св-ву, которое объявлено readonly???
TForm((@Application.MainForm)^) := Form2;
так и константе значения можно присваивать!!!
const
i: string = "Это константа?";
begin
string((@i)^) := "Ну и что это за константа после этого???";
ShowMessage(i);
end;
Я конечно никого не призываю так писать, но факт остаётся фактом.
А вот нормальный вызов функции-члена-класса (виртуальной) через указатель в Делфях не реализован. Да, конечно, как вариант можно в каждом классе создать массив указателей на ф-и-члены, заполнять его в конструкторе, а в свой алгоритм передавать номер эл-та массива. Но ведь это получается копирование vmt, некий свой аналог. Причём если кто-то будет наследоваться от моего класса, он должен помнить, что ему необходимо заполнить этот массив указателями на свои ф-и-члены.
Ну, или как предложил vuk © писать отдельно ф-ю для вызова соответствующей ф-и-члена. А будет у меня 100 таких функций? И каждый раз их дублировать только потому, что где-то в недрах своего алгоритма она использует вызов ф-и-члена?
Тоскливо становится...
← →
MBo (2002-03-28 18:24) [15]MethodAddress?
← →
Толик (2002-03-28 18:40) [16]to MBo ©
К сожалению это не решает проблему вызова своей реализации виртуальной ф-и для классов-наследников при получении адреса ф-и класса-родителя:
TChild = class(TParent)
var
P: TParent;
Child: TChild;
mtd: TMethod;
begin
mtd.Code := P.MethodAddress("MyFnc");
mtd.Data := Child;
MyFnc(mtd)(); //вызов MyFnc, реализованной в TParent - потенциальная возможность получить AbstractError
end;
← →
vuk (2002-03-28 19:02) [17]to Толик:
>так и константе значения можно присваивать!!!
>const
> i: string = "Это константа?";
А кто сказал, что это настоящая константа? Это же обычная переменная. Можно, конечно, заставить компилятор ругаться на явное присвоение ей значения, но переменной она от этого быть не перестанет. А у каждой переменной, как водится, адрес есть...
>А будет у меня 100 таких функций? И каждый раз их дублировать
Зачем же каждый раз дублировать-то?
А вообще говоря, уже неоднократно писали о том, что для каждого языка нужно решать задачи естественными для него методами, а не переписыванием алгоритмов с других языков один в один.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.04.11;
Скачать: [xml.tar.bz2];
Память: 0.51 MB
Время: 0.008 c