Субклассирование - это метод перехвата сообщений, с помощью собственной функции окна, подменяющей исходную. т.е. Вы подсовываете Windows собственную функцию для обработки сообщения окну.
Private Declare Function SetWindowLong Lib "user32" Alias _ "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Private Declar Function CallWindowProc Lib "user32" Alias _ "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, _ ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 'одна из констант SetWindowLong/GetWindowLong Private Const GWL_WNDPROC = (-4) 'Эти 3 константы - чисто для примера Private Const WM_MOUSEWHEEL = &H20A Private Const WM_HSCROLL = &H114 Private Const WM_VSCROLL = &H115 'В этой переменной будет храниться указатель 'на стандартную функцию процессинга меседжей, 'пока работает наша функция. 'По завершении работы субкласса нужно будет 'вернуть его окну Public lngPrevProc As Long '*********************************** ' 1. Пишем функцию обратного вызова WindowProc ' и помещаем в один из глобальных модулей Public Function WindowProc(ByVal hWnd As Long, _ ByVal Msg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long On Error Resume Next 'здесь размещаем блок If...Then...Else или Select Case 'для отлова нужного нам значения месседжа и определения 'соответствующего ему действия. 'Значения констант месседжей можно посмотреть, 'например, в файлах заголовков в комплекте VisualStudio '(наиболее употребительные описаны в Winuser.h) 'Например, перехватим событие прокрутки формы: If Msg = WM_MOUSEWHEEL Or Msg = WM_HSCROLL Or Msg = WM_VSCROLL Then 'здесь пишем то, что у нас должно выполняться Else 'иначе: передаем через CallWindowProc меседж самому окну по адресу lngPrevProc 'чтобы оно могло его стандартно обработать (если нам это нужно) WindowProc = CallWindowProc(lngPrevProc, hWnd, Msg, wParam, lParam) End If End Function
'следующие две функции устанавливают и снимают хук на окно Public Sub SetHook(hWnd As Long) On Error Resume Next 'SetWindowLong возвращает адрес текущей функции процессинга меседжей. 'Мы этот адрес запоминаем в lngPrevProc и подсовываем окну адрес нашей 'функции WindowProc, запустив ее через AddressOf lngPrevProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc) End Sub
Public Sub ClearHook(hWnd As Long) On Error Resume Next 'По завершению работы субкласса нужно вернуть окну адрес 'его собственной стандартной функции процессинга, который мы 'запомнили в lngPrevProc Call SetWindowLong(hWnd, GWL_WNDPROC, lngPrevProc) End Sub
'Теперь для начала работы субкласса вызовите SetHook и передайте 'ей хендл нужного нам окна. 'По завершению (напр. при закрытии формы) вызовите с тем же параметром 'функцию ClearHook 'ВНИМАНИЕ!!! Если до начала работы субкласса был загружен 'редактор VBA, субкласс может (и будет!) работать некорректно!!! 'Закройте Access, потом снова откройте и запустите пример. 'Т.к. в MSA 97 нет оператора AddressOf вместо него необходимо 'использовать функцию AddrOf, код которой можно взять по адресу : '"http://am.rusimport.ru/MSAccess/topic.aspx?ID=405" |
Просмотров: 10119
Ваш коментарий будет первым | | |