得知目前Mouse所指的Menu Item是哪一个
来源:cww
请先查阅"有BitMap的Menu"这编文章，取得Menu的相关知识，再查
"如何拦截ComboBox MouseMove"的SubClass之技巧
一些商业软件中，当滑鼠指向某个Menu Item时，在表单的底部STATUSBAR中会显示有该Item
功能的简要说明。而VB5中有关Menu的捕捉事件只有一个 CLICK，那该如何做呢。其实当
选择了Menu後，Mouse在Menu SubMenu MenuItem上移来移去时，会产生WM_MENUSELECT的
Message给Menu所在的表单，而其wParam的Low Word有两个意义，如果Mouse指到的Item
之下还有子Menu，该LowWord of wParam指的是该Item是第几个SubMenu，而lParam便是
Menu的Handle；相反的，如果Mouse所指的Item底下没有PopupMenu了，那 LowWord of
wParam指的是MenuID，而lParam是hSubMenu。


档案   编辑	选项  --> hMenu    (功能表, Menu)
      +-------+
      |复制   |---------> hSubMenu (子功能表, SubMenu)
      |贴上   |
      |减下 -------------> MenuID   (功能表项目,MenuItem)
      |       |
      +-------+

所以了，这就得使用SubClass的技巧，取得WM_MENUSELECT的Message，进而得知到底是
选到了哪一个MenuItem。当然了，我们可以使用GetMenu GetSubMenu GetMenuItemID
等API来得知功能表上每一个项目的hMenu hSubMenu MenuID,如此一来，和WM_MENUSELECT
讯息所取得的lParam  wParam做做比较，就可得知到底选上了哪一个，而本例则是使用
GetMenuString取得MenuItem的title，如果您的MenuItems没有相同的title，也不失一
得知方式。


'以下在form，请自行加Menu於Form上
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 Sub

 Private 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 Long

 Public 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