Изменение фонового цвета меню - VB
Формулировка задачи:
Для перекрашивания фона меню формы пользуюсь вот таким кодом (АПИ-декларации опускаю):
Работать-то оно работает, но вот если мышью просто 'провести' по всем пунктам КОРНЕВОГО меню (и тем более - если понажимать их), то вокруг всех этих корневых пунктов прорисовывается другим цветом некая 'граница', что сильно портит внешний вид формы (
Из-за чего это происходит - понятно: при наведении мышью на корневой пункт меню он 'приподнимается', и на НЕПЕРЕКРАШЕННОМ меню он при выведении мыши 'утапливается' обратно, и следов незаметно. А вот на перекрашенном - следы остаются...
ВОПРОС: нельзя ли как-то отрубить этот 'hover-эффект' у корневых меню - чтобы при наведении на них мыши они вообще никак не реагировали, т.е. не приподнимались бы?! Может, у меню есть какой-нибудь 'стиль', который можно изменить через АПИ? или ещё что в этом духе?
Решение задачи: «Изменение фонового цвета меню»
textual
Листинг программы
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Static overMenu As Boolean, oldRootItem As Long Dim mbInfo As PMENUBARINFO, retVal As Long, i As Integer, pt As POINTAPI Select Case uMsg Case WM_NCMOUSEMOVE If wParam = HTMENU Then overMenu = True For i = 1 To 7 ' << число корневых пунктов меню = 7 mbInfo.cbSize = Len(mbInfo) retVal = GetMenuBarInfo(frmParams.hwnd, OBJID_MENU, i, mbInfo) If retVal <> 0 Then GetCursorPos pt If PtInRect(mbInfo.rcBar, pt.X, pt.Y) Then Exit For End If Next If i <> oldRootItem Then ' перекрашиваем при переходе с одного корневого пункта меню на другой, ' когда собственно и появляется неприятная 'граница' вокруг пункта: Debug.Print 'Moved to root item ' & i SetMenuColour frmParams.hwnd, frmParams.BackColor, False oldRootItem = i End If End If Case WM_MOUSEMOVE, WM_LBUTTONDOWN, WM_RBUTTONDOWN If overMenu Then ' перекрашиваем при выходе мыши за пределы menubar (и при щелчке там же): Debug.Print 'Moved or clicked outside menubar' overMenu = False oldRootItem = -1 SetMenuColour frmParams.hwnd, frmParams.BackColor, False End If Case WM_EXITMENULOOP ' меню 'захлопнулось' - после этого тоже остаётся граница --> перекрашиваем: Debug.Print 'Menu closed' overMenu = False oldRootItem = -1 SetMenuColour frmParams.hwnd, frmParams.BackColor, False Case Else End Select WindowProc = CallWindowProc(mWndProcNext2, hwnd, uMsg, wParam, ByVal lParam) End Function