CodeItBetter Programming Another VB Programming Blog

'Controls - How to use MouseDown/DoubleClick events for those Controls don't have it

'Some controls don't have MouseDown event (Combo Boxes, Scroll Bars, DriveListBoxes, etc.)
'or DoubleClick event (Command Button for example).
'
'You can use the following code to subclass the controls MouseDown/DoubleClick events.
'subclass = read the Windows "messages" before they arrive to specific control.
'For example, a message can be a button that been clicked (on control), key that pressed,
'paint event that occured, the mouse that moved over it, and everything else that related
'to the control.
'
'This code allow you to execute specific code when the user clicks on the right mouse
'button on Combo Box.
'
'Warning: because this code use subclassing, it is very important to unsubclass the control
'at the end of the program. Thus, if you will close the program from VB Stop button, the
'Form_UnLoad event will not be executed, and the unsubclass calling event will not be
'executed too, and that will cause your VB environment to crash.
'So close the program from the Form's X Button.
'
'Add a Combo Box to your form. Set the Combo Box Style property to 2 - DropDown List.
'If you won't do so, the subclassed events will be executed only when the user clicks on
'the Combo Box down arrow.

Option Explicit
 
Private g_lngOldWindowProc As Long
Private 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
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const WM_LBUTTONDOWN = &H201    'left mouse button is down
Private Const WM_LBUTTONDBLCLK = &H203    'left mouse button is double clicked
Private Const WM_RBUTTONDOWN = &H204    'right mouse button is down
Private Const WM_RBUTTONDBLCLK = &H206    'right mouse button is double clicked
Private Const WM_MBUTTONDOWN = &H207    'middle mouse button is down
Private Const WM_MBUTTONDBLCLK = &H209    'middle mouse button is double clicked
Private Const GWL_WNDPROC = (-4)
 
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    Select Case Msg
    Case WM_LBUTTONDOWN
        'Place here the code of the mouse left button down event.
        MsgBox "the left mouse button is down"
        NewWindowProc = True
    Case WM_RBUTTONDOWN
        'Message when the right mouse button is down
        MsgBox "the right mouse button is down"
        NewWindowProc = True
    Case Else
        'Let the default message-handler take care of this message!
        NewWindowProc = CallWindowProc(g_lngOldWindowProc, hwnd, Msg, wParam, lParam)
    End Select
End Function
 
Public Sub StartSubclassing(hwnd As Long)
    g_lngOldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
 
Public Sub EndSubclassing(hwnd As Long)
    Dim lngRetVal As Long
    lngRetVal = SetWindowLong(hwnd, GWL_WNDPROC, g_lngOldWindowProc)
End Sub
 
Private Sub Form_Load()
    StartSubclassing Combo1.hwnd
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    EndSubclassing (Combo1.hwnd)
End Sub