How to Add To System Context Menu

Does anyone knows how you can add to the system context menu (Contains Restore,Max,Min,Close). GetSystemMenu gets the system menu and AppendMenu allows you to append to the menu but how can i really do something useful with the new appended menu??

Declare Function GetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long

the following code will help u to add a Helo ! menu item in SystemMenu.

'in bas module
Option Explicit
Public Const WM_SYSCOMMAND As Long = &H112&
Public Const IDM_ABOUT As Long = 1&
Public Const IDM_WHO As Long = 2&
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_DRAWCLIPBOARD = &H308
Public Const GWL_WNDPROC = (-4)
Dim PrevProc As Long
Public Sub HookForm(F As Form)
'here we sub classing the form
'previous address of WindowProc stores in PrevProc
'inorder to replace after the subclassing (forms unload)
PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf MyWindowProc)
End Sub
Public Sub UnHookForm(F As Form)
'here we replace actual WindowProc with MyWindowProc
SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
End Sub
Public Function MyWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'here we gets all msg
'u can do anything (with care)
Select Case uMsg
Case WM_SYSCOMMAND
If wParam = IDM_WHO Then
MsgBox "send your suggestions & bugs to me at [email protected] ", _
vbInformation, "MySysMenu"
End If
End Select
MyWindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
End Function



'in form
Option Explicit

Const MF_CHECKED = &H8&
Const MF_APPEND = &H100&
Const TPM_LEFTALIGN = &H0&
Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
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 AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim hSysMenu As Long
Private Sub Form_Load()

hSysMenu = GetSystemMenu(hwnd, ByVal 0&)
'Append a few menu items
AppendMenu hSysMenu, MF_STRING, IDM_WHO, "Hello !"
'subclassing the form inorder to retrieve all msgs
HookForm Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
'here we stops subclassing
'if not it will system will crashes (GPF) due invalid memory ref.
UnHookForm Me

End Sub

:) Enjoy
pramod kumar

Thanks, it works© I have another question on Checked menu like Always On Top in WinZip, How do you achieve the checked effect?? Using AppendMenu hSysMenu, MF_STRING+ MF_CHECKED, IDM_WHO, "Hello !" only have a tick beside it but it doesnt disappear©

Presently, I removed the menu and replace it with a check menu when user click on it©
What is the proper way to achieve the effect©

Try the CheckMenuTiem menu api

Yes, he is correct CheckMenuItem will do

delete all forms general declarations
and change bas module to this

Option Explicit

Public Const WM_SYSCOMMAND As Long = &H112&
Public Const IDM_ABOUT As Long = 1&
Public Const IDM_WHO As Long = 2&
Public Const MF_UNCHECKED = &H0&
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 Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
Public Declare Function GetMenuState Lib "user32" (ByVal hMenu As Long, ByVal wID As Long, ByVal wFlags As Long) As Long
Public Const MF_CHECKED = &H8&
Public Const MF_APPEND = &H100&
Public Const TPM_LEFTALIGN = &H0&
Public Const MF_DISABLED = &H2&
Public Const MF_GRAYED = &H1&
Public Const MF_SEPARATOR = &H800&
Public Const MF_STRING = &H0&
Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
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
Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Const WM_DRAWCLIPBOARD = &H308
Public Const GWL_WNDPROC = (-4)
Public hSysMenu As Long
Const WM_LBUTTONDOWN = &H201

Dim PrevProc As Long
Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim a As POINTAPI, b As POINTAPI
Public Sub HookForm(F As Form)
'here we sub classing the form
'previous address of WindowProc stores in PrevProc
'inorder to replace after the subclassing (forms unload)
PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf MyWindowProc)
End Sub
Public Sub UnHookForm(F As Form)
'here we replace actual WindowProc with MyWindowProc
SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
End Sub
Public Function MyWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'here we gets all msg
'u can do anything (with care)
'Debug.Print uMsg, wParam, lParam
Select Case uMsg
Case WM_SYSCOMMAND
If wParam = IDM_WHO Then
Dim Rtn As Long
'here checking whether menu is ckecked or not
'and modify with the rtn value
Rtn = GetMenuState(hSysMenu, IDM_WHO, MF_STRING)
If Rtn = MF_CHECKED Then
CheckMenuItem hSysMenu, IDM_WHO, MF_UNCHECKED
Else
CheckMenuItem hSysMenu, IDM_WHO, MF_CHECKED
End If
MsgBox "send your suggestions & bugs to me at [email protected] ", _
vbInformation, "MySysMenu"
End If



End Select
MyWindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
End Function

:)Enjoy
pramod kumar