borderAndreaVB free resources for Visual Basic developersborder

AndreaVB Visual Basic and VB.NET source code resources - Copyright © 1999-2014 Andrea Tincani
:: How to handle the Mouse Wheel events in your projects (improved)

Author  

Andrea Tincani and Wilson, Joshua C.

Language  

VB5, VB6

Operating Systems  

Windows NT
API Declarations

'==============inside a MODULE
Option Explicit
'************************************************************
'API
'************************************************************


Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
    ByVal lpPrevWndFunc As Long, _
    ByVal hWnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long

'************************************************************
'Constants
'************************************************************


Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A

Module

'************************************************************
'Variables
'************************************************************


Private hControl As Long
Private lPrevWndProc As Long

'*************************************************************
'WindowProc
'*************************************************************


Private Function WindowProc(ByVal lWnd As Long, ByVal lMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
   
'Test if the message is WM_MOUSEWHEEL
    If lMsg = WM_MOUSEWHEEL Then
       
'Add event handling code here
       
'this will be universal to all forms that are 'hooked' to this code
        Screen.ActiveForm.MouseWheelRolled
    End If
   
'Sends message to previous procedure if not MOUSEWHEEL
   
'This is VERY IMPORTANT!!!
    If lMsg <> WM_MOUSEWHEEL Then
        WindowProc = CallWindowProc(lPrevWndProc, lWnd, lMsg, wParam, lParam)
    End If
End Function

'*************************************************************
'Hook
'All forms that call this procedure must implement this procedure in their module:
'   Public Sub MouseWheelRolled()
'        <your code>
'   End Sub
'*************************************************************

Public Sub Hook(ByVal hControl_ As Long)
    hControl = hControl_
    lPrevWndProc = SetWindowLong(hControl, GWL_WNDPROC, AddrOf("WindowProc"))
End Sub

'*************************************************************
'UnHook
'*************************************************************

Public Sub UnHook()
    Call SetWindowLong(hControl, GWL_WNDPROC, lPrevWndProc)
End Sub

Usage
'...and in the forms implementing the mousewheel code:

<code>
Public Sub MouseWheelRolled()
    Beep
End Sub
</code>

'see, this way each form can specify it's own mousewheel handling through
'the MouseWheelRolled procedure.

'Hope this isn't too unreadable.
:: Navigation

Home

Windows NT Tips

Previous Tip

Next Tip

:: Search this site
Google
:: Related Topics
icon 07-08-2005 Mouse wheel try #2 by Yotzo
:: Sponsored Links



borderAndreaVB free resources for Visual Basic developersborder
borderAndreaVB Visual Basic and VB.NET source code resources - Copyright © 1999-2014 Andrea Tincaniborder