通过获取菜单的Rect来映射相关的菜单事件

'建立一个menu1的菜单,并建立menu1的子菜单menu2

  Private Type POINTAPI
          x   As Long
          y   As Long
  End Type
  Private Type RECT
          Left   As Long
          Top   As Long
          Right   As Long
          Bottom   As Long
  End Type

Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemRect Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long, ByVal uItem As Long, ByVal lprcItem As RECT) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Const MOUSEEVENTF_ABSOLUTE = &H8000           '   absolute   move
Private Const MOUSEEVENTF_LEFTDOWN = &H2           '   left   button   down
Private Const MOUSEEVENTF_LEFTUP = &H4           '   left   button   up
Private Const MOUSEEVENTF_MOVE = &H1           '   mouse   move
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetMessageExtraInfo Lib "user32" () As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0         'X   Size   of   screen
Const SM_CYSCREEN = 1         'Y   Size   of   Screen

Private Sub Form_KeyPress(ByVal KeyAscii As Integer)
    Dim mWnd As Long
    mWnd = Me.hwnd

    Dim hMenu As Long, hSubMenu As Long

    hMenu = GetMenu(mWnd)
    ClickMenuItem mWnd, hMenu, 0
    hSubMenu = GetSubMenu(hMenu, 0)
    ClickMenuItem mWnd, hSubMenu, 0

End Sub


Private Sub ScreenToAbsolute(ByVal lpPoint As POINTAPI)
    lpPoint.x = lpPoint.x * (&HFFFF& / GetSystemMetrics(SM_CXSCREEN))
    lpPoint.y = lpPoint.y * (&HFFFF& / GetSystemMetrics(SM_CYSCREEN))
End Sub

Private Sub Click(ByVal p As POINTAPI)
    mouse_event MOUSEEVENTF_ABSOLUTE Or MOUSEEVENTF_MOVE, p.x, p.y, 0, GetMessageExtraInfo()
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, GetMessageExtraInfo()
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, GetMessageExtraInfo()
End Sub

Private Sub ClickMenuItem(ByVal mWnd As Long, ByVal hMenu As Long, ByVal Pos As Long)
    Dim ret As Long
    Dim r As RECT, p As POINTAPI
    ret = GetMenuItemRect(mWnd, hMenu, Pos, r)
    If ret = 0 Then Exit Sub
    p.x = (r.Left + r.Right) / 2
    p.y = (r.Top + r.Bottom) / 2
    ScreenToAbsolute (p)
    Click (p)
End Sub

Private Sub Form_Load()
    Dim mWnd As Long, p As POINTAPI
    mWnd = Me.hwnd
    Dim hMenu As Long, hSubMenu As Long
    hMenu = GetMenu(mWnd)
    ClickMenuItem mWnd, hMenu, 0
    hSubMenu = GetSubMenu(hMenu, 0)
    ClickMenuItem mWnd, hSubMenu, 0
    p.x = &HFFFF& / 2
    p.y = &HFFFF& / 2
    Click (p)
    Me.AutoRedraw = True
    Me.BackColor = vbWhite
    Print ("Press   any   key")
End Sub

Private Sub menu2_Click()
    MsgBox ("Click")
End Sub 

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值