Форум: "Основная";
Текущий архив: 2002.04.11;
Скачать: [xml.tar.bz2];
ВнизИ снова про вызовы функций-членов Найти похожие ветки
← →
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;
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2002.04.11;
Скачать: [xml.tar.bz2];
Память: 0.44 MB
Время: 0.007 c