' Class module for ActiveX dll
Option Compare Text
Option Explicit
Private frm As Object
Private intCancel As Integer
Public Event MouseWheel(Cancel As Integer)
Public Property Set Form(frmIn As Object)
Set frm = frmIn
End Property
Public Property Get MouseWheelCancel() As Integer
MouseWheelCancel = intCancel
End Property
Public Sub SubClassHookForm()
lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, _
AddressOf WindowProc)
Set CMouse = Me
End Sub
Public Sub SubClassUnHookForm()
Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Public Sub FireMouseWheel()
RaiseEvent MouseWheel(intCancel)
End Sub
' Standard Module Code
Option Compare Text
Option Explicit
Public CMouse As CMouseWheel
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare 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
Public Const GWL_WNDPROC = -4
Public Const WM_MouseWheel = &H20A
Public lpPrevWndProc As Long
Public Function WindowProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Select Case uMsg
Case WM_MouseWheel
CMouse.FireMouseWheel
If CMouse.MouseWheelCancel = False Then
WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End If
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End Select
End Function
' Subs coded: Form LOAD Code/ Form CLOSE code/ clsMouseWheel_MouseWheel code
' Make sure you have referenced the MouseWheel.dll before you insert this code. Also
' Ensure that you are not going to overwriite an existing code if you are cutting and
' pasting. Either copy before or after you existing code.
Option Compare Database
Option Explicit
Private WithEvents clsMouseWheel As MouseWheel.CMouseWheel
Private Sub Form_Load()
Set clsMouseWheel = New MouseWheel.CMouseWheel
Set clsMouseWheel.Form = Me
clsMouseWheel.SubClassHookForm
End Sub
Private Sub Form_Close()
clsMouseWheel.SubClassUnHookForm
Set clsMouseWheel.Form = Nothing
Set clsMouseWheel = Nothing
End Sub
Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
MsgBox "The Mouse Wheel has been disabled. Record shouldn't advance."
Cancel = True
End Sub
|