Changer la couleur de fond d'un menu

0/5 (12 avis)

Snippet vu 8 992 fois - Téléchargée 35 fois

Contenu du snippet

Je ne sais pas si ça a été déjà proposé, mais ce bout de code permet de changer la couleur de fond d'un menu, tout simplement.

Source / Exemple :


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
'Déclaration des API
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

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
'Convertis une couleur windows (ole) en RGB
    OleTranslateColor lMenuColor, 0, lRGBColor
    
    'les Flags...
    lFlags = MIM_BACKGROUND
    If bIncludeSubMenus Then
        "Changer la couleur de fond de tous les sous-menus
        lFlags = lFlags Or MIM_APPLYTOSUBMENUS
    End If
    
    With tMenuInf
        .cbSize = Len(tMenuInf)
        .fMask = lFlags
        .hbrBack = CreateSolidBrush(lRGBColor)
    End With
    
    If lMenuIndex <> -1 Then
        'Appliquer la couleur à un mlenu spécifié
        lhMenu = GetSubMenu(GetMenu(lhForm), lMenuIndex)
    Else
        'Appliquer la couleur a un menu spécifié
        lhMenu = GetMenu(lhForm)
    End If
    
    If lhMenu Then
        SetMenuInfo lhMenu, tMenuInf
        FormMenuColour = (Err.LastDllError = 0)
        DrawMenuBar lhForm
    Else
        Debug.Print "Pas de menu..."
        Debug.Assert False
        FormMenuColour = False
    End If
    
    Exit Function
    
ErrFailed:
    Debug.Print Err.Description
    Debug.Assert False
    FormMenuColour = False
End Function

Conclusion :


Exemple d'utilisation:

FormMenuColour Me.hwnd, vbRed, True

A voir également

Ajouter un commentaire Commentaires
phugon Messages postés 3 Date d'inscription samedi 14 octobre 2000 Statut Membre Dernière intervention 20 mai 2009
20 mai 2009 à 16:51
Très Bien
Rien à redire
amerzagkof Messages postés 7 Date d'inscription lundi 13 août 2007 Statut Membre Dernière intervention 14 août 2007
9 janv. 2008 à 15:30
c'est de poster un zip
Dragonmaster Messages postés 126 Date d'inscription vendredi 20 août 2004 Statut Membre Dernière intervention 3 avril 2009
19 oct. 2004 à 18:23
Oui, mais pour ceux qui ne veulent pas utiliser d'OCX, c'est une solution...
annesirine Messages postés 38 Date d'inscription samedi 16 octobre 2004 Statut Membre Dernière intervention 19 février 2006
18 oct. 2004 à 06:02
Oui mais au moins c'est beau ...
Dragonmaster Messages postés 126 Date d'inscription vendredi 20 août 2004 Statut Membre Dernière intervention 3 avril 2009
17 oct. 2004 à 21:22
ça, ce n'est pas de la coloration... J'ai déjà vu un OCX sur vbfrance.com qui transformait les menu à la façon office Xp :)
Afficher les 12 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.