Изменение фонового цвета меню - VB

Формулировка задачи:

Для перекрашивания фона меню формы пользуюсь вот таким кодом (АПИ-декларации опускаю):
Public 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
Работать-то оно работает, но вот если мышью просто 'провести' по всем пунктам КОРНЕВОГО меню (и тем более - если понажимать их), то вокруг всех этих корневых пунктов прорисовывается другим цветом некая 'граница', что сильно портит внешний вид формы ( Из-за чего это происходит - понятно: при наведении мышью на корневой пункт меню он 'приподнимается', и на НЕПЕРЕКРАШЕННОМ меню он при выведении мыши 'утапливается' обратно, и следов незаметно. А вот на перекрашенном - следы остаются... ВОПРОС: нельзя ли как-то отрубить этот 'hover-эффект' у корневых меню - чтобы при наведении на них мыши они вообще никак не реагировали, т.е. не приподнимались бы?! Может, у меню есть какой-нибудь 'стиль', который можно изменить через АПИ? или ещё что в этом духе?

Код к задаче: «Изменение фонового цвета меню - VB»

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

10   голосов, оценка 3.900 из 5


СОХРАНИТЬ ССЫЛКУ