AJOUT DE SOUS MENU DYNAMIQUEMENT
olilefou
-
21 sept. 2001 à 13:21
AngeliusMefyrx Messages postés 52 Date d'inscription lundi 20 mars 2006 Statut Membre Dernière intervention 14 octobre 2007 - 16 mars 2007 à 17:45
AngeliusMefyrx Messages postés 52 Date d'inscription lundi 20 mars 2006 Statut Membre Dernière intervention 14 octobre 2007 - 16 mars 2007 à 17:45
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/156-ajout-de-sous-menu-dynamiquement
https://codes-sources.commentcamarche.net/source/156-ajout-de-sous-menu-dynamiquement
16 mars 2007 à 17:45
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
5 avril 2002 à 23:01
mais demande un peu de travil pour le rendre efficace a 100%
mais l'idée est bonne
bonne continuation
24 janv. 2002 à 11:03
Félicitazionne !
Ca progresse , ca progresse !!! Merci
24 sept. 2001 à 14:56
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 !
23 sept. 2001 à 10:28
il me sert !!!
21 sept. 2001 à 19:13
21 sept. 2001 à 13:21
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 8235
ClientLeft = 615
ClientTop = 1830
ClientWidth = 6555
LinkTopic = "Form1"
ScaleHeight = 8235
ScaleWidth = 6555
Begin VB.CommandButton Command1
Caption = "Ajout 3"
Height = 975
Index = 3
Left = 3120
Top = 240
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "Ajout 2"
Height = 975
Index = 2
Left = 1680
Top = 240
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "Ajout 1"
Height = 975
Index = 1
Left = 240
Top = 240
Width = 1335
End
Begin VB.Menu menu
Caption = "menu"
Begin VB.Menu Sous
Caption = "Sous"
Index = 0
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click(Index As Integer)
Command1(Index).Enabled = False
Load Sous(Index)
Sous(Index).Caption = "Sous " & Index
Sous(Index).Visible = True
End Sub
Private Sub Sous_Click(Index As Integer)
MsgBox "Choix " & Index
End Sub