Использование Hook-процедур для создания компонентов

Ранее уже упоминалось, что каждый потомок TWinControl имеет процедуру, которая принимает и обрабатывает сообщения. Если имеется ссылка на дескриптор окна (HWND), то можно определить адрес этой процедуры и, что более важно, подменить этот адрес и таким образом обрабатывать получаемые сообщения своим способом. Как правило, никто не пишет полностью обработчики всех сообщений; чаще вызывается старый метод по умолчанию. При этом новая процедура используется как фильтр: при поступлении какого-либо события выполняется код. Фактически это «шпион» в TwinControl: нас уведомляют о приходе какого-либо сообщения и можно выполнить какой-либо код. При правильной реализации Hook-процедуры TWinControl продолжает работать как обычно, не подозревая, что своими сообщениями он делится с кем-то еще.

Hook-процедура определяется следующим образом:

procedure(var Message:TMessage) of object;

Она зависит от переменной типа TMessage, в которой содержится вся информация о сообщении. Но определить эту процедуру – недостаточно. Она должна копироваться для каждого TWinControl, к которому будет присоединена. Это достигается вызовом WinAPI-метода MakeObjectInstance. В качестве параметра этот метод принимает метод объекта, делает его копию в памяти и возвращает адрес нового метода. Понятно, что при этом резервируются системные ресурсы, которые необходимо вернуть системе. Это достигается вызовом метода FreeObjectInstance.

Еще одно важное условие: перед разрушением TWinControl должна быть восстановлена связь со старой процедурой обработки сообщений, иначе ресурсы не будут возвращены системе. Значит, придется запоминать указатель на старую процедуру, который можно узнать вызовом метода Win API GetWindowLong с параметром GWL_WNDPROC. Этот указатель будет использоваться также для вызова обработчиков событий TWinControl по умолчанию. Обратный метод — SetWindowLong — используется для установки Hook-процедуры.

Итак, сформулируем задачу для следующего упражнения. Предположим, мы хотим создать компонент, который будет заставлять пищать при нажатии кнопки мыши другие компоненты – потомки TWinControl. Понятно, что данный компонент не следует показывать во время выполнения приложения, поэтому в качестве его класса-предка выберем TComponent. Имя класса определим как TBeepWnd. В секции private определим три переменные:

FOldProc,FNewProc:pointer;

FControl:TWinControl;

Из названий ясно, что мы будем запоминать ссылку на старую процедуру в переменной FOldProc, ссылка на новую процедуру (после выполнения метода MakeObjectInstance) будет храниться в переменной FNewProc. И в переменной FControl будем сохранять ссылку на элемент управления, на который в данный момент «повешена» Hook-процедура. Определим три метода в этой же секции:

procedure HookProc(var Message:TMessage);

procedure HookWindow(W:TWinControl);

procedure UnhookWindow;

и в секции implementation реализуем их:

1. procedure TBeepWnd.HookProc(var Message:TMessage);

2. begin

3. case Message.Msg of

4. WM_LBUTTONDOWN:begin {Our task}

5. Beep;

6. Message.Result:=CallWindowProc(FOldProc, FControl.Handle, Message.Msg, Message.WParam, Message.lParam);

7. end;

8. WM_DESTROY:begin {When window is about destroying, remove hook}

9. Message.Result:=CallWindowProc(FOldProc, FControl.Handle, Message.Msg, Message.WParam, Message.lParam);

10. UnhookWindow;

11. end;

12. {Call default handler}

13. else Message.Result:=CallWindowProc(FOldProc, FControl.Handle, Message.Msg, Message.WParam, Message.lParam);

14. end;

15. end;

В самой Hook-процедуре перехватывается сообщение, на которое происходит реакция – WM_LBUTTONDOWN. Кроме того, любая Hook-процедура обязана обрабатывать сообщение WM_DESTROY. Это последнее сообщение, которое передается окну перед тем, как оно будет разрушено. Наша реакция – восстановить предыдущий метод вызовом описанного ниже метода UnhookWindow. И наконец, везде вызываются обработчики сообщений по умолчанию посредством метода CallWindowProc. Забыть обработчик события по умолчанию – то же самое, что забыть inherited в обработчике события, в 80% случаев это приведет к некорректному поведению приложения. Ни в коем случае нельзя забывать присваивать результат вызова метода CallWindowProc полю Result переменной Message! Код в этом случае работать не будет!

1. procedure TBeepWnd.HookWindow(W:TWinControl);

2. begin

3. if csDesigning in ComponentState then begin {Checking if component at design or run-time}

4. FControl:=W;

5. Exit;

6. end;

7. if FControl<>nil then UnhookWindow; {Remove hook if it was previously installed}

8. if W<>nil then begin

9. FOldProc:=pointer(GetWindowLong(W.Handle,GWL_WNDPROC)); {Determines address of old procedure}

10. FNewProc:=MakeObjectInstance(HookProc); {Make copy in memory}

11. SetWindowLong(W.Handle,GWL_WNDPROC,integer(FNewProc)); {Set new procedure}

12. end;

13. FControl:=W; {Store reference at control}

14. end;

Этот метод используется для установки новой процедуры обработки сообщений. Сначала проверяется, на каком из этапов находится данный компонент: на этапе разработки или на этапе выполнения. Если компонент находится на этапе разработки, то есть выставлен флаг csDesigning в свойстве ComponentState, то сохраняется просто ссылка на компонент без установки Hook-процедуры. Это сделано для того, чтобы избежать установки Hook-процедуры на среду разработки Delphi. Если ранее эта процедура была установлена на другом элементе управления, она снимается посредством вызова метода UnhookWindow. После этого запоминается адрес старой процедуры (GetWindowLong), делается копия в памяти новой процедуры (MakeObjectInstance) и выставляется адрес новой процедуры (SetWindowLong). Используется приведение типов от integer к pointer, и наоборот – вызываемые методы требуют (или возвращают) переменные не совсем подходящих типов. И наконец, ссылка на элемент управления запоминается в переменной FControl, которую мы определили в секции private.

1. procedure TBeepWnd.UnhookWindow;

2. begin

3. if (FControl=nil) or (FOldProc=nil) or (FNewProc=nil) then Exit; {No hook was installed}

4. SetWindowLong(FControl.Handle,GWL_WNDPROC,integer(FOldProc)); {Set old window procedure}

5. FreeObjectInstance(FNewProc); {Free resources}

6. FControl:=nil; {Initiate variables}

7. FOldProc:=nil;

8. FNewProc:=nil;

9. end;

Данный метод восстанавливает старый обработчик события. Он вызывается из метода HookProc и должен еще вызываться из деструктора компонента – снимать Hook необходимо как при разрушении окна, так и при разрушении данного компонента. Метод SetWindowLong c адресом старого метода восстанавливает старый обработчик сообщений. После этого следует вернуть ресурсы системе вызовом метода FreeObjectInstance.

Итак, базовые методы для работы с Hook-процедурой определены. Теперь необходимо переписать деструктор, чтобы Hook-процедура снималась при разрушении данного компонента:

1. destructor TBeepWnd.Destroy;

2. begin

3. UnhookWindow;

4. inherited Destroy;

5. end;

И наконец, в секции published определим свойство, которое будет отображаться в инспекторе объектов:

property Control:TWinControl read FControl write HookWindow;

Для установки нового компонента ссылаемся на ранее определенный метод, который во время выполнения приложения немедленно «повесит» Hook-процедуру на компонент, который станет пищать при нажатии кнопки. Напомним, что вместо оператора Beep можно написать любой исполняемый код.

Тестируется компонент достаточно просто: ставится на форму, на которую ставятся и несколько компонентов-потомков TWinControl. После выбора на фоне компонента TBeepWnd при щелчке мышью в инспекторе объектов на поле Control разворачивается список, в котором присутствуют все определенные на форме TWinControl. Следует выбрать один из них и запустить приложение. При нажатии левой кнопки мыши на выбранном компоненте он издает писк.