Ajout de sous menu dynamiquement

Soyez le premier à donner votre avis sur cette source.

Vue 8 379 fois - Téléchargée 1 158 fois

Description

Permet d'ajouter a un sous menu dynamiquement a un menu deja existant (utilisation d'API Windows)

Tout est dans le zip

Conclusion :


Si quelqu'un sait faire la même chose sans API je prend !

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
52
Date d'inscription
lundi 20 mars 2006
Statut
Membre
Dernière intervention
14 octobre 2007

*********************Ce que ça fait*******************
Base de données Access
Lorsqu'on charge le programme, ça accès une base de données Access
Ca créer alors un menu dynamique et attribue une commande afilié à celle ci

J'ai mis pas mal toute le code que je croyais utile
Inutilie de dire qu'il faut appeller la function dans le Form Load
De plus, cela attribue un menu au 6e menu de la fenetre aupréalablement créer avec rien dedans
Pour le premier, juste remplacer le 6 par 0 aux 2 endroits approprié
chemin = Le chemin de la BD access
DBPassword = Mettre ce que vous voulez si ya un mot de passe, sinon enlever la derniere option qui load la BD
Désoler mais, ça fait partis d'un programme que je fais, donc j'ai simplement copier le code lier à cette partie...j,espère rien avoir oublier

*************************BD ACCESS***********************
Table:
DBA_Raccourci

Champs:
Application Exemple: Boite de partage
Liens Exemple: iexplore "http://support.lexmark.com/cgi-perl/knowledgebase.cgi?ccs=37:3:0:101:0:0&docid=ENUS8664"
Categorie Exemple: Liens Internet

*************************MODULE***********************

Public pOldProc As Long
Public pOldProc2 As Long

Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long
Public Declare Function SetMenuItemInfo Lib "user32" Alias "SetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, lpcMenuItemInfo As MENUITEMINFO) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public 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

Public retval As Long
Public chemin As String

Public mii1 As MENUITEMINFO 'strucutre d'info d'un menu


Public Const MIIM_STATE = &H1
Public Const MIIM_ID = &H2
Public Const MIIM_SUBMENU = &H4
Public Const MIIM_CHECKMARKS = &H8
Public Const MIIM_DATA = &H20
Public Const MIIM_TYPE = &H10
Public Const MFT_BITMAP = &H4
Public Const MFT_MENUBARBREAK = &H20
Public Const MFT_MENUBREAK = &H40
Public Const MFT_OWNERDRAW = &H100
Public Const MFT_RADIOCHECK = &H200
Public Const MFT_RIGHTJUSTIFY = &H4000
Public Const MFT_RIGHTORDER = &H2000
Public Const MFT_SEPARATOR = &H800
Public Const MFT_STRING = &H0
Public Const MFS_CHECKED = &H8
Public Const MFS_DEFAULT = &H1000
Public Const MFS_DISABLED = &H2
Public Const MFS_ENABLED = &H0
Public Const MFS_GRAYED = &H1
Public Const MFS_HILITE = &H80
Public Const MFS_UNCHECKED = &H0
Public Const MFS_UNHILITE = &H0

Public Const WM_COMMAND = &H111

Public Const GWL_WNDPROC = -4
Public Const DBPassword = ""


Public hPopupMenu1 As Long 'handle du menu déroulant
Public hPopupSMenu1 As Long
Public hPopupSMenu2 As Long

Public hMenu As Long 'handle pour manipuler le menu "FICHIER" temporairement

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096


Public conDatabase As Database
Public Table_Menu_App() As String
Public Table_Menu_App_H As Integer


Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim i As Integer
If uMsg = WM_COMMAND Then
For i = 0 To Table_Menu_App_H
If Table_Menu_App(2, i) <> "" And Table_Menu_App(0, i) = wParam Then
Set go = CreateObject("WScript.Shell")
go.run Table_Menu_App(2, i)
End If
Next i
End If
WindowProc = CallWindowProc(pOldProc, hwnd, uMsg, wParam, lParam)
End Function



Rem ***************************************** Frm_Main *******************************************

Private Sub Load_Menu_Favoris()
Dim StrSQL As String
Dim Rs As Recordset
hPopupMenu1 = CreatePopupMenu()
Dim CategorieTmp As String
Dim Incrementeur As Integer
Incrementeur = 100
Table_Menu_App_H = -1

Set conDatabase = OpenDatabase(chemin, Options, ReadOnly, "MS Access;pwd=" & DBPassword)
StrSQL = "SELECT * FROM DBA_Raccourci ORDER BY Categorie DESC, Application DESC"
Set Rs = conDatabase.OpenRecordset(StrSQL)

If Rs.RecordCount > 0 Then
Rs.MoveFirst
Do Until Rs.EOF
If Rs.Fields("Categorie") <> CategorieTmp Then
Incrementeur = Incrementeur + 1
hPopupSMenu1 = CreatePopupMenu()
CategorieTmp = Rs.Fields("Categorie")
With mii1
.cbSize = Len(mii1)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fState = MFS_ENABLED
.wID = Incrementeur
.fType = MFT_STRING
.dwTypeData = Rs.Fields("Categorie")
.cch = Len(.dwTypeData)
End With
retval = InsertMenuItem(hPopupMenu1, 0, 1, mii1)
hMenu = GetMenu(Frm_Main.hwnd)
retval = GetMenuItemInfo(hMenu, 6, 1, mii1) 'Le 7e menu dans la liste
With mii1
.cbSize = Len(mii1)
.fMask = MIIM_SUBMENU
.hSubMenu = hPopupMenu1
End With
retval = SetMenuItemInfo(hMenu, 6, 1, mii1) 'Le 7e menu dans la liste
End If

Incrementeur = Incrementeur + 1
Table_Menu_App_H = Table_Menu_App_H + 1
ReDim Preserve Table_Menu_App(0 To 2, 0 To Table_Menu_App_H)
Table_Menu_App(0, Table_Menu_App_H) = Incrementeur
Table_Menu_App(1, Table_Menu_App_H) = Rs.Fields("Application")
Table_Menu_App(2, Table_Menu_App_H) = Rs.Fields("Liens")

With mii1
.cbSize = Len(mii1)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fState = MFS_ENABLED
.wID = Incrementeur
.fType = MFT_STRING
.dwTypeData = Rs.Fields("Application")
.cch = Len(.dwTypeData)
End With
retval = InsertMenuItem(hPopupSMenu1, 0, 1, mii1)
retval = GetMenuItemInfo(hPopupMenu1, 0, 1, mii1)
With mii1
.cbSize = Len(mii1)
.fMask = MIIM_SUBMENU
.hSubMenu = hPopupSMenu1
End With
retval = SetMenuItemInfo(hPopupMenu1, 0, 1, mii1)
Rs.MoveNext
Loop
End If
pOldProc = SetWindowLong(Frm_Main.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Messages postés
6
Date d'inscription
vendredi 5 avril 2002
Statut
Membre
Dernière intervention
30 mars 2005

interessant
mais demande un peu de travil pour le rendre efficace a 100%
mais l'idée est bonne
bonne continuation
Messages postés
159
Date d'inscription
mardi 18 décembre 2001
Statut
Membre
Dernière intervention
15 septembre 2005

Bien cool ces petits codes sources courts mais efficaces !

Félicitazionne !

Ca progresse , ca progresse !!! Merci
c'est pour ça que j'ai donner mon prog car avec Vb on peut pas faire de sous menu :
Dans l'exemple de olilefou même si tu met un index au menu "Menu" on peut crée d'autre menu
load Menu(index)

par contre ça charge pas les sous menu en même temps donc ça sert a rien !
olilefou il est genial ton code !!!!!!!
il me sert !!!
Afficher les 7 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.