📄 m65.htm
字号:
<html>
<head>
<title>VB教程</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<p align="center"><script src="../../1.js"></script></a>
<body bgcolor="#ffffff" leftmargin="5" topmargin="1" marginheight="5" marginwidth="5">
<div align=center>
<table border=0 cellpadding=0 cellspacing=0 width=680 align="center">
<tbody>
<tr>
<td bgcolor=#000000 height=9>
<div align=center class=H1> <font color="#FFFFFF">如何拦截ComboBox的mouse右键</font> </font> </font></div>
</td>
</tr>
<tr valign=top>
<td class=H1 height=76>
<p align="left"> <br>
在ComboBox上按右键时，会有一个popup
menu出现，如何令之不出现呢？ 在editBox中可用ubclassing的技巧check msg是否是WM_RBUTTONDOWN
来拦截mouse是否按了右键而後吃掉该message(不Call CallWindowProc())，而使之不会出现popup menu。但在ComboBox中，按了mouse右键，却仍出现Popup
Menu，查了一下按右键时，发现是 WM_PARENTNOTIFY的讯息，而不是wm_rbuttondown， 这该如何才能使之不出现Popup
menu<br>
<br>
这是个有趣的问题，ComboBox 是由 "Edit"(TextBox 的前身) 及 "ListBox"两种 Windows 的 control
所组成的，而在 ComboBox 上面按下滑鼠右钮是由"Edit" 来处理，因此拦截的方法是：<br>
<br>
1. 呼叫 EnumChildWindows 取得 ComboBox 的 "Edit" 子视窗的 hWnd</font></span></font></p>
<p align="left"> <span class="unnamed1">2. 拦截 "Edit"
hWnd。 <br>
</span></font> <br>
</font></p>
<table border=0 width="709">
<tbody>
<tr>
<td> '以下程式在form<br>
Option Explicit<br>
Private hwnd5 As Long<br>
<br>
Private Sub Form_Load()<br>
Dim ret As Long<br>
'取得Combo内EditBox的hwnd<br>
hwnd5 = FindEditInCombo(Combo1)<br>
'记录原本的Window Procedure的位址<br>
preWinProc = GetWindowLong(hwnd5, GWL_WNDPROC)<br>
'设定EditBox的window Procedure到wndproc<br>
ret = SetWindowLong(hwnd5, GWL_WNDPROC, AddressOf wndproc)<br>
End Sub<br>
<br>
Private Sub Form_Unload(Cancel As Integer)<br>
Dim ret As Long<br>
'取消Message的截取，而使之又只送往原来的Window Procedure<br>
ret = SetWindowLong(hwnd5, GWL_WNDPROC, preWinProc)<br>
End Sub<br>
<br>
'以下程式在.bas module<br>
Option Explicit<br>
<br>
Declare Function EnumChildWindows Lib "user32" _<br>
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _<br>
ByVal lParam As Long) As Long<br>
Declare Function GetClassName Lib "user32" Alias "GetClassNameA"
_<br>
(ByVal hwnd As Long, ByVal lpClassName As String, _<br>
ByVal nMaxCount As Long) As Long<br>
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
_<br>
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
As Long<br>
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
_<br>
(ByVal hwnd As Long, ByVal nIndex As Long) As Long<br>
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA"
_<br>
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long,
_<br>
ByVal wParam As Long, ByVal lParam As Long) As Long<br>
<br>
Public Const GWL_WNDPROC = (-4)<br>
Public Const WM_MOUSEMOVE = &H200<br>
Public Const WM_RBUTTONDOWN = &H204<br>
Public preWinProc As Long<br>
Private hEditWnd As Long<br>
<br>
Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _<br>
ByVal wParam As Long, ByVal lParam As Long) As Long<br>
'以下会截取mouse Rbutton Down<br>
If Msg = WM_RBUTTONDOWN Then<br>
Debug.Print "Combol Mouse RButton Down "<br>
Else<br>
'将之送往原来的Window Procedure<br>
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)<br>
End If<br>
End Function<br>
Public Function FindEditInCombo(ctl As ComboBox) As Long<br>
Call EnumChildWindows(ctl.hwnd, AddressOf EnumFunc, 0)<br>
FindEditInCombo = hEditWnd<br>
End Function<br>
<br>
Public Function EnumFunc(ByVal hwnd As Long, ByVal lParam As Long)
As Long<br>
Dim ClsName As String<br>
Dim len5 As Long<br>
If hwnd = 0 Then<br>
EnumFunc = 0<br>
Else<br>
ClsName = String(255, 0)<br>
len5 = GetClassName(hwnd, ClsName, 256)<br>
ClsName = Left(ClsName, len5)<br>
If ClsName = "Edit" Then<br>
hEditWnd = hwnd<br>
EnumFunc = 0<br>
Else<br>
EnumFunc = 1<br>
End If<br>
End If<br>
End Function<br>
</font></span> <br>
</td>
</tr>
</tbody>
</table>
</table>
</div>
<p align="center"><a href="../../pian/vb.htm">回首页</a>
<p align="center"><script src="../../2.js"></script></a>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -