Option Explicit
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Any) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Const TPM_LEFTALIGN = &H0&
Private hsysmenu As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Function num(i As Integer) As String
num = Mid(" 长恨歌 汉皇重色思倾国，御宇多年求不得。杨家有女初长成，养在深闺人未识。天生丽质难自弃，一朝选在君王侧。回眸一笑百媚生，六宫粉黛无颜色。春寒赐浴华清池，温泉水滑洗凝脂。侍儿扶起娇无力，始是新承恩泽时。云鬓花颜金步摇，芙蓉帐暖度春宵。春宵苦短日高起，从此君王不早朝。", 8 * i + 1, 8)
End Function
Private Sub Form_Load()
Dim i As Integer
hsysmenu = GetSystemMenu(hwnd, False) '系统菜单句柄
InsertMenu hsysmenu, 0, &H800, &H0, "" '加入分割符
For i = 0 To 5
ModifyMenu hsysmenu, i, &H4410, 0, num(i+1) '改变菜单条目
Next
For i = 6 To 15
InsertMenu hsysmenu, i, &H400, &H0, num(i+1) '插入菜单条目
Next 'i=6 对应条目为关闭按钮，如此设置是为了留下该条目
InsertMenu hsysmenu, 0, &H800, &H0, "" '加入分割符
InsertMenu hsysmenu, 0, &H400, &H0, num(0)
Me.Move Screen.Width / 2 - 3000, Screen.Height / 2 - 2000, 6000, 4000 ' 窗体居中
Me.Caption = "请用鼠标右键调出系统菜单！！！"
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Pts As POINTAPI
GetCursorPos Pts '获取鼠标位置
If Button = 2 Then TrackPopupMenu hsysmenu, TPM_LEFTALIGN, Pts.x, Pts.y, 0, Me.hwnd, ByVal 0&
'在鼠标点击处弹出更改后的系统菜单
End Sub
延伸阅读
文章来源于领测软件测试网 https://www.ltesting.net/
