1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
| Private m_hWnd As Long 'handle
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Any) As Long 'API pour rechercher le handle d'une fenetre
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal HWND As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 'API pour envoyer une commande a une fenetre avec son Handle
Public Declare Function GetMenu Lib "user32" (ByVal HWND As Long) 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 DrawMenuBar Lib "user32" (ByVal HWND As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As Boolean, _
lpmii As MENUITEMINFO) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
' Déclaration de constantes
Public Const MF_STRING = &H0&
Public Const MF_HELP = &H4000&
Public Const MFS_DEFAULT = &H1000&
Public Const MIIM_ID = &H2
Public Const MIIM_SUBMENU = &H4
Public Const MIIM_TYPE = &H10
Public Const MIIM_DATA = &H20
' Déclaration du type MENU
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
Sub import()
' Déclaration des variables utilisées
Dim hMenu As Long, lgNbMenu As Long
Dim lgRet As Long
Dim stBuffer As String * 80
Dim lpItemInfo As MENUITEMINFO
Dim hSubMenu As Long, hSsubMenu As Long
Dim HWND As Long
Dim sMenu As Long
Dim ssMenu As Long
HWND = FindWindow(vbNullString, "Afficher les runs")
If HWND = 0 Then
MsgBox ("Invalid hWnd")
End If
hMenu = GetMenu(HWND)
If hMenu <> 0 Then
'MsgBox (hMenu)
lgNbMenu = GetMenuItemCount(hMenu)
'MsgBox (lgNbMenu)
' Mise à jour de la structure
lpItemInfo.cbSize = 44
lpItemInfo.dwTypeData = stBuffer & Chr$(0)
lpItemInfo.fType = MF_STRING
lpItemInfo.cch = 80
lpItemInfo.fState = MFS_DEFAULT
lpItemInfo.fMask = MIIM_ID Or MIIM_STATE Or MIIM_TYPE Or MIIM_SUBMENU
' Récupère le contenu du menu
lgRet = GetMenuItemInfo(hMenu, 0, True, lpItemInfo)
lpItemInfo.dwTypeData = Replace(lpItemInfo.dwTypeData, Chr$(0), vbNullString)
MsgBox (lpItemInfo.dwTypeData)
' Récupère un pointeur vers le sous-menu
hSubMenu = GetSubMenu(hMenu, 0)
' Récupère le nombre de sous-menus
sMenu = GetMenuItemCount(hSubMenu)
' Parcours des éléments de second niveau
' Mise à niveau de la structure
lpItemInfo.cbSize = 44
lpItemInfo.dwTypeData = stBuffer & Chr$(0)
lpItemInfo.fType = MF_STRING
lpItemInfo.cch = 80
lpItemInfo.fState = MFS_DEFAULT
lpItemInfo.fMask = MIIM_ID Or MIIM_STATE Or MIIM_TYPE Or MIIM_SUBMENU
MsgBox (lpItemInfo.dwTypeData)
' Récupère le contenu du sous-menu
lgRet = GetMenuItemInfo(hSubMenu, 15, True, lpItemInfo)
lpItemInfo.dwTypeData = Replace(lpItemInfo.dwTypeData, _
Chr$(0), vbNullString)
' Récupère un pointeur vers le sous-menu
hSsubMenu = GetSubMenu(sMenu, 15)
' Récupère le nombre de sous-menus
ssMenu = GetMenuItemCount(hSsubMenu)
' Parcours des éléments de second niveau
' Mise à niveau de la structure
lpItemInfo.cbSize = 44
lpItemInfo.dwTypeData = stBuffer & Chr$(0)
lpItemInfo.fType = MF_STRING
lpItemInfo.cch = 80
lpItemInfo.fState = MFS_DEFAULT
lpItemInfo.fMask = MIIM_ID Or MIIM_STATE Or MIIM_TYPE Or MIIM_SUBMENU
' Récupère le contenu du sous-menu
lgRet = GetMenuItemInfo(hSsubMenu, 1, True, lpItemInfo)
lpItemInfo.dwTypeData = Replace(lpItemInfo.dwTypeData, _
Chr$(0), vbNullString)
MsgBox (lpItemInfo.dwTypeData)
End If
End Sub |
Partager