VB and VBA Users Source Code: Changing the backcolor of a form menu
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Changing the backcolor of a form menu
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Sunday, May 18, 2003
Hits:
1206
Category:
Windows API
Article:
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 'Author : Andrew Baker 'Date : 25/05/2002 '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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
