Visual Basic Codes
Visual Basic > Forms sample source codes

Changing the backcolor of a form menu

Changing the backcolor of a form menu

The code below demonstrates how to change the backcolor of a VB form menu or menu item.

Option Explicit


Private Type MENUINFO
   cbSize As Long
   fMask As Long
   dwStyle As Long
   cyMax As Long
   hbrBack As Long
   dwContextHelpID As Long
   dwMenuData As Long
End Type

Private Declare Function SetMenuInfo Lib "user32" (ByVal hMenu As Long, mi As MENUINFO) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function OleTranslateColor Lib "olepro32.dll" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long



'Purpose   :    Change to color of a form menu (without changing system settings)
'Inputs    :    lhForm                  Handle to the form to change the color of
'               lMenuColor              The color to change the menu to
'               [bIncludeSubMenus]      If True changes the color of submenus, else
'                                       just changes the menu color.
'               [lMenuIndex]            If specified, the zero based index of the menu
'                                       item to set the color of, else sets the color
'                                       of all menu items.
'Outputs   :    Returns True on success
'Example   :    FormMenuColour Me.hwnd, vbRed, True
'Notes     :

Function FormMenuColour(ByVal lhForm As Long, ByVal lMenuColor As Long, Optional ByVal bIncludeSubMenus As Boolean = True, Optional lMenuIndex As Long = -1) As Boolean
    Const MIM_BACKGROUND As Long = &H2, MIM_APPLYTOSUBMENUS As Long = &H80000000
    Dim tMenuInf As MENUINFO
    Dim lFlags As Long
    Dim lRGBColor As Long
    Dim lhMenu As Long
    
    On Error GoTo ErrFailed
    'Convert a Windows colour (OLE colour) to a valid RGB
    OleTranslateColor lMenuColor, 0, lRGBColor
    
    'Set Flag
    lFlags = MIM_BACKGROUND
    If bIncludeSubMenus Then
        'Change all sub menu colors
        lFlags = lFlags Or MIM_APPLYTOSUBMENUS
    End If
    
    With tMenuInf
        .cbSize = Len(tMenuInf)
        .fMask = lFlags
        .hbrBack = CreateSolidBrush(lRGBColor)
    End With
    
    If lMenuIndex <> -1 Then
        'Apply color to a specific menu
        lhMenu = GetSubMenu(GetMenu(lhForm), lMenuIndex)
    Else
        'Apply color to all menus
        lhMenu = GetMenu(lhForm)
    End If
    
    If lhMenu Then
        SetMenuInfo lhMenu, tMenuInf
        FormMenuColour = (Err.LastDllError = 0)
        DrawMenuBar lhForm
    Else
        Debug.Print "Form doesn't have a menu"
        Debug.Assert False
        FormMenuColour = False
    End If
    
    Exit Function
    
ErrFailed:
    Debug.Print Err.Description
    Debug.Assert False
    FormMenuColour = False
End Function