Results 1 to 7 of 7
  1. #1
    2 Star Lounger
    Join Date
    May 2001
    Location
    indiana
    Posts
    130
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Access 97 Scroll Mouse Disabling Problem Solved!!! (Access 97)

    I know many many people have been trying to figure out how to disable the scroll mouse on forms. well, I (with the help of several people - including Rory, and several locations of bits of code) have found the solution!! here is what you do:

    Add these code sections to each form you need this to work on... (you may have to paste this all into word or notepad first to retain the formatting)

    Private Sub Form_Load()

    'Store handle to this form's window
    gHW = Me.hwnd

    If IsHooked Then
    Call Unhook
    End If

    'Call procedure to begin capturing messages for this window
    Call Hook
    End Sub


    Private Sub Form_Unload(Cancel As Integer)
    'Call procedure to stop intercepting the messages for this window
    Call Unhook
    End Sub




    Create a new module and paste this code there...




    Option Compare Database
    Option Explicit

    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

    Declare Function SetWindowLong Lib "user32" Alias _
    "SetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

    Public Declare Function RegisterWindowMessage& Lib "user32" Alias "RegisterWindowMessageA" _
    (ByVal lpString As String)

    Private Declare Function GetCurrentVbaProject _
    Lib "vba332.dll" Alias "EbGetExecutingProj" _
    (hProject As Long) As Long
    Private Declare Function GetFuncID _
    Lib "vba332.dll" Alias "TipGetFunctionId" _
    (ByVal hProject As Long, ByVal strFunctionName As String, _
    ByRef strFunctionId As String) As Long
    Private Declare Function GetAddr _
    Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" _
    (ByVal hProject As Long, ByVal strFunctionId As String, _
    ByRef lpfn As Long) As Long

    Public Const GWL_WNDPROC = -4
    Public IsHooked As Boolean
    Public lpPrevWndProc As Long
    Public gHW As Long

    Public Sub Hook()

    If IsHooked Then
    'MsgBox "Don't hook it twice without " & _
    ' "unhooking, or you will be unable to unhook it."
    IsHooked = True
    Else

    lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddrOf("WindowProc"))
    IsHooked = True
    End If

    End Sub

    Public Sub Unhook()

    Dim temp As Long
    temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
    IsHooked = False

    End Sub

    Function WindowProc(ByVal hw As Long, ByVal uMsg As _
    Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    If uMsg = GetMouseWheelMsg Then
    ' Debug.Print "Message: "; hw, uMsg, wParam, lParam
    WindowProc = 0
    Else
    WindowProc = CallWindowProc(lpPrevWndProc, hw, _
    uMsg, wParam, lParam)
    End If

    End Function

    Public Function AddrOf(strFuncName As String) As Long
    Dim hProject As Long
    Dim lngResult As Long
    Dim strID As String
    Dim lpfn As Long
    Dim strFuncNameUnicode As String

    Const NO_ERROR = 0

    ' The function name must be in Unicode, so convert it.
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)

    ' Get the current VBA project
    ' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
    ' so now we just check the project handle when the function returns.
    Call GetCurrentVbaProject(hProject)

    ' Make sure we got a project handle... we always should, but you never know!
    If hProject <> 0 Then
    ' Get the VBA function ID (whatever that is!)
    lngResult = GetFuncID( _
    hProject, strFuncNameUnicode, strID)

    ' We have to check this because we GPF if we try to get a function pointer
    ' of a non-existent function.
    If lngResult = NO_ERROR Then
    ' Get the function pointer.
    lngResult = GetAddr(hProject, strID, lpfn)

    If lngResult = NO_ERROR Then
    AddrOf = lpfn
    End If
    End If
    End If
    End Function

    Public Function GetMouseWheelMsg() As Long

    GetMouseWheelMsg = 522 'this works for Win98/2000, otherwise use
    'RegisterWindowMessage("MSWHEEL_ROLLMSG")

    End Function


    in testing this myself, i have had no problem with it <img src=/S/crossfingers.gif border=0 alt=crossfingers width=17 height=16>. however, rory has tried it with access 2000/windows 2000 and has had a few problems. perhaps it is just a unique situation on his machine, but it could be something to watch out for. here is the post:
    http://www.wopr.com/cgi-bin/w3t/showflat.p...rt=1#Post126770
    Use this code as needed. i hope it will be as useful to you as it has to me!

  2. #2
    4 Star Lounger
    Join Date
    Jun 2001
    Location
    Sacramento, California, USA
    Posts
    491
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Access 97 Scroll Mouse Disabling Problem Solved!!! (Access 97)

    Thank you so much !!

    Your perseverance really paid off !!

    It works like a charm.... so far !!!!

    Much appreciated AccessMan.

    Michael Abrams

  3. #3
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts

    Re: Access 97 Scroll Mouse Disabling Problem Solved!!! (Access 97)

    As Jon confirmed in the original thread, there are problems with this (or equivalent) code in Access 2000 (see Q278379 for details) so this is purely designed for A97.
    Regards,
    Rory

    Microsoft MVP - Excel

  4. #4
    Star Lounger
    Join Date
    Dec 2001
    Location
    Birmingham, Alabama USA
    Posts
    95
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Access 97 Scroll Mouse Disabling Problem Solved!!! (Access 97)

    The code originally posted, at the start of the original thread, works in Access 2000 ... I have not tried it in Access 2002 yet but I suspect it will work in that verson also. It just will not work in Access 97.

    RDH
    Ricky Hicks
    Microsoft MVP
    Birmingham, Alabama USA

  5. #5
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts

    Re: Access 97 Scroll Mouse Disabling Problem Solved!!! (Access 97)

    It does, yes, but subject to the caveats in the KB article. It froze my PC on several occasions as I had used the VBEditor during that session. Curiously, it seemed to be fine as long as I kept the cursor off the form itself.
    Regards,
    Rory

    Microsoft MVP - Excel

  6. #6
    2 Star Lounger
    Join Date
    May 2001
    Location
    indiana
    Posts
    130
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Access 97 Scroll Mouse Disabling Problem Solved!!! (Access 97)

    just wanted to add one point of advice when using this code:

    try to enter the code when your program is in its final stages, as it creates many problems when debugging your code. basically, you will have to disable all calls of this function before you can pause the code and step through it. otherwise it will call the procedure while you are stepping through and it will crash access. i have not noticed it causing any other problems thus far.

    happy programming <img src=/S/compute.gif border=0 alt=compute width=40 height=20>

  7. #7
    3 Star Lounger
    Join Date
    Jul 2001
    Location
    Minneapolis, Minnesota, USA
    Posts
    299
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Access 97 Scroll Mouse Disabling Problem Solved!!! (Access 97)

    Way to go Access Man! <img src=/S/bravo.gif border=0 alt=bravo width=16 height=30> . I just got a call from a supervisor and I was about to slap another user's hand for using the wheel on their mouse but now I don't have to.....

    thanks so much! <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23>
    Carpy Diem, it&#39;s .

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •