Troitsky
Водник Водкин | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
PavelO
Цитата:| спасибо за ссылку, только вот что-то не работает этот код |
Ну так напильником нужно было доработать! 
Цитата:| я имел ввиду менять положение ScrollTop колесом мышки |
С такой штукой никогда не работал, поэтому опять мог понять неправильно. Доработал код из того примера, что давал тебе и вот что получилось.
Код модуля:
Код: Option Explicit
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public hW As Long ' Хендл пользовательской формы
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowTextA Lib "user32" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private lpPrevWndProc As Long, Wheel As Integer
Sub Hook(hwnd As Long)
lpPrevWndProc = SetWindowLongA(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Sub UnHook(hwnd As Long)
SetWindowLongA hwnd, GWL_WNDPROC, lpPrevWndProc
End Sub
Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo xErr
If uMsg = WM_MOUSEWHEEL Then
If wParam = -7864320 Or wParam = -23592960 Or wParam = -15728640 Then
myForm.Scroll , fmScrollActionLineDown ' скролим вниз
ElseIf wParam = 7864320 Or wParam = 23592960 Or wParam = 15728640 Then
myForm.Scroll , fmScrollActionLineUp ' скролим вверх
End If
Else
WindowProc = CallWindowProcA(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End If
xErr:
End Function |
Код формы:
Код: Option Explicit
Private Sub UserForm_Initialize()
hW = FindWindow(vbNullString, Me.Caption & Chr(0))
Hook hW
End Sub
Private Sub UserForm_Terminate()
UnHook hW
End Sub |
Тестовый пример:
Цитата:
Если перемудрил и для такого в самом Excel VBA предусмотрена возможность - звиняйте - не работал, не ведаю. Кто если в курсе дела, тогда поправьте меня.
----------
Мы в хорошем настроении гуляем по лесам.
Кто обидеть нас захочет – сам получит по усам.
Сам полу- получит по усам. Сам полу- получит по усам! |
|
Всего записей: 795 | Зарегистр. 13-12-2003 | Отправлено: 20:03 22-11-2006 | Исправлено: Troitsky, 20:04 22-11-2006 |
|
) 
.