Some controls don't have MouseDown event (Combo Boxes,
Scroll Bars,
DriveListBoxes and more) 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, for example, to
executed specific code when the user clicks on the right mouse button on Combo
Box (and without it you can't!).
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_Load event will not be executed, and the unsubclass calling that found
in the Form_Load 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.
Option Explicit
' Address of the original Windows procedure
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
' New
message-handler
' This is the function that will receive all the Windows
messages
' when subclassing is activated
On Error Resume Next
Select Case Msg
' here you can add more events, using the constants above.
' Message when the left mouse button is down
Case WM_LBUTTONDOWN
' place here the code of the mouse left button down
event.
MsgBox "the left
mouse button is down"
NewWindowProc =
True
' Message when the right mouse
button is down
Case
WM_RBUTTONDOWN
MsgBox "the right
mouse button is down"
NewWindowProc =
True
' All other messages
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)
' Start subclassing by redirecting all messages to NewWindowProc
function
' and storing the address of original message-handler in
' OldWindowProc
variable
g_lngOldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub
Public Sub EndSubclassing(hwnd As Long)
Dim lngRetVal
As Long
' Restore the original
message-handler.
lngRetVal =
SetWindowLong(hwnd, GWL_WNDPROC, g_lngOldWindowProc)
End
Sub
Private Sub Form_Load()
' replace
the 2 "Combo1" below with the name of the control you want
' to
subclass its events
StartSubclassing Combo1.hwnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
EndSubclassing (Combo1.hwnd)
End Sub