At some stage in your programming career, you might find you want to add another item to the standard system menu (which is displayed when you click a windows icon, or right click on its title bar). To do this in VB, you need to use the AppendWindow API function to add an item, and then subclass the WM_SYSCOMMAND message to detect when the item is clicked. The code below shows you how. Please note that as this uses subclassing, you must not press the stop button on the VB toolbar.
Option Explicit
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
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal
bRevert As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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 IDM_CUSTOM As Long = 1010
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 = IDM_CUSTOM Then
MsgBox "VB
Web About...", vbInformation, "About"
Exit Function
End If
End If
SysMenuHandler = CallWindowProc(lProcOld, hWnd, iMsg, wParam,
lParam)
End Function
Public Function SubClass(FormName As Form, sMenu As String)
Dim lhSysMenu As Long, lRet As Long
lhSysMenu = GetSystemMenu(FormName.hWnd, 0&)
'Add seperator
lRet = AppendMenu(lhSysMenu, MF_SEPARATOR, 0&, vbNullString)
'Add new menu item
lRet = AppendMenu(lhSysMenu, MF_STRING, IDM_CUSTOM, sMenu)
lProcOld = SetWindowLong(FormName.hWnd, GWL_WNDPROC, AddressOf
SysMenuHandler)
End Function
'Form Code
Option Explicit
Private Sub Form_Load()
SubClass Me, "About..."
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, lProcOld
End Sub