Create dynamic menu in VB6

Question

Create dynamic menu in VB6

Navigation

#1 by (3 votes)

0

What seemed to be simple and easy became a nightmare ...

The idea of a dynamic menu is simple. Simply create menus, items and sub-items according to the database. However, the tool available through visual basic 6 is quite limited and does not allow the menu construction to be so dynamic.

I tried to use the SmartMenuXP component to build a fully dynamic menu, however, although I managed to achieve my goal, there were some issues that prevented me from progressing with the use of this component. This toolbar (SmartMenuXp) was allocated in the main MDI of the project, but when opening child forms, the children form control box went beyond the menu and the controls (Minimize, Close, Maximize) were above the menu and below the mdi controls. I searched all the available information, read all the product documentation and swept all the properties ... but I could not solve the problem.

I would like to find an easy-to-use API / Component to create a menu bar, or diamic menus.

visual-basic-6 menu

asked by anonymous 20.05.2014 / 16:21

1 answer



                    
        

         
                            Assign value to the input text
                                        ListView in numerical order - Android

score 3 · Accepted Answer

Unfortunately, VB6 does not allow you to do this using VB. An external component or the Windows APIs must be used.

I created a small example of how to do this using the Windows APIs.

For the example, a Form ( Form1 ) and Module ( Module1 ) were created.

Initially, Form1 has the following menu bar:

Whilerunningtheprogram,theexampleaddsatabandthreeextramenus:

Module1 has the following important functions for Form1 :

PreparaForm1 : prepares Form1 to be able to add and treat dynamic menus
AdicionaItem : add an item to an existing menu (for security, not to conflict with id's native VB menus, choose high id's, such as 16000, 16001 ... up to 65534)


     AdicionaSubMenu    : adds an item to an existing menu, but this item acts as a submenu 
 
     AdicionaSeparador    : adds a separator to an existing menu 
 
     RemoveItemPorIndice    : remove an item (according to its index / position) from an existing menu 
 
     RemoveItemPorId    : remove an item (depending on your id) from an existing menu


 There are four other functions to work with items in submenus, they work in the same way as the others, but act on a submenu within a menu:    AdicionaItemSub    ,    AdicionaSeparadorSub    ,    RemoveItemPorIndiceSub     

 Example Form1 Code 

Option Explicit

Public Function MenuClicado(ByVal id As Long) As Boolean
    MenuClicado = True

    Select Case id
    Case 16001
        MsgBox "Menu dinâmico 1: vou excluir o menu no índice 1"
        'Exclui o menu com o índice 1
        Module1.RemoveItemPorIndice 0, 1
    Case 16002
        MsgBox "Menu dinâmico 2: vou excluir o Menu dinâmico 3"
        'Exclui o Menu dinâmico 3 através do seu id
        Module1.RemoveItemPorId 0, 16003
    Case 16003
        MsgBox "Menu dinâmico 3"
    Case 16004
        MsgBox "Sub item 1"
    Case 16005
        MsgBox "Sub item 2"
    Case 16006
        MsgBox "Sub item 3"
    Case Else
        'Não era um dos nossos menus
        MenuClicado = False
    End Select
End Function

Private Sub Form_Load()
    'Primeiro deve preparar o módulo!!!
    Module1.PreparaForm1 Me

    'Adiciona um separador ao menu 0 (primeiro menu)
    Module1.AdicionaSeparador 0

    'Adiciona três items ao menu 0 (primeiro menu)
    Module1.AdicionaItem 0, 16001, "Menu dinâmico 1"
    Module1.AdicionaItem 0, 16002, "Menu dinâmico 2"
    Module1.AdicionaItem 0, 16003, "Menu dinâmico 3"
    Module1.AdicionaSubMenu 0, "Menu dinâmico 4"
    Module1.AdicionaItemSub 0, 5, 16004, "Sub item 1"
    Module1.AdicionaItemSub 0, 5, 16005, "Sub item 2"
    Module1.AdicionaItemSub 0, 5, 16006, "Sub item 3"
End Sub


 Module1 code 

Option Explicit

'API's do Windows para trabalhar com menus
Private Const MF_SEPARATOR As Long = &H800
Private Const MF_BYPOSITION As Long = &H400
Private Const MF_POPUP As Long = &H10
Private Declare Function GetMenu Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal uFlags As Long, ByVal uIDNewItem As Long, ByVal lpNewItem As String) As Long
Private Declare Function RemoveMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal uPosition As Long, ByVal uFlags As Long) As Long
Private Declare Function CreatePopupMenu Lib "user32.dll" () As Long

'API's do Windows para trabalhar com janelas e mensagens
Private Const WM_COMMAND As Long = &H111
Private Const GWL_WNDPROC As Long = -4
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'Endereço do WndProc antigo do Form
Private oldWndProc As Long
Private frmOriginal As Form1

Public Sub PreparaForm1(frm As Form1)
    Set frmOriginal = frm

    'Esse código todo tem que vir aqui em um módulo separado por causa
    'do operador AddressOf
    oldWndProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub

Public Sub AdicionaItem(ByVal indiceDoMenuPai As Long, ByVal id As Long, ByVal texto As String)
    Dim barraDeMenus As Long
    barraDeMenus = GetMenu(frmOriginal.hWnd)

    Dim menu As Long
    menu = GetSubMenu(barraDeMenus, indiceDoMenuPai)

    AppendMenu menu, 0, id, texto
End Sub

Public Sub AdicionaItemSub(ByVal indiceDoMenuPai As Long, ByVal indiceDoSubMenu As Long, ByVal id As Long, ByVal texto As String)
    Dim barraDeMenus As Long
    barraDeMenus = GetMenu(frmOriginal.hWnd)

    Dim menu As Long
    menu = GetSubMenu(barraDeMenus, indiceDoMenuPai)
    menu = GetSubMenu(menu, indiceDoSubMenu)

    AppendMenu menu, 0, id, texto
End Sub

Public Sub AdicionaSeparador(ByVal indiceDoMenuPai As Long)
    Dim barraDeMenus As Long
    barraDeMenus = GetMenu(frmOriginal.hWnd)

    Dim menu As Long
    menu = GetSubMenu(barraDeMenus, indiceDoMenuPai)

    AppendMenu menu, MF_SEPARATOR, 0, ""
End Sub

Public Sub AdicionaSeparadorSub(ByVal indiceDoMenuPai As Long, ByVal indiceDoSubMenu As Long)
    Dim barraDeMenus As Long
    barraDeMenus = GetMenu(frmOriginal.hWnd)

    Dim menu As Long
    menu = GetSubMenu(barraDeMenus, indiceDoMenuPai)
    menu = GetSubMenu(menu, indiceDoSubMenu)

    AppendMenu menu, MF_SEPARATOR, 0, ""
End Sub

Public Sub AdicionaSubMenu(ByVal indiceDoMenuPai As Long, ByVal texto As String)
    Dim barraDeMenus As Long
    barraDeMenus = GetMenu(frmOriginal.hWnd)

    Dim menu As Long
    menu = GetSubMenu(barraDeMenus, indiceDoMenuPai)

    AppendMenu menu, MF_POPUP, CreatePopupMenu, texto
End Sub

Public Sub RemoveItemPorIndice(ByVal indiceDoMenuPai As Long, ByVal indiceDoItem As Long)
    Dim barraDeMenus As Long
    barraDeMenus = GetMenu(frmOriginal.hWnd)

    Dim menu As Long
    menu = GetSubMenu(barraDeMenus, indiceDoMenuPai)

    RemoveMenu menu, indiceDoItem, MF_BYPOSITION
End Sub

Public Sub RemoveItemPorIndiceSub(ByVal indiceDoMenuPai As Long, ByVal indiceDoSubMenu As Long, ByVal indiceDoItem As Long)
    Dim barraDeMenus As Long
    barraDeMenus = GetMenu(frmOriginal.hWnd)

    Dim menu As Long
    menu = GetSubMenu(barraDeMenus, indiceDoMenuPai)
    menu = GetSubMenu(menu, indiceDoSubMenu)

    RemoveMenu menu, indiceDoItem, MF_BYPOSITION
End Sub

Public Sub RemoveItemPorId(ByVal indiceDoMenuPai As Long, ByVal idDoItem As Long)
    Dim barraDeMenus As Long
    barraDeMenus = GetMenu(frmOriginal.hWnd)

    Dim menu As Long
    menu = GetSubMenu(barraDeMenus, indiceDoMenuPai)

    RemoveMenu menu, idDoItem, 0
End Sub

Public Sub RemoveItemPorIdSub(ByVal indiceDoMenuPai As Long, ByVal indiceDoSubMenu As Long, ByVal idDoItem As Long)
    Dim barraDeMenus As Long
    barraDeMenus = GetMenu(frmOriginal.hWnd)

    Dim menu As Long
    menu = GetSubMenu(barraDeMenus, indiceDoMenuPai)
    menu = GetSubMenu(menu, indiceDoSubMenu)

    RemoveMenu menu, idDoItem, 0
End Sub

Private Function WndProc(ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If message = WM_COMMAND Then
        If frmOriginal.MenuClicado(wParam And &HFFFF) = True Then
            'Quando um dos nossos menus foi clicado, apenas retorna 0,
            'e para a função por aqui
            WndProc = 0
            Exit Function
        End If
    End If
    'Chama o WndProc antigo do Form
    WndProc = CallWindowProc(oldWndProc, hWnd, message, wParam, lParam)
End Function