Commentaires sur une source : AJOUTER DES IMAGES DANS UN MENU

lionyz Messages postés 62 Date d'inscription samedi 10 janvier 2009 Statut Membre Dernière intervention 30 octobre 2012
7 mars 2009 à 11:30

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

lionyz Messages postés 62 Date d'inscription samedi 10 janvier 2009 Statut Membre Dernière intervention 30 octobre 2012
6 mars 2009 à 23:46

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

lionyz Messages postés 62 Date d'inscription samedi 10 janvier 2009 Statut Membre Dernière intervention 30 octobre 2012
6 mars 2009 à 00:45

Au 2ème essai un 3ème bug

la variable SRCCOPY n'est pas définie

Merci de votre aide

lionyz Messages postés 62 Date d'inscription samedi 10 janvier 2009 Statut Membre Dernière intervention 30 octobre 2012
6 mars 2009 à 00:32

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

pekch Messages postés 51 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 7 juillet 2006
2 juil. 2006 à 01:25

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 ;)

Rifton007 Messages postés 4 Date d'inscription vendredi 15 janvier 2010 Statut Membre Dernière intervention 20 janvier 2010
31 janv. 2005 à 18:29

Comment sa fonctionne j'ai rien compris.

zeunz Messages postés 200 Date d'inscription jeudi 26 février 2004 Statut Membre Dernière intervention 30 juin 2008
23 janv. 2005 à 22:52

slt j'ai essaye la methede d'ARTSoft, et ca ne marche ke pr les fichiers image avec une largeur et hauteur de 12 cm chacun. ms si c'est plus grand, le menu me coupe l'image....

KeepCool37 Messages postés 11 Date d'inscription vendredi 10 janvier 2003 Statut Membre Dernière intervention 30 novembre 2006
12 nov. 2004 à 13:54

Cette source ne fonctionne pas sur ma machine XP.
J'ai essayé d'essayer de comprendre et il semble que cela vienne d'un problème de compatibilité avec l'ImageList.
Il faut prendre l'ImageList issue de la librairie de composants COMCTL32.ocx dans Microsoft Windows Common Controls 5.0 (SP2) (voir le menu Projet/Composant... dans l'ide VB6) et non celle de MSCOMCTL.ocx dans Microsoft Windows Common Controls 6.0 (SP6)
En redéfinissant les icons ça marche du tonner !!!!!!!

cs_scoob79 Messages postés 23 Date d'inscription mercredi 3 novembre 2004 Statut Membre Dernière intervention 9 mars 2010
3 nov. 2004 à 22:32

cela ne marche pas chez peut-être que je ne sais pas le faire fonctionner j'attend le zip avec demo.

tmeg Messages postés 33 Date d'inscription mardi 17 juin 2003 Statut Membre Dernière intervention 12 mars 2009
2 sept. 2004 à 17:13

oui un exemple et plus de commentaire serais le bienvenue mais sinon nikel

Egalon Messages postés 124 Date d'inscription lundi 26 avril 2004 Statut Membre Dernière intervention 17 juin 2011
25 août 2004 à 15:42

C'est clair qu'on y voit rien!
Un exemple serait le bienvenu.
Merci

benzinafouad Messages postés 25 Date d'inscription jeudi 15 août 2002 Statut Membre Dernière intervention 21 juillet 2004
12 avril 2004 à 19:43

Pourquoi ne pas faire un exemple dans le zip?!!!!!!!!!!!! c bizzar

KeepCool37 Messages postés 11 Date d'inscription vendredi 10 janvier 2003 Statut Membre Dernière intervention 30 novembre 2006
26 mars 2004 à 18:13

ça ne veut pas marcher !!!!

A la base, il manquait :

Public Const SRCCOPY &HCC0020 ' (DWORD) dest source

Pi j'vois tjrs pas ma zimage dans le menu !

Jujufouq Messages postés 254 Date d'inscription jeudi 27 décembre 2001 Statut Membre Dernière intervention 5 mars 2006
27 juin 2003 à 00:05

Intéressant, mérite qu'on se penche dessus. Bonne note.

cs_laestrella Messages postés 93 Date d'inscription lundi 16 juin 2003 Statut Membre Dernière intervention 27 juin 2003
26 juin 2003 à 09:57

Merci pour le zip et c'est mieux d'en mettre un à chaque fois

cs_jmluc Messages postés 57 Date d'inscription mercredi 19 décembre 2001 Statut Membre Dernière intervention 31 juillet 2003
26 juin 2003 à 09:29

Je vais testé ta nouvelle méthode...
En attendant ton travail est bien...8/10
jmluc

Matesys Messages postés 2 Date d'inscription jeudi 12 juin 2003 Statut Membre Dernière intervention 26 juin 2003
26 juin 2003 à 09:18

Le code de jmluc marche effectivement, ct la 1ère version que j'avais écrite... Seulement, ce code oblige à avoir des images préformattées ayant une taille valide, c-a-d correspondant à la taille définie par le système avec la résolution écran en cours... Ici, je peux envoyer des images en 48x48 qui seront redimensionnées avec la taille ad hoc... Pour le type BITMAP, g mis à jour le code

cs_EBArtSoft Messages postés 4525 Date d'inscription dimanche 29 septembre 2002 Statut Modérateur Dernière intervention 22 avril 2019 9
26 juin 2003 à 09:15

C'est vrais que la methode de jmluc est typique et bien plus simple cela dit pour utiliser les icones on peut utiliser ta methode avec l'API drawicon au lieu de stretchblt !

j'y comprend rien au "niveau" mais niveau le niveau 3 ne me semble
pas etre adapté...

mauvais point je ne sait pas si tu as testé ta source avant de la balancer compte tenu des oublis comme celui de liberer la memoire du bitmap en fin de routine :

hStretchBitmap = CreateCompatibleBitmap(...)
...
DeleteObject hStretchBitmap

je met 5/10

Applique toi, continue et B@nne prog

cs_jmluc Messages postés 57 Date d'inscription mercredi 19 décembre 2001 Statut Membre Dernière intervention 31 juillet 2003
26 juin 2003 à 08:35

J'avais vu bien plus simple y'a qques temps pour un développement :
Dans un module :
Public Declare Function GetMenu Lib "user32" (ByVal hwnd 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
'
Public Const M_BITMAP = 4&

Dans ta form :

Private Sub Form_Load()
Dim hMenu As Long
Dim hSousMenu As Long
Dim ID As Long
'
'*** REM : le premier sousmenu a pour index 2, le suivant 3 etc...

hMenu = GetMenu(Me.hwnd)
'*** Premier sous-menu <ouvrir>
'
ID = 2
SetMenuItemBitmaps hMenu, ID, M_BITMAP, PicOuvrir.Picture, PicOuvrir.Picture
'*** Deuxième Sous-Menu <Enregistrer>
'
ID = 3
SetMenuItemBitmaps hMenu, ID, M_BITMAP, PicEnregistrer.Picture, PicEnregistrer.Picture

ID = 5
SetMenuItemBitmaps hMenu, ID, M_BITMAP, PicStop.Picture, PicStop.Picture

End Sub

Private Sub mnuQuitter_Click()
End
End Sub

Cela suppose que tes images sont sur la form en non visible...
Mais ça marche bien
jmluc@jmlucienvb.org

cs_psycho Messages postés 232 Date d'inscription samedi 11 mai 2002 Statut Membre Dernière intervention 27 octobre 2007
25 juin 2003 à 19:55

g rajouté ca et ca marche...
Private Type BITMAP '14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
(issu de la visionneuse d api.)
++
psycho

cs_Urgo Messages postés 780 Date d'inscription lundi 16 décembre 2002 Statut Membre Dernière intervention 16 avril 2009 1
25 juin 2003 à 17:30

Un zip pour les flémards comme moi :)

cs_LogOff Messages postés 69 Date d'inscription dimanche 6 octobre 2002 Statut Membre Dernière intervention 14 juillet 2009
25 juin 2003 à 16:59

Ce code a l'air super (et surtout simple à utiliser !), mais la ligne:
Dim CurBitmap As bitmap provoque une erreur :
type défini par l'utilisateur non défini

Quelqu'un pourrait-il résoudre le pb ?
Merci d'avance

cs_max12 Messages postés 1491 Date d'inscription dimanche 19 novembre 2000 Statut Modérateur Dernière intervention 7 juillet 2014
25 juin 2003 à 16:41

C'est vrai qu'un zip serais fortement interressant pour les débutants :)

cs_laestrella Messages postés 93 Date d'inscription lundi 16 juin 2003 Statut Membre Dernière intervention 27 juin 2003
25 juin 2003 à 15:56

T'es un fou toi de laisser ça sans fichier ZIP lol.
C'est bien joli mais je te conseil de le mettre dans un Zip. ça sera plus facile pour tout le monde.

AJOUTER DES IMAGES DANS UN MENU

Votre réponse

Discussions similaires