.
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;

  end;

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 г. )