Private Sub Form_Load()
Dim ret As Long
hMenu = GetMenu(Me.hwnd)'记录原本的Window Procedure的位址
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
'设定Combo1的window Procedure到wndproc
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim ret As Long
'取消Message的截取,而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
End Sub
'以下在.Bas
'以下程式在module1.bas
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
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 GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongPublic Const GWL_WNDPROC = (-4)
Public Const WM_MENUSELECT = &H11F
Public Const MF_BYCOMMAND = &H0&
Public Const MF_BYPOSITION = &H400&Public hMenu As Long
Public preWinProc As Long
Private Type tLong
ll As Long
End Type
Private Type TwoWord
LowWord As Integer
HiWord As Integer
End Type
Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MenuItemStr As String, SubMenuStr As String
Dim hSubmenu As Long, MenuId As Long, i As Long
Dim tmpl As tLong, tmpt As TwoWord
'以下程式会截取WM_MENUSELECT处理完後,再将之送往原来的Window Procedure
If Msg = WM_MENUSELECT Then
SubMenuStr = String(255, 0)
MenuItemStr = String(255, 0) tmpl.ll = wParam
LSet tmpt = tmpl
MenuId = tmpt.LowWord hSubmenu = GetSubMenu(lParam, MenuId)
If hSubmenu = 0 Then '表示该item之下没有popupMenu了
Call GetMenuString(lParam, MenuId, MenuItemStr, 256, MF_BYCOMMAND)
MenuItemStr = Left(MenuItemStr, InStr(1, MenuItemStr, Chr(0)) - 1)
Debug.Print "正在 MenuItem " + MenuItemStr
Else
Call GetMenuString(hMenu, hSubmenu, SubMenuStr, 256, MF_BYCOMMAND)
SubMenuStr = Left(SubMenuStr, InStr(1, SubMenuStr, Chr(0)) - 1)
Debug.Print "正在 PopUpMenu " + SubMenuStr
End If
End If
'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function
Dim ret As Long
hMenu = GetMenu(Me.hwnd)'记录原本的Window Procedure的位址
preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
'设定Combo1的window Procedure到wndproc
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim ret As Long
'取消Message的截取,而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
End Sub
'以下在.Bas
'以下程式在module1.bas
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
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 GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As LongPublic Const GWL_WNDPROC = (-4)
Public Const WM_MENUSELECT = &H11F
Public Const MF_BYCOMMAND = &H0&
Public Const MF_BYPOSITION = &H400&Public hMenu As Long
Public preWinProc As Long
Private Type tLong
ll As Long
End Type
Private Type TwoWord
LowWord As Integer
HiWord As Integer
End Type
Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MenuItemStr As String, SubMenuStr As String
Dim hSubmenu As Long, MenuId As Long, i As Long
Dim tmpl As tLong, tmpt As TwoWord
'以下程式会截取WM_MENUSELECT处理完後,再将之送往原来的Window Procedure
If Msg = WM_MENUSELECT Then
SubMenuStr = String(255, 0)
MenuItemStr = String(255, 0) tmpl.ll = wParam
LSet tmpt = tmpl
MenuId = tmpt.LowWord hSubmenu = GetSubMenu(lParam, MenuId)
If hSubmenu = 0 Then '表示该item之下没有popupMenu了
Call GetMenuString(lParam, MenuId, MenuItemStr, 256, MF_BYCOMMAND)
MenuItemStr = Left(MenuItemStr, InStr(1, MenuItemStr, Chr(0)) - 1)
Debug.Print "正在 MenuItem " + MenuItemStr
Else
Call GetMenuString(hMenu, hSubmenu, SubMenuStr, 256, MF_BYCOMMAND)
SubMenuStr = Left(SubMenuStr, InStr(1, SubMenuStr, Chr(0)) - 1)
Debug.Print "正在 PopUpMenu " + SubMenuStr
End If
End If
'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function
解决方案 »
- vb如何截取网页的html代码
- 菜鸟再问数据库
- datagrid控件更新列时发生错误
- 写了一段程序,可是运行不了.请高手看看,谢谢了.
- real player 插件播放ram,rpm等多源文件
- 怎样调用默认电子邮件程序(带附件)?
- 在VB中怎样打开一个指定的Word文档?关闭? 在线
- 选项对话框,怎么只能对“群组1”成为选中状态进行界面设计,而其他的“群组”为何不能成为选中状态呢?
- 在2beesoft网站上下载过icon的人请进!!!
- 我有一份源代码,愿意共享,谁要?
- form能否嵌套form而且子form可以操作
- 小弟初来乍到,刚学会怎么发贴子,第一个问题:“怎么用api关闭windows中正在运行的窗口?“
2,在需要接收事件的类中,用WithEvents声明一个变量为上面的新建类,即可在代码窗口对事件编程。