MENU

[THEROB]

Does anyone know how to change that menu that appears when you press ALT + SPACE (that one that contains: move, size, minimize, maximize, close)

I have seen it done in other programs.

Thanks

Rob.

You have to Subclass.

Sub-Classing: Adding an About box to the control menu.

1. Start a new Standard-Exe project, form1 is created by default.

2. Add a standard module to the project, project menu and click 'add module'

3. The new module should open up by default. Add the following code.

Remember and I keep telling people you write to me and say
 my samples do not work. Make sure that the API
 declarations are one line


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_ABOUT 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_ABOUT Then
        MsgBox "About . . .", vbInformation, "About"
        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, lRet As Long

lhSysMenu = GetSystemMenu(FormName.hWnd, 0&)
lRet = AppendMenu(lhSysMenu, MF_SEPARATOR, 0&, _
vbNullString)
lRet = AppendMenu(lhSysMenu, MF_STRING, _
IDM_ABOUT, "About...")

FormName.Show
lProcOld = SetWindowLong(FormName.hWnd, GWL_WNDPROC, _
AddressOf SysMenuCode.SysMenuHandler)
End Function
4. Open up the code window for form1 and type the following

Option Explicit

Private Sub Form_Load()
Dim d As String
d = SubClass(Form1) 'Type the name of the form d =
SubClass(<FormName>)
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, lProcOld
End Sub
5. I have altered the code to work with any form just specify the form name where I have commented the code.

6. Run the project by clicking on run on the toolbar or from the run menu.

If you click on the control menu then you will see two
 items. One a separator and the other which
 says 'About...'. Click on about and a message box appears 
with my copyright.



Tip by Steve Anderson

[kedaman]

'I got this code from somewhere, probably planetsourcecode
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 = 274
Public Const MF_SEPARATOR = &H800
Public Const MF_STRING = 0
Public Const GWL_WNDPROC = -4
Public Const IDM_ABOUT& = 1010
Public lProcOld As Long

Private 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_ABOUT Then
            MsgBox "About . . .", vbInformation, "About"
            Exit Function
        End If
    End If
    SysMenuHandler = CallWindowProc(lProcOld, hWnd, iMsg, wParam, lParam)
End Function

'To Start subclassing, put in form load
Dim lhSysMenu&
    lhSysMenu = GetSystemMenu(Me.hWnd, 0&)
    AppendMenu lhSysMenu, MF_SEPARATOR, 0&, vbNullString
    AppendMenu lhSysMenu, MF_STRING, IDM_ABOUT, "About..."
    lProcOld = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf SysMenuHandler)

'To end subclassing (better put this one in form unload, to avoid crash)
SetWindowLong Me.hWnd, GWL_WNDPROC, lProcOld
'It will crash anyway if you break the code so you have to fire this line in immediate window before debugging

[kedaman]

Hehe, matt you usually seems to be faster than me, that was some 2 seconds right=? hehe

And your on cable modem kedaman.
I am using a DUN connection.

And...all answers are better than none .

[SteveCRM]

hmmm...has there been a shift of power on the boards?

[kedaman]

Steve got a point? Eh, matthew maybe i should switch back to my old 33.6 modem or hehe, 1+1=2