VB中抑制控件的弹出菜单

发布: 2007-6-21 21:57 | 作者: - | 来源: - | 查看: 17次 | 进入软件测试论坛讨论

在VB的某些控件如文本框（TEXTBOX）、组合框（COMBOBOX）等上单击鼠标右键都会有缺省的弹出菜单，这些缺省弹出菜单，在某些情况下我们并不需要或者根据实际情况需要使用自己的弹出菜单，那么如何抑制控件的弹出菜单呢？

我们需要检测控件的鼠标右键单击消息，然后什么事也不做或者使用自己的弹出菜单，这需要编写一个钩子函数来完成。下面以抑制文本框的弹出菜单为例说明实现方法。

为窗体添加一个模块，在模块中编写钩子函数：

首先声明使用的API函数及常量，

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 Const GWL_WNDPROC = -4
Public Const WM_RBUTTONUP = &H205
Public lpPrevWndProc As Long
Private lngHWnd As Long

钩子函数编写：

Public Sub Hook(hWnd As Long)
  lngHWnd=hWnd
  lpPrevWndProc = SetWindowLong(lngHWnd, 
  GWL_WNDPROC, AddressOf WindowProc)
End Sub

钩子函数撤消：

Public Sub UnHook()
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(lngHWnd,
 GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As 
Long, ByVal uMsg As Long, _
   ByVal wParam As Long, ByVal 
   lParam As Long) As Long
   Select Case uMsg
检测鼠标击键消息，如果是单击右键
   Case WM_RBUTTONUP
     什么事也不做
    或弹出自己定制的菜单
   Case Else
WindowProc = CallWindowProc(lpPrevWndProc,
 hw, uMsg, wParam, lParam)
   End Select
End Function

在窗体中添加一个文本框，在窗体的Form_Load事件中启动钩子函数：

Private Sub Form_Load()
 Call Hook(Text1.hWnd)
End Sub

在窗体的Form_Unload事件中撤消钩 ?

Private Sub Form_Unload(Cancel As Integer)
   Call UnHook
End Sub

注意，在窗体退出时必须撤消钩子函数，否则程序会出错。

本程序在VB5.0、WIN98下调试通过。