Ajouter des images dans un menu

Soyez le premier à donner votre avis sur cette source.

Vue 9 241 fois - Téléchargée 2 387 fois

Description

Ce code permet d'ajouter des images (BITMAP, attention, les icones ne sont pas supportées) dans un menu d'application... Il suffit de passer en paramètre le libellé d'item de menu à modifier, ainsi que l'image à afficher. Celle ci peut être venir d'une PictureBox ou d'une ImageList. Grosse amélioration par rapport aux codes que l'on peut trouver sur le net : sachant que la dimensions des images de menu sont dynamiques (en fonction de la résolution), ce code redimensionne automatiquement le bitmap avant de la plaquer sur le menu. Vous avez donc possibilité d'utiliser directement des bitmaps 16x16, 32x32 voire plus, ils seront pris en charge automatiquement.
A la demande générale, g tout remis dans un ZIP

Conclusion :


Attention toutefois lorsque vous passez des bitmap bcp + grands que la dimensions des images de menu : le redimensionnement risque de pas être très très joli

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
62
Date d'inscription
samedi 10 janvier 2009
Statut
Membre
Dernière intervention
30 octobre 2012

Au 4ème essai et après quelques modifications j'ai réussi à faire fonctionner ce programme

J'ai supprimé le redimensionnement pas vraiment indispensable.
ça marche sauf pour les popupmenus; quand on décoche la case 'Visible' dans le créateur de menus les images
n'apparaissent plus dans les sou-menus
Si quelqu'un à une idée sur le sujet, merci de nous la faire partager.

Exemple de menu dans une Form qui contient les menus sous-menus et les images en non visible

Fichiers
Ouvrir
Enregistrer
Imprimer

Dans la Form

Private Sub Form_Load()

...........

'Ajouter Icons dans menus
Dim hMenu As Long
hMenu = GetMenu(Me.hWnd)

AddIconToMenu "Ouvrir" , PicOuvrir.Picture, hMenu
AddIconToMenu "Enregistrer" , PicEnregistrer.Picture, hMenu
AddIconToMenu "Imprimer" , PicImprimer.Picture, hMenu

............

End Sub

Dans un module

Option Explicit

'******************************* TYPES APIs ************************************
Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wid As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

'**************************** CONSTANTES APIs **********************************
Public Const SM_CXMENUCHECK = 71
Public Const SM_CYMENUCHECK = 72

Private Const MENU_IDENTIFIER As Long = &H1
Private Const MIIM_TYPE = &H10
Private Const MIIM_SUBMENU = &H4
Private Const MIIM_STATE As Long = &H1
Private Const MIIM_ID As Long = &H2
Private Const MIIM_CHECKMARKS As Long = &H8
Private Const MIIM_DATA As Long = &H20
Private Const MF_POPUP = &H10
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
Private Const MF_SEPARATOR = &H800
Private Const MF_BITMAP = &H4&
Private Const MFT_STRING As Long = &H0
Private Const MFT_BITMAP = MF_BITMAP
Private Const MFT_RADIOCHECK = &H200&

'******************************** APIs ****************************************

Public 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 GetMenuCheckMarkDimensions Lib "User32" () As Long
Private Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long
Private Declare Function GetMenuItemID Lib "User32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemInfo Lib "User32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal ByPos As Boolean, lpmii As MENUITEMINFO) As Long
Private Declare Function SetMenuItemInfo Lib "User32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal uItem As Long, ByVal ByPos As Long, lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function ModifyMenuPic Lib "User32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Long) As Long
Public Declare Function SetMenuItemBitmaps Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

'****************************** FONCTION ****************************************
Public Sub AddIconToMenu(ByVal pMenuLabel As String, ByVal pMenuPicture As Long, hMenu As Long)
Dim ret As Long, hSubMenu As Long
Dim MenuID As Long, CurMenu As MENUITEMINFO
Dim NbMenus As Long, NbSubMenus As Long
Dim i As Long, j As Long

'Recherche de l'ID de l'item de menu dont le libellé est passé en paramètre
NbMenus = GetMenuItemCount(hMenu)
For i = 0 To NbMenus
hSubMenu = GetSubMenu(hMenu, i)
NbSubMenus = GetMenuItemCount(hSubMenu)
For j = 0 To NbSubMenus
With CurMenu
.cbSize = Len(CurMenu)
.fMask = MIIM_TYPE
.fType = MFT_STRING
.dwTypeData = vbNullString
.cch = Len(.dwTypeData)

ret = GetMenuItemInfo(hSubMenu, j, MENU_IDENTIFIER, CurMenu)

.dwTypeData = Space$(.cch + 1)
.cch = Len(.dwTypeData)

ret = GetMenuItemInfo(hSubMenu, j, MENU_IDENTIFIER, CurMenu) If Left$(Trim$(.dwTypeData), Len(pMenuLabel)) pMenuLabel Then MenuID GetMenuItemID(hSubMenu, j): Exit For
MenuID = 0
End With
Next
If MenuID <> 0 Then Exit For
Next

If MenuID = 0 Then Exit Sub 'Elément de menu non trouvé

'Affection au menu
SetMenuItemBitmaps hSubMenu, MenuID, MF_BYCOMMAND, pMenuPicture, pMenuPicture

End Sub
Messages postés
62
Date d'inscription
samedi 10 janvier 2009
Statut
Membre
Dernière intervention
30 octobre 2012

Au 3ème essai et après quelques recherches voilà ou j'en suis

Le code à mettre dans la form sur laquelle se trouve les menus (Name -> Form1 par exemple)
peut s'écrire comme suit

AddIconToMenu "Ouvrir", Img1

(Img1 est une Picture sur Form1 non visible)

Dans le module
hMenu GetMenu(MainW.hwnd) devient hMenu GetMenu(Form1.hwnd)

et ajouter comme écrit plus haut
Public Const SRCCOPY &HCC0020 ' (DWORD) dest source

Ayant fait ces modifications je clique sur 'Exécuter'

puis je clique sur le menu Ad Hoc et surprise le menu ne fait plus apparaitre les sous-menus
il est bloqué ?? donc pas de sous-menus et pas d'image !!

Quelqu'un a t il peut obtenir une image et si oui comment ?

Merci d'avance
Messages postés
62
Date d'inscription
samedi 10 janvier 2009
Statut
Membre
Dernière intervention
30 octobre 2012

Au 2ème essai un 3ème bug

la variable SRCCOPY n'est pas définie

Merci de votre aide
Messages postés
62
Date d'inscription
samedi 10 janvier 2009
Statut
Membre
Dernière intervention
30 octobre 2012

Au 1er essai 2 problèmes

1 - L'instruction suivante provoque une erreur
AddIconToMenu mnuSites(0), ImgList1(1)

l'argument pour les menus est accepté mais pour les images venant d'une ImageList
il est refusé (Vb ne gère pas ....)
un exemple serait le bienvenu

2 - Dans l'instruction 'hMenu = GetMenu(MainW.hwnd)' la variable MainW n'est pas définie

Merci de votre aide
Messages postés
51
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
7 juillet 2006

arg j'ai plein d'erreur (WMain.hwnd, y connait pas et moi non plus, et ya le truc avec sccopy...)
bon bref de toute facon j'en ai pas vraiment besoin, mais bon ca aurait été un plus ;)
Afficher les 24 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.