1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Access:Disable Mouse Scroll button navigation

Discussion in 'Business Applications' started by sthomp04, Oct 13, 2004.

Thread Status:
Not open for further replies.
  1. sthomp04

    sthomp04 Thread Starter

    Joined:
    Sep 5, 2003
    Messages:
    89
    I can keep a user from navigating to different records in a form by changing the navigation buttons property to "no". However, the user can still use the scroll button on the mouse to navigate to other records. Any fix for this?

    Thanks
    Steve
     
  2. lp092jl

    lp092jl

    Joined:
    Sep 8, 2004
    Messages:
    18
    Create a module and name it basSubClassWindow, paste this code
    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
    
    Then create a class module named CMouseWheel, and paste this code:
    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
    

    Paste this in the code window of the form you want to disable the mousewheel of:

    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.
     Cancel = True
         
    End Sub
    



    After pasting the code, make sure that you close out of your database before using the forms or else access will freeze.
     
As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/284277

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice