直接赋值下面程序到一个新建画面中测试,根据实际需求更改菜单要求
Option Explicit
'相关API函数定义
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal hwnd As Long, ByVal lptpm As Any) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Const GW_HWNDNEXT = 2
'鼠标坐标
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim hwnd As Long
Dim hSubMenu As Long
Dim hMainMenu As Long
' 菜单类型
'-----------------------------------------------------------
Const MF_INSERT = &H0&
Const MF_CHANGE = &H80&
Const MF_APPEND = &H100&
Const MF_DELETE = &H200&
Const MF_REMOVE = &H1000&
Const MF_BYCOMMAND = &H0&
Const MF_BYPOSITION = &H400&
Const MF_SEPARATOR = &H800&
Const MF_ENABLED = &H0&
Const MF_GRAYED = &H1&
Const MF_DISABLED = &H2&
Const MF_UNCHECKED = &H0&
Const MF_CHECKED = &H8&
Const MF_USECHECKBITMAPS = &H200&
Const MF_STRING = &H0&
Const MF_BITMAP = &H4&
Const MF_OWNERDRAW = &H100&
Const MF_POPUP = &H10&
Const MF_MENUBARBREAK = &H20&
Const MF_MENUBREAK = &H40&
Const MF_UNHILITE = &H0&
Const MF_HILITE = &H80&
Const MF_SYSMENU = &H2000&
Const MF_HELP = &H4000&
Const MF_MOUSESELECT = &H8000&
Const TPM_LEFTBUTTON = &H0&
Const TPM_RIGHTBUTTON = &H2&
Const TPM_LEFTALIGN = &H0&
Const TPM_CENTERALIGN = &H4&
Const TPM_RIGHTALIGN = &H8&
Const TPM_RETURNCMD = &H100&
Private Sub CFixPicture_Close()
'注销菜单
DestroyMenu hSubMenu
DestroyMenu hMainMenu
End Sub
Private Sub CFixPicture_Initialize()
'菜单初始化设置
Dim ParentHWnd As Long
Dim ChildHWnd As Long
Dim ChildDocHWnd As Long
Dim ChildWindow As Long
' 找到当前画面的句柄
ParentHWnd = FindWindowPartial("*工作台*", "*")
ChildHWnd = FindWindowEx(ParentHWnd, &O0, "MDIClient", "")
ChildDocHWnd = FindWindowEx(ChildHWnd, &O0, vbNullString, Me.PictureName)
ChildWindow = FindWindowEx(ChildDocHWnd, &O0, vbNullString, vbNullString)
hwnd = ChildWindow
' 创建主菜单
hMainMenu = CreatePopupMenu()
AppendMenu hMainMenu, MF_STRING, 1, "菜单 - 1"
AppendMenu hMainMenu, MF_STRING, 2, "菜单 - 2"
AppendMenu hMainMenu, MF_SEPARATOR, 3, ByVal 0& '分隔线
AppendMenu hMainMenu, MF_STRING, 4, "关于"
'AppendMenu hMenu, MF_STRING Or MF_GRAYED, 4, "关于" '灰色
' 创建子菜单
hSubMenu = CreatePopupMenu()
AppendMenu hSubMenu, MF_STRING, 6, "菜单 1 - 1"
' 将子菜单加到主菜单中
AppendMenu hMainMenu, MF_BYPOSITION Or MF_POPUP, hSubMenu, "&子菜单主名"
End Sub
Private Function FindWindowPartial(ByVal Title As String, ByVal Class As String) As Long
'找到窗口句柄
Dim hWndThis As Long
hWndThis = FindWindow(vbNullString, vbNullString)
While hWndThis
Dim sTitle As String, sClass As String
sTitle = Space$(255)
sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle)))
sClass = Space$(255)
sClass = Left$(sClass, GetClassName(hWndThis, sClass, Len(sClass)))
If sTitle Like Title And sClass Like Class Then
FindWindowPartial = hWndThis
Exit Function
End If
hWndThis = GetWindow(hWndThis, GW_HWNDNEXT)
Wend
End Function
Private Sub CFixPicture_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Double, ByVal Y As Double)
'点击画面弹出菜单,可以定义其他画面上的对象弹出菜单
Dim Pt As POINTAPI
Dim ret As Long
If Button = 2 Then '1表示左键,2表示右键,3表示中间键
' 获得鼠标位置
GetCursorPos Pt
' 显示弹出菜单
ret = TrackPopupMenuEx(hMainMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, Pt.X, Pt.Y, hwnd, ByVal 0&)
' 显示选择菜单项,菜单处理程序写在此处
Select Case ret
Case 1
Call MenuProc1
Case 2
Call MenuProc2
Case 4
Call MenuProc4
Case 6
Call MenuProc6
End Select
End If
End Sub
Private Sub MenuProc1()
'菜单点击处理程序
MsgBox "菜单-1点击!"
End Sub
Private Sub MenuProc2()
'菜单点击处理程序
MsgBox "菜单-2点击!"
End Sub
Private Sub MenuProc4()
'菜单点击处理程序
MsgBox "关于点击"
End Sub
Private Sub MenuProc6()
'菜单点击处理程序
MsgBox "弹出子菜单1-1点击!"
End Sub
Public Sub CFixPicture_CtrlAccent()
'画面“Ctrl+~”事件
Dim ret As Long
'显示在左上角
ret = TrackPopupMenuEx(hMainMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, 0, 0, hwnd, ByVal 0&)
Select Case ret
Case 1
Call MenuProc1
Case 2
Call MenuProc2
Case 4
Call MenuProc4
Case 6
Call MenuProc6
End Select
End Sub