none
[Access 2003 + VBA] Disable Mousewheel scrolling from a record to another in a form

    Question

  • Hi,

    I want to prevent the user from scrolling from a reccord to a record threw the mouse wheel by error, so I made this code:

    'Prevent records from changing if mouse wheel used
    Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
    Dim modCancel As Boolean
        modCancel = True
    End Sub
    
    'Prevent system from updating DB if mouse wheel used
    Private Sub Form_BeforeUpdate(Cancel As Integer)
    Dim modCancel As Boolean
        If modCancel = True Then
            MsgBox "You cannot use the mousewheel to scroll through records. Use PageUp and PageDown.", vbOKOnly + vbInformation
            Cancel = True
            modCancel = False
        End If
    End Sub
    


    but, it seems to not work, if fact, I receive no error message and mouse wheel scrolling is still allowed...

    How do i fix this, please?

    Sincerly

    Monday, September 26, 2011 6:15 PM

Answers

  • Hi,
     
    I couldn't understand his basMouseHook, so, I found another one much easier to understand and without licence!
    basMouseHook code:
     
    Option Compare Database
    Option Explicit
    
    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 CMouse As CMouseWheel
    
    Public Function WindowProc(ByVal hwnd As Long, _
        ByVal uMsg As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long) As Long
    
        'Look at the message passed to the window. If it is
        'a mouse wheel message, call the FireMouseWheel procedure
        'in the CMouseWheel class, which in turn raises the MouseWheel
        'event. If the Cancel argument in the form event procedure is
        'set to False, then we process the message normally, otherwise
        'we ignore it.  If the message is something other than the mouse
        'wheel, then process it normally
        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
    
    
    
    CMouseWheel code:
    Option Compare Database
    
    Option Explicit
    
    Private frm As Access.Form
    Private intCancel As Integer
    Public Event MouseWheel(Cancel As Integer)
    
    Public Property Set Form(frmIn As Access.Form)
        'Define Property procedure for the class which
        'allows us to set the Form object we are
        'using with it. This property is set from the
        'form class module.
        Set frm = frmIn
    End Property
    
    Public Property Get MouseWheelCancel() As Integer
        'Define Property procedure for the class which
        'allows us to retrieve whether or not the Form
        'event procedure canceled the MouseWheel event.
        'This property is retrieved by the WindowProc
        'function in the standard basSubClassWindow
        'module.
    
        MouseWheelCancel = intCancel
    End Property
    
    Public Sub SubClassHookForm()
        'Called from the form's OnOpen or OnLoad
        'event. This procedure is what "hooks" or
        'subclasses the form window. If you hook the
        'the form window, you must unhook it when completed
        'or Access will crash.
        
        lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, _
                                        AddressOf WindowProc)
          Set CMouse = Me
       End Sub
    
    Public Sub SubClassUnHookForm()
        'Called from the form's OnClose event.
        'This procedure must be called to unhook the
        'form window if the SubClassHookForm procedure
        'has previously been called. Otherwise, Access will
        'crash.
    
        Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)
    End Sub
    
    Public Sub FireMouseWheel()
    
        'Called from the WindowProc function in the
        'basSubClassWindow module. Used to raise the
        'MouseWheel event when the WindowProc function
        'intercepts a mouse wheel message.
        RaiseEvent MouseWheel(intCancel)
    End Sub
    
    
    
    
    Form code:
    Option Compare Database
    Option Explicit
    
    'Declare a module level variable as the custom class
    'and give us access to the class's events
    Private WithEvents clsMouseWheel As CMouseWheel
    
    
    Private Sub Form_Load()
    
        'Create a new instance of the class,
        'and set the class's Form property to
        'the current form
        Set clsMouseWheel = New CMouseWheel
        Set clsMouseWheel.Form = Me
    
        'Subclass the current form by calling
        'the SubClassHookForm method in the class
        clsMouseWheel.SubClassHookForm
    End Sub
    
    Private Sub Form_Close()
        'Unhook the form by calling the
        'SubClassUnhook form method in the
        'class, and then destroy the object
        'variable
      
        clsMouseWheel.SubClassUnHookForm
        Set clsMouseWheel.Form = Nothing
        Set clsMouseWheel = Nothing
    End Sub
    
    Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
         'This is the event procedure where you can
         'decide what to do when the user rolls the mouse.
         'If setting Cancel = True, we disable the mouse wheel
         'in this form.
    
         MsgBox "You cannot use the mouse wheel to scroll through records."
         Cancel = True
    End Sub
    

     I just can't use a code if I don't understand it, and I will not be satisfied...
    • Marked as answer by iboumiza Wednesday, September 28, 2011 1:02 AM
    Wednesday, September 28, 2011 1:02 AM

All replies

  • You might look at this article, they offer a nice solution to your problem:

    http://www.everythingaccess.com/tutorials.asp?ID=A-new-method-for-disabling-the-Mouse-Scroll-Wheel-in-Access-forms

     

    Hopes this helps,


    Daniel van den Berg | Washington, USA | "Anticipate the difficult by managing the easy"
    Monday, September 26, 2011 6:20 PM
  • Hi,

    I don't want to download others files, I just want to fix my code, please

    Thanks

    Monday, September 26, 2011 6:50 PM
  • I admire your determination to invent the wheel again, but why try to develop something which already exisits.

    I am afraid its not that easy to fix your code to get this working.

    Besides that, there are other solutions available as described in the same article;

    - using a DLL provided by Lebans

    - or using VBA Subclassing as provided by Microsoft.

     

    The advantage of using the utility of Wayne Phillips, you dont need a DLL and has advantage over using the VBA Subclass.

     

    You just import the code module basMouseHook into your database application from the demonstration database Access 2000 version.

    Then place the following code in your OnOpen Event of your Form:

    Private Sub Form_Open(Cancel As Integer)
         Static MouseHook As Object
         Set MouseHook = NewMouseHook(Me)
    End Sub
    

    Hope this helps,


    Daniel van den Berg | Washington, USA | "Anticipate the difficult by managing the easy"
    Monday, September 26, 2011 7:04 PM
  • Hi,
     
    I couldn't understand his basMouseHook, so, I found another one much easier to understand and without licence!
    basMouseHook code:
     
    Option Compare Database
    Option Explicit
    
    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 CMouse As CMouseWheel
    
    Public Function WindowProc(ByVal hwnd As Long, _
        ByVal uMsg As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long) As Long
    
        'Look at the message passed to the window. If it is
        'a mouse wheel message, call the FireMouseWheel procedure
        'in the CMouseWheel class, which in turn raises the MouseWheel
        'event. If the Cancel argument in the form event procedure is
        'set to False, then we process the message normally, otherwise
        'we ignore it.  If the message is something other than the mouse
        'wheel, then process it normally
        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
    
    
    
    CMouseWheel code:
    Option Compare Database
    
    Option Explicit
    
    Private frm As Access.Form
    Private intCancel As Integer
    Public Event MouseWheel(Cancel As Integer)
    
    Public Property Set Form(frmIn As Access.Form)
        'Define Property procedure for the class which
        'allows us to set the Form object we are
        'using with it. This property is set from the
        'form class module.
        Set frm = frmIn
    End Property
    
    Public Property Get MouseWheelCancel() As Integer
        'Define Property procedure for the class which
        'allows us to retrieve whether or not the Form
        'event procedure canceled the MouseWheel event.
        'This property is retrieved by the WindowProc
        'function in the standard basSubClassWindow
        'module.
    
        MouseWheelCancel = intCancel
    End Property
    
    Public Sub SubClassHookForm()
        'Called from the form's OnOpen or OnLoad
        'event. This procedure is what "hooks" or
        'subclasses the form window. If you hook the
        'the form window, you must unhook it when completed
        'or Access will crash.
        
        lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, _
                                        AddressOf WindowProc)
          Set CMouse = Me
       End Sub
    
    Public Sub SubClassUnHookForm()
        'Called from the form's OnClose event.
        'This procedure must be called to unhook the
        'form window if the SubClassHookForm procedure
        'has previously been called. Otherwise, Access will
        'crash.
    
        Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)
    End Sub
    
    Public Sub FireMouseWheel()
    
        'Called from the WindowProc function in the
        'basSubClassWindow module. Used to raise the
        'MouseWheel event when the WindowProc function
        'intercepts a mouse wheel message.
        RaiseEvent MouseWheel(intCancel)
    End Sub
    
    
    
    
    Form code:
    Option Compare Database
    Option Explicit
    
    'Declare a module level variable as the custom class
    'and give us access to the class's events
    Private WithEvents clsMouseWheel As CMouseWheel
    
    
    Private Sub Form_Load()
    
        'Create a new instance of the class,
        'and set the class's Form property to
        'the current form
        Set clsMouseWheel = New CMouseWheel
        Set clsMouseWheel.Form = Me
    
        'Subclass the current form by calling
        'the SubClassHookForm method in the class
        clsMouseWheel.SubClassHookForm
    End Sub
    
    Private Sub Form_Close()
        'Unhook the form by calling the
        'SubClassUnhook form method in the
        'class, and then destroy the object
        'variable
      
        clsMouseWheel.SubClassUnHookForm
        Set clsMouseWheel.Form = Nothing
        Set clsMouseWheel = Nothing
    End Sub
    
    Private Sub clsMouseWheel_MouseWheel(Cancel As Integer)
         'This is the event procedure where you can
         'decide what to do when the user rolls the mouse.
         'If setting Cancel = True, we disable the mouse wheel
         'in this form.
    
         MsgBox "You cannot use the mouse wheel to scroll through records."
         Cancel = True
    End Sub
    

     I just can't use a code if I don't understand it, and I will not be satisfied...
    • Marked as answer by iboumiza Wednesday, September 28, 2011 1:02 AM
    Wednesday, September 28, 2011 1:02 AM