为系统菜单添加新的菜单并响应单击事件

以下代码在模块中

Option Explicit

Public Declare Function AppendMenu Lib "user32" Alias _
"AppendMenuA" (ByVal hMenu As Long, ByVal wFlags _
As Long, ByVal wIDNewItem As Long, ByVal _
lpNewItem As String) As Long '在指定的菜单里加入一个菜单项

Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hWnd As Long, ByVal bRevert As Long) As Long '取得窗体系统菜单的句柄

Public Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long '在窗口结构中为指定的窗口设置信息

Public Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" (ByVal lpPrevWndFunc _
As Long, ByVal hWnd As Long, ByVal Msg As _
Long, ByVal wParam As Long, ByVal lParam As Long) As Long '将消息传给窗口函数
'常数声明
Public Const WM_SYSCOMMAND = &H112
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const GWL_WNDPROC = (-4)
Public Const MyAbout = 1 '这里是指定菜单条目的新命令ID,可以自己设置
Public lProcOld As Long '记录原来窗口程序的地址的常数

Public Function SysMenuHandler(ByVal hWnd _
As Long, ByVal iMsg As Long, ByVal wParam _
As Long, ByVal lParam As Long) As Long '响应单击事件的函数过程
If iMsg = WM_SYSCOMMAND Then
If wParam = MyAbout Then
MsgBox "好好学习,天天向上", vbInformation, "VB万岁"
Exit Function
End If
End If
SysMenuHandler = CallWindowProc(lProcOld, _
hWnd, iMsg, wParam, lParam)
End Function

Public Function SubClass(FormName As Form) '添加新的菜单项的子过程
Dim lhSysMenu As Long
lhSysMenu = GetSystemMenu(FormName.hWnd, 0&)

Call AppendMenu(lhSysMenu, MF_SEPARATOR, 0, vbNullString) 'MF_SEPARATOR是加入分隔条
Call AppendMenu(lhSysMenu, MF_STRING, MyAbout, "新添加的菜单")

lProcOld = SetWindowLong(FormName.hWnd, GWL_WNDPROC, AddressOf SysMenuHandler) '记录原来程序的地址
End Function

以下代码在窗体中

Option Explicit

Private Sub Form_Load()
Call SubClass(Form1) 'SubClass子过程调用
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, lProcOld '退出时恢复原有的地址
End Sub