Related:  

Windows' menu colour is a system property that applies to all applications, set through Control Panel's Appearance tab on the Display / Properties dialog. This setting is system-wide, and a well-behaved VB application will always respect the user's menu preferences.

But in a skinned or textured app there may be justifiable reasons to utilize a custom menu bar or menu/submenu colour. This page shows how to give your form a custom menu colour without affecting or changing the system's menu settings and, consequently, the user's preferences for Windows and for other applications.

As coded, the methods provide for the application to pass colour values as either long integers, long hexadecimal values, longs generated as the result of a call to the RGB() function, or VB or Windows constants representing standard system colours.

Translation of the colour value) passed is made via OleTranslateColor() in order to provide a mechanism ensure valid colours are applied (when the application provides for the user to choose the colours. Should the application not require this level of sophistication, for example when a specific or pre-defined set of known valid colours will are to be used, the routines could be simplified to directly use those values.

The routine provides for setting the colour of either or both of the main menu bar and the actual dropdown menu. At a minimum, the custom colour must be applied to the main menu bar. To provide the means to shade the menu bar and submenus differently (e.g. where different colours are desired for the menu bar and dropdown menus), the routine is called twice -- the first time specifying the colour for the dropdown menus (bIncludeSubmenus as True), then again with the colour for the menu bar passing bIncludeSubmenus as False. On the first call both the menu bar and submenus are assigned the new colour. On the second call only the menu bar itself is changed. The system menu responds to the same colouring technique, thus the demo includes the code to change the system menu to either the same or an entirely different colour than that of the other dropdown menus or menu bar.

Where the developer has created a menu for display as a popup menu, that menu can also receive the same or its own custom colour --- the popup will be displayed in the colour chosen. Naturally, popup menus defined on another form which has not received customization will appear in the normal system-wide menu preference colour.

Although this will customize the menu's BackColor, no corresponding method exists to change the menu text colour without delving into some serious subclassing.

If you would like your form's BackColor to follow the menu colour selected by the user, uncomment the BackColor lines in the demo code below. Also, be aware that to enable Windows to repaint the menu using the custom colour, it requires the brush created to persist during the lifetime of the application. Therefore, do not call DeleteObject to free the brush created; Windows will delete the brush on application termination.

One final point. Because Windows uses the hbrush specified to paint the menu, you could substitute CreateHatchedBrush for CreateSolidBrush -- the menu would be painted with diagonal, horizontal, vertical, hatched, or checked (square) lines alternating between the chosen colour and white. This is not recommended of course, but mentioned just to show it is possible.

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Const MIM_BACKGROUND As Long = &H2
Private Const MIM_APPLYTOSUBMENUS As Long = &H80000000

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 DrawMenuBar Lib "user32" _
  (ByVal hwnd As Long) As Long

Private Declare Function GetMenu Lib "user32" _
  (ByVal hwnd As Long) As Long

Private Declare Function GetSystemMenu Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal bRevert As Long) As Long

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 Sub Form_Load()

   Dim cnt As Long
   
   With Combo1
   
      .Move 3720, 240
   
      .AddItem "Button Face (Default)"
      .ItemData(.NewIndex) = vbButtonFace
      
      .AddItem "Application Workspace"
      .ItemData(.NewIndex) = vbApplicationWorkspace
            
      .AddItem "Window Background"
      .ItemData(.NewIndex) = vbWindowBackground
            
      .AddItem "Active Title Bar"
      .ItemData(.NewIndex) = vbActiveTitleBar
            
      .AddItem "Tooltip Background"
      .ItemData(.NewIndex) = vbInfoBackground
      
      .AddItem "(Select colour...)"
      
      .ListIndex = 0
      
   End With
   
End Sub

Private Sub Combo1_Click()

   Dim clrref As Long
   
   With Combo1
   
      If .ListIndex > -1 Then
   
         Select Case .ListIndex
      
            Case .ListCount - 1
            
               clrref = GetColor()
               
               If clrref > -1 Then
               
                  SetMenuColour Me.hwnd, clrref, True
                  SetSysMenuColour Me.hwnd, clrref
                  'Me.BackColor = clrref
                  
               End If
               
            Case Else
            
               SetMenuColour Me.hwnd, .ItemData(.ListIndex), True
               SetSysMenuColour Me.hwnd, .ItemData(.ListIndex)
               'Me.BackColor = .ItemData(.ListIndex)
   
         End Select
   
         
      End If
   End With
   
End Sub


Private Function GetColor() As Long

   On Local Error GoTo GetColor_error

   With CommonDialog1
     'trap cancel
      .CancelError = True

     'match colour if possible
      .flags = cdlCCRGBInit
      
     'get the actual color from
     'the form's current background.
     'This could also be passed as a
     'parameter to this method for
     'increased functionality
      .Color = TranslateOLEtoRBG(Me.BackColor)
      
     'get and return the colour selected
      .ShowColor
      GetColor = .Color
      
   End With

GetColor_exit:
   Exit Function

GetColor_error:
  'return -1 to enable trapping
  'and still allow black (value 0)
  'to be selected
   GetColor = -1
   Resume GetColor_exit

End Function


Private Function SetMenuColour(ByVal hwndfrm As Long, _
                               ByVal dwColour As Long, _
                               ByVal bIncludeSubmenus As Boolean) As Boolean

  'set application menu colour
   Dim mi As MENUINFO
   Dim flags As Long
   Dim clrref As Long
   
  'convert a Windows colour (OLE colour)
  'to a valid RGB colour if required
   clrref = TranslateOLEtoRBG(dwColour)
   
  'we're changing the background,
  'so at a minimum set this flag
   flags = MIM_BACKGROUND
   
   If bIncludeSubmenus Then
     'MIM_BACKGROUND only changes
     'the back colour of the main
     'menu bar, unless this flag is set
      flags = flags Or MIM_APPLYTOSUBMENUS
   End If

  'fill in struct, assign to menu,
  'and force a redraw with the
  'new attributes
   With mi
      .cbSize = Len(mi)
      .fMask = flags
      .hbrBack = CreateSolidBrush(clrref)
   End With

   SetMenuInfo GetMenu(hwndfrm), mi
   DrawMenuBar hwndfrm

End Function


Private Function SetSysMenuColour(ByVal hwndfrm As Long, _
                                  ByVal dwColour As Long) As Boolean

  'set system menu colour
   Dim mi As MENUINFO
   Dim hSysMenu As Long
   Dim clrref As Long

  'convert a Windows colour (OLE colour)
  'to a valid RGB colour if required
   clrref = TranslateOLEtoRBG(dwColour)

  'get handle to the system menu,
  'fill in struct, assign to menu,
  'and force a redraw with the
  'new attributes
   hSysMenu = GetSystemMenu(Me.hwnd, False)
   
   With mi
      .cbSize = Len(mi)
      .fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS
      .hbrBack = CreateSolidBrush(clrref)
   End With

   SetMenuInfo hSysMenu, mi
   DrawMenuBar hSysMenu
   
End Function


Private Function TranslateOLEtoRBG(ByVal dwOleColour As Long) As Long
    
  'check to see if the passed colour
  'value is and OLE or RGB colour, and
  'if an OLE colour, translate it to
  'a valid RGB color and return. If the
  'colour is already a valid RGB colour,
  'the function returns the colour without
  'change
   OleTranslateColor dwOleColour, 0, TranslateOLEtoRBG
      
End Function

If you inspect the SetMenuColour routine, you'll see the hwnd used in the SetMenuInfo call is that of the form passed to the method as the hwnd parameter. Another API not used - GetSubMenu - can provide the hwnd for each individual dropdown menu when called in conjunction with a 0-based index that represents a menu's physical position along the menu bar (ie File=0, Edit=1, and so on). And, by drilling down even further, each pop out menu under the parent menu can also be identified by its own hwnd if need be.

By passing SetMenuInfo the handle from GetSubMenu you can affect a background colour change to just the specified menu, rather than the entire form menu. The following code will change the menu bar to yellow, the File menu (or first menu on your test form) to cyan, and the second menu (Edit) to green. Any remaining menus will retain VB's default menu colour. Note too that if a dropdown menu has a pop out submenu it will not be coloured unless MIM_APPLYTOSUBMENUS is specified in the flags.

Private Sub Command1_Click()
  
   Dim mi As MENUINFO
   
   With mi
   
      .cbSize = Len(mi)
      
      .fMask = MIM_BACKGROUND
      .hbrBack = CreateSolidBrush(vbYellow)
       SetMenuInfo GetMenu(Me.hwnd), mi  'main menu bar
   
      .fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS
      .hbrBack = CreateSolidBrush(vbCyan)
       SetMenuInfo GetSubMenu(GetMenu(Me.hwnd), 0), mi 'File menu (item 0)
      
      .hbrBack = CreateSolidBrush(vbGreen)
       SetMenuInfo GetSubMenu(GetMenu(Me.hwnd), 1), mi 'Edit menu (item 1)
    
      .hbrBack = CreateSolidBrush(vbRed)
       SetMenuInfo GetSubMenu(GetMenu(Me.hwnd), 2), mi 'Select menu (item 2)
        
    End With
     
   DrawMenuBar Me.hwnd

End Sub

Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy