Mouse Whell в Access

[Andrey Fedorov]

Надо чтобы мышиным колесиком можно было крутить listbox и переключать группу кнопок, все в Access. Желательна реализация в виде класса.

Никто не встречал подобного???

[alibek]

Сам как-то делал, кодом, строчек 15-20, пойдет? Класс не делал, чтобы не заморачиваться с сабклассингом.

[Andrey Fedorov]

Сам как-то делал, кодом, строчек 15-20, пойдет? Класс не делал, чтобы не заморачиваться с сабклассингом.

Давай - посмотрим...

[alibek]

Код: Выделить всё

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMessage As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal uMessage As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const GWL_WNDPROC As Long = (-4&)
Private lpPrevWndProc As Long, vWheelScrollLines As Long

Public Enum SystemParametersActions
  spiGetBeep = 1
  spiSetBeep = 2
  spiGetMouse = 3
  spiSetMouse = 4
  spiGetBorder = 5
  spiSetBorder = 6
  spiGetKeyboardSpeed = 10
  spiSetKeyboardSpeed = 11
  spiLangDriver = 12
  spiIconHorizontalSpacing = 13
  spiIconVerticalSpacing = 24
  spiGetScreebSaveTimeout = 14
  spiSetScreenSaveTimeout = 15
  spiGetScreenSaveActive = 16
  spiSetScreenSaveActive = 17
  spiGetGridGranularity = 18
  spiSetGridGranularity = 19
  spiSetDeskWallPaper = 20
  spiSetDeskPattern = 21
  spiGetKeyboardDelay = 22
  spiSetKeyboardDelay = 23
  spiGetIconTitleWrap = 25
  spiSetIconTitleWrap = 26
  spiGetMenuDropAlignment = 27
  spiSetMenuDropAlignment = 28
  spiSetDoubleClkWidth = 29
  spiSetDoubleClkHeight = 30
  spiGetIconTitleLogFont = 31
  spiSetIconTitleLogFont = 34
  spiSetDoubleClickTime = 32
  spiSetMouseButtonSwap = 33
  spiGetFastTaskSwitch = 35
  spiSetFastTaskSwitch = 36
  spiSetDragFullWindows = 37
  spiGetDragFullWindows = 38
  spiGetNonClientMetrics = 41
  spiSetNonClientMetrics = 42
  spiGetMinimizedMetrics = 43
  spiSetMinimizedMetrics = 44
  spiGetIconMetrics = 45
  spiSetIconMetrics = 46
  spiSetWorkArea = 47
  spiGetWorkArea = 48
  spiSetPenWindows = 49
  spiGetHighContrast = 66
  spiSetHighContrast = 67
  spiGetKeyboardPref = 68
  spiSetKeyboardPref = 69
  spiGetScreenReader = 70
  spiSetScreenReader = 71
  spiGetAnimation = 72
  spiSetAnimation = 73
  spiGetFontSmoothing = 74
  spiSetFongSmoothing = 75
  spiSetDragWidth = 76
  spiSetDragHeight = 77
  spiSetHandHeld = 78
  spiGetLowPowerTimeout = 79
  spiSetLowPowerTimeout = 81
  spiGetPowerOffTimeout = 80
  spiSetPowerOffTimeout = 82
  spiGetLowPowerActive = 83
  spiSetLowPowerActive = 85
  spiGetPowerOffActive = 84
  spiSetPowerOffActive = 86
  spiSetCursors = 87
  spiSetIcons = 88
  spiGetDedaultInputLang = 89
  spiSetDefaultInputLang = 90
  spiSetLangToggle = 91
  spiGetWindowsExtension = 92
  spiSetMouseTrails = 93
  spiGetMouseTrails = 94
  spiSetScreenSaverRunning = 97
  spiGetScreenSaverRunning = 114
  spiScreenSaverRunning = spiSetScreenSaverRunning
  spiGetFilterKeys = 50
  spiSetFilterKeys = 51
  spiGetToggleKeys = 52
  spiSetToggleKeys = 53
  spiGetMouseKeys = 54
  spiSetMouseKeys = 55
  spiGetShowSounds = 56
  spiSetShowSounds = 57
  spiGetStickyKeys = 58
  spiSetStickyKeys = 59
  spiGetAccessTimeout = 60
  spiSetAccessTimeout = 61
  spiGetSerialKeys = 62
  spiSetSerialKeys = 63
  spiGetSoundSentry = 64
  spiSetSoundSentry = 65
  spiGetMouseHoverWidth = 98
  spiSetMouseHoverWidth = 99
  spiGetMouseHoverHeight = 100
  spiSetMouseHoverHeight = 101
  spiGetMouseHoverTime = 102
  spiSetMouseHoverTime = 103
  spiGetWheelScrollLines = 104
  spiSetWheelScrollLines = 105
  spiGetShowIMEUI = 110
  spiSetShowIMEUI = 111
  spiGetMouseSpeed = 112
  spiSetMouseSpeed = 113
  spiGetActiveWindowTracking = &H1000&
  spiSetActiveWindowTracking = &H1001&
  spiGetMenuAnimation = &H1002&
  spiSetMenuAnimation = &H1003&
  spiGetComboBoxAnimation = &H1004&
  spiSetComboBoxAnimation = &H1005&
  spiGetListBoxSmoothScrolling = &H1006&
  spiSetListBoxSmoothScrolling = &H1007&
  spiGetGradientCaptions = &H1008&
  spiSetGradientCaptions = &H1009&
  spiGetMenuUnderlines = &H100A&
  spiSetMenuUndetlines = &H100B&
  spiGetActiveWndTrkZOrder = &H100C&
  spiSetActiveWndTrkZOrder = &H100D&
  spiGetHotTracking = &H100E&
  spiSetHotTracking = &H100F&
  spiGetForegroundLockTimeout = &H2000&
  spiSetForegroundLockTimeout = &H2001&
  spiGetActiveWndTrkTimeout = &H2002&
  spiSetActiveWndTrkTimeout = &H2003&
  spiGetForegroundFlashCount = &H2004&
  spiSetForegroundFlashCount = &H2005&
End Enum
Public Enum SystemParametersFlags
  spifNotUpdate = 0&
  spifUpdateINIFile = &H1&
  spifSendWinINIChange = &H2&
  spifSendChange = spifSendWinINIChange
End Enum
Public Declare Function SystemParametersInfo Lib "user32" _
  Alias "SystemParametersInfoA" ( _
   ByVal uAction As SystemParametersActions, _
   ByVal uParam As Long, _
   lpvParam As Any, _
   ByVal fuWinIni As SystemParametersFlags) _
  As Long

Private Sub MouseScrollHook()
If lpPrevWndProc <> 0 Then Exit Sub
lpPrevWndProc = SetWindowLong(frmMAIN.hWnd, GWL_WNDPROC, AddressOf frmMAIN_WndProc_Scroll)
If SystemParametersInfo(spiGetWheelScrollLines, 0&, vWheelScrollLines, spifNotUpdate) = 0 Then vWheelScrollLines = 3
End Sub

Private Sub MouseScrollUnHook()
If lpPrevWndProc = 0 Then Exit Sub
Call SetWindowLong(frmMAIN.hWnd, GWL_WNDPROC, lpPrevWndProc)
vWheelScrollLines = 0&
End Sub

Function frmMAIN_WndProc_Scroll(ByVal hWnd As Long, ByVal uMessage As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const WM_MOUSEWHEEL As Long = &H20A&
Const WHEEL_DELTA As Long = 120&
Const WHEEL_PAGESCROLL As Long = (-1&)
frmMAIN_WndProc_Scroll = CallWindowProc(lpPrevWndProc, hWnd, uMessage, wParam, lParam)
If uMessage = WM_MOUSEWHEEL Then
  If wParam < 0 Then
    Call frmMAIN.MouseScroll(-vWheelScrollLines, lParam And &HFFFF&, lParam \ &HFFFF&)
  Else
    Call frmMAIN.MouseScroll(vWheelScrollLines, lParam And &HFFFF&, lParam \ &HFFFF&)
  End If
End If
End Function


Вроде бы ничего не забыл.
Если убрать ненужные ENum-ы и API-функции, как раз останется 15-20 строк.

[Andrey Fedorov]

Тут еще такое обнаружилось:

http://www.mvps.org/access/api/api0036.htm