Private Sub Form_Load()
……
ProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(hWnd, GWL_WNDPROC, ProcOld)
End Sub
Then, add the code below to a module
……
Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'// ----WARNING----
'// do not attempt to debug this procedure!!
'// ----WARNING----
'// this is our implementation of the message handling routine
'// determine which message was recieved
Select Case iMsg
Case WM_SYSCOMMAND
If wParam = IDM_ABOUT Then
MsgBox "VB Web Append to System Menu Example", vbInformation, "About"
Exit Function
End If
End Select
'// pass all messages on to VB and then return the value to windows
WindowProc = CallWindowProc(ProcOld, hWnd, iMsg, wParam, lParam)
End Function
This example adds an About... item to the forms System Menu (shown by clicking the forms icon, or right clicking on its button on the taskbar)
Please note that this uses subclassing, so DO NOT use the Stop button on the VB toolbar, or attempt to debug the WindowProc procedure (unless you like VB crashing!).
First, add the following code to a form
'// form_load event. Catch all those messages!
Private Sub Form_Load()
Dim lhSysMenu As Long, lRet As Long
On Error Resume Next
'// add about menu
lhSysMenu = GetSystemMenu(hWnd, 0&)
lRet = AppendMenu(lhSysMenu, MF_SEPARATOR, 0&, vbNullString)
lRet = AppendMenu(lhSysMenu, MF_STRING, IDM_ABOUT, "About...")
Show
'// saves the previous window message handler. Always restore this value
'// AddressOf command sends the address of the WindowProc procedure
'// to windows
ProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
'// form_queryunload event. Return control to windows/vb
Private Sub Form_Unload(Cancel As Integer)
'// give message processing control back to VB
'// if you don't do this you WILL crash!!!
Call SetWindowLong(hWnd, GWL_WNDPROC, ProcOld)
End Sub
Then, add the code below to a module
'// variable that stores the previous message handler
Public ProcOld As Long
'// Windows API Call for catching messages
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'// Windows API call for calling window procedures
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
'// menu windows api
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
'// windows api constants
Public Const WM_SYSCOMMAND = &H112
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Public Const GWL_WNDPROC = (-4)
Public Const IDM_ABOUT As Long = 1010
Public Function WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'// ----WARNING----
'// do not attempt to debug this procedure!!
'// ----WARNING----
'// this is our implementation of the message handling routine
'// determine which message was recieved
Select Case iMsg
Case WM_SYSCOMMAND
If wParam = IDM_ABOUT Then
MsgBox "VB Web Append to System Menu Example", vbInformation, "About"
Exit Function
End If
End Select
'// pass all messages on to VB and then return the value to windows
WindowProc = CallWindowProc(ProcOld, hWnd, iMsg, wParam, lParam)
End Function