API 更改系统菜单条目

一个运用API 更改系统菜单，复制系统菜单的例子。(需要注意的是：如果要响应菜单项的单击事件，可能要用到钩子函数和更多的代码）

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

 

效果如下：