'建立一个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