Ejemplos usando el Api de windows para Visual basic

260 - Obtener estructura de un menú

Ejemplo que usa el Api de windows para obtener la estructura de un menú de una ventana , en este caso un formulario del programa , para cargarla en un control Treeview

El ejemplo está basado en un código fuente del sitio web : Active vb

En el poyecto , se usan las apis GetSystemMenu, GetMenuState, GetMenu, GetSubMenu, GetMenuString y GetMenuItemCount.

Antes de cargar la estructura al Treeview, se almacenan todos los menús y submenús en un array y luego se pasan al control Tree view

Descargar ejemplo

Código fuente ( Controles : un Treeview1, agregar menues al formulario, un command1 )

Option Explicit Type Menu_Descriptor text As String Key As String Type As Long nSub As Long Id As Long ParenthMenu As Long ParentHwnd As Long level As Long pos As Long End Type Declare Function GetMenuItemCount Lib "user32" ( _ ByVal hmenu As Long) As Long Declare Function GetMenuItemID Lib "user32" ( _ ByVal hmenu As Long, _ ByVal nPos As Long) As Long Declare Function GetMenuString _ Lib "user32" _ Alias "GetMenuStringA" ( _ ByVal hmenu As Long, _ ByVal wIDItem As Long, _ ByVal lpstring As String, _ ByVal nMaxCount As Long, _ ByVal wFlag As Long) As Long Declare Function GetSubMenu _ Lib "user32" ( _ ByVal hmenu As Long, _ ByVal nPos As Long) As Long Declare Function GetMenu _ Lib "user32" ( _ ByVal hWnd As Long) As Long Declare Function GetMenuState _ Lib "user32" ( _ ByVal hmenu As Long, _ ByVal wID As Long, _ ByVal wFlags As Long) As Long Declare Function GetSystemMenu _ Lib "user32" ( _ ByVal hWnd As Long, _ ByVal bRevert As Long) As Long Public MenuList() As Menu_Descriptor Sub List_Menu(ByVal hWnd, ByVal hmenu As Long, sys As Long) ' Erstellt die Liste der Menüeinträge. Beachte: ' Die Funktion wird rekursiv verwendet, d.h. sie ' ruft sich selbst auf. Dim menuID As Long Dim menuFlag As Long Dim menuCnt As Long Dim i As Long Dim ret As Long Dim pos As Long Dim MenuText$ Dim mText$ Static level As Long Static cnt As Long Dim ub As Long Dim subMenu As Long Const MF_BYPOSITION = 1024 Const MF_BYCOMMAND = 0 If hmenu = 0 Then ' por si se quiere incluir el menú de sistema ( en este ejemplo no ) If sys = True Then hmenu = GetSystemMenu(hWnd, 0) Else ' handle del menú principal de la ventana hmenu = GetMenu(hWnd) End If cnt = 0 level = 0 ' almacena en el type el HWND anterior MenuList(0).ParenthMenu = hmenu End If If hmenu <= 0 Then ' Wenn nicht verfügbar > abbrechen Exit Sub End If ' Obtiene con GetMenuItemCount la cantidad de menues del menu actual menuCnt = GetMenuItemCount(hmenu) If menuCnt < 0 Then Exit Sub End If ub = UBound(MenuList) ReDim Preserve MenuList(ub + menuCnt) level = level + 1 MenuText$ = String$(256, 0) For i = 0 To menuCnt - 1 ' ID für diese Menü lesen ' -1 für Popup, 0 für Seperator menuID = GetMenuItemID(hmenu, i) 'buffer MenuText = String$(256, 0) ' tipo de menú ''''''''''''''''''''''''''''' Select Case menuID Case 0 ' Seperator cnt = cnt + 1 MenuList(cnt).Type = 0 mText$ = "---------------" Case -1 ' Popup menu cnt = cnt + 1 MenuList(cnt).Type = 1 ' recupera el caption ret = GetMenuString(hmenu, i, MenuText, 127, MF_BYPOSITION) menuFlag = GetMenuState(hmenu, i, MF_BYPOSITION) Case Else ' Normaler Eintrag cnt = cnt + 1 ret = GetMenuString(hmenu, menuID, MenuText, 127, MF_BYCOMMAND) menuFlag = GetMenuState(hmenu, menuID, MF_BYCOMMAND) MenuList(cnt).Type = 2 End Select If MenuList(cnt).Type > 0 Then pos = InStr(1, MenuText$, Chr$(0), 1) mText$ = Left$(MenuText$, pos - 1) End If MenuList(cnt).Id = menuID MenuList(cnt).ParentHwnd = hWnd MenuList(cnt).ParenthMenu = hmenu MenuList(cnt).text = mText MenuList(cnt).level = level MenuList(cnt).pos = i If MenuList(cnt).Type = 1 Then subMenu = GetSubMenu(hmenu, i) menuCnt = GetMenuItemCount(subMenu) MenuList(cnt).nSub = menuCnt Call List_Menu(hWnd, subMenu, 0) End If Next i level = level - 1 End Sub ' recibe el HWND de la ventana el treeview '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub Cargar_Menu_En_Treeview(lHwnd As Long, tv As TreeView) ' si el hwnd es 0 sale If lHwnd = 0 Then Exit Sub Dim hmenu As Long Dim i As Long Dim Nivel As Long ' redimensiona la lista que almacena los menues ReDim MenuList(0) ' carga todos los menu en el array Call List_Menu(lHwnd, hmenu, False) Dim caption_menu As String Dim nodo As Node Dim nn As Integer With tv tv.HotTracking = True ' opcional tv.Nodes.Clear ' limpia el treeview End With ' recorre todo el array For i = 1 To UBound(MenuList) ' nivel del menú actual 1 - 2 - 3 - 4 etc... Nivel = (MenuList(i).level - 1) ' texto del menú caption_menu = MenuList(i).text If Nivel < 0 Then Nivel = 0 ' Se agregan los separadores si el caption es una cadena vacia If caption_menu = "" Then caption_menu = "<--------->" With tv ' menú de primer nivel If Nivel = 0 Then Set nodo = .Nodes.Add(, , , caption_menu) ' menues children y nodos siguientes ElseIf Nivel = nn Then Set nodo = .Nodes(i - 1).Parent Set nodo = .Nodes.Add(i - 1, tvwNext, , caption_menu) ElseIf Nivel > nn Then Set nodo = .Nodes.Add(i - 1, tvwChild, , caption_menu) Else Set nodo = .Nodes.Add(nodo.FirstSibling.Parent, , , caption_menu) End If ' expande el nodo nodo.Expanded = True End With ' para comprobar el próximo nivel de menú nn = Nivel Next End Sub

Código en un formulario

Option Explicit ' le pasa el treeview y el hwnd de la ventana ''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Command1_Click() Call Cargar_Menu_En_Treeview(Me.hWnd, TreeView1) End Sub

Buscar en Recursos vb