Delphi Изнутри. Урок 10. Класс TObject. Функция MethodAddress.

Автор megabax

07.02.2011 г.

New Page 2

Delphi Изнутри. Урок 10. Класс TObject. Функция MethodAddress.

Допустим, нам надо поменять событие OnMouseMoveвсем элементам фоpмы. Или же нужно сбросить свойство Hint у всех элементов, у которых это оно есть. Контpолы могут быть самые pазные TEdit, TLabel, TListView и т.п. Такие возможности есть в Delphi, более того, на них построена вся среда визуальной разработки IDE Delphi.

Для справки:

Run-time type information (RTTI) - это специальный механизм определения типа объекта во время выполнения. Чаще всего это актуально для определения типа объекта по указателю. Многие каркасные библиотеки самостоятельно поддерживают этот механизм. В том числе и VCL.

Приведем пример использования данного механизма в Delphi. Для начала рассмотрим работу с методами, а затем - со свойствами.

Следующий пример устанавливает у всех компонентов на форме обработчик OnMouseMove на собственную процедуру.

unit ex10_1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, TypInfo, StdCtrls;

type

TfrmMethodAddress = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

procedure FormCreate(Sender: TObject);

//...эта функция обязательно должна быть описана здесь, а не в одном из

// следующих pазделов, иначе MethodAddress() ее не видит.

procedure CommonMouseMove (Sender: TObject;

Shift: TShiftState; X, Y: Integer);

private

public

procedure SetEventMethodToAllComponentsInForm( FormX: TForm );

end;

var

frmMethodAddress: TfrmMethodAddress;

implementation

{$R *.dfm}

procedure TfrmMethodAddress.FormCreate(Sender: TObject);

begin

//...пеpедадим для пpобы ссылку на эту же фоpму

SetEventMethodToAllComponentsInForm( self );

end;

procedure TfrmMethodAddress.SetEventMethodToAllComponentsInForm( FormX: TForm );

var

PropInfo: PPropInfo;

i: integer;

CommonMethod: TMethod;

begin

for i:=0 to FormX.ComponentCount-1 do

begin

PropInfo := GetPropInfo( FormX.Components[i].ClassInfo, 'OnMouseMove');

if PropInfo <> nil then

begin

CommonMethod.Data := FormX.Components[i];

CommonMethod.Code := frmMethodAddress.MethodAddress('CommonMouseMove');

SetMethodProp(FormX.Components[i], PropInfo, CommonMethod );

end;

procedure TfrmMethodAddress.CommonMouseMove (Sender: TObject;

Shift: TShiftState; X,Y: Integer);

begin

ShowMessage('Мы подвели к объекту мышку!');

end;

end.

Данная программа у всех элементов формы (в данном примере это три метки TLabel) установит один обработчик события на подвод мышки. Для особо любознательных привожу ассемблерный текст с русскими комментами:

; -> EAX Указатель на класс

; EDX Указатель на имя

PUSH EBX

PUSH ESI

PUSH EDI

XOR ECX,ECX

XOR EDI,EDI

MOV BL,[EDX]

JMP @@haveVMT

@@outer: ; верхние 16 бит ECX равно 0

MOV EAX,[EAX]

@@haveVMT:

MOV ESI,[EAX].vmtMethodTable

TEST ESI,ESI

JE @@parent

MOV DI,[ESI] ; EDI := method count

ADD ESI,2

@@inner: ; верхние 16 бит ECX равно 0

MOV CL,[ESI+6] ; сравниваем длину строк

CMP CL,BL

JE @@cmpChar

@@cont: ; верхние 16 бит ECX равно 0

MOV CX,[ESI] ; получим длину описания метода

ADD ESI,ECX ; указатель ESI на следующий метод

DEC EDI

JNZ @@inner

@@parent:

MOV EAX,[EAX].vmtParent ; получим родительскую vmt

TEST EAX,EAX

JNE @@outer

JMP @@exit ; возвратим NIL (пустой указатель)

@@notEqual:

MOV BL,[EDX] ; восстановим в BL длину имени

JMP @@cont

@@cmpChar: ; верхние 16 бит ECX равно 0

MOV CH,0 ; верхние 24 бит ECX равно 0

@@cmpCharLoop:

MOV BL,[ESI+ECX+6] ; сравнение без учета регистра символа

XOR BL,[EDX+ECX+0] ; последний символ сравниваем с первым

AND BL,$DF

JNE @@notEqual

DEC ECX ; ECX служит счетчиком

JNZ @@cmpCharLoop

; нашли его

MOV EAX,[ESI+2]

@@exit:

POP EDI

POP ESI

POP EBX

Последнее обновление ( 05.06.2013 г. )

« След.		Пред. »

Вернуться