POUP MENU RUNTIME
olá, pesquisei aqui no fórum (código abaixo) e encontrei uma solução para criar poup menu runtime....porém preciso criar mais itens dentro da opções criadas...
caso alguem exemplo criando a partir de um BD access também será bem vindo. obrigado
[ô]Código criado por sasusk3
Private Sub Command1_Click()
On Error Resume Next
Remover
For I = 0 To File1.ListCount - 1
Load sk(sk.Count + 1)
sk(sk.Count).Caption = File1.List(I)
sk(sk.Count).Visible = True
Next
End Sub
Private Sub Form_Load()
File1.Path = certo(App.Path) & [Ô]skins\[Ô]
End Sub
Function certo(s As String) As String
If Right(s, 1) = [Ô]\[Ô] Then certo = s Else certo = s & [Ô]\[Ô]
End Function
Function Remover()
On Error Resume Next
For I = 1 To sk.Count
Unload sk(I)
Next
End Function
Private Sub sk_Click(Index As Integer)
MsgBox [Ô]Voce esclheu o skin: [Ô] & sk(Index).Caption
End Sub
caso alguem exemplo criando a partir de um BD access também será bem vindo. obrigado
[ô]Código criado por sasusk3
Private Sub Command1_Click()
On Error Resume Next
Remover
For I = 0 To File1.ListCount - 1
Load sk(sk.Count + 1)
sk(sk.Count).Caption = File1.List(I)
sk(sk.Count).Visible = True
Next
End Sub
Private Sub Form_Load()
File1.Path = certo(App.Path) & [Ô]skins\[Ô]
End Sub
Function certo(s As String) As String
If Right(s, 1) = [Ô]\[Ô] Then certo = s Else certo = s & [Ô]\[Ô]
End Function
Function Remover()
On Error Resume Next
For I = 1 To sk.Count
Unload sk(I)
Next
End Function
Private Sub sk_Click(Index As Integer)
MsgBox [Ô]Voce esclheu o skin: [Ô] & sk(Index).Caption
End Sub
Você pelo menos entende o que está acontecendo nesse código?
entendo!!! logicamente..caos contrário nem colocaria ele na descrição de minha dúvida...
este código monta um menu em tempo de execução conforme instruções em um código...ou seja...atende em parte o que estou necessitando..a muito tempo faço a menus via meu editor do vb e uso os mesmos....porém estou tentando verificar aqui no site exemplos que me permitam criar um menu sem usar o editor, ou seja, que não precise criar ele no projeto, mas sim importando um de um BD ou até mesmo via código...isso eu ajusto...
esse código cria em tempo de execução cria os itens dentro do menu, mas não cria sub itens...isso que eu preciso..
Caso for possÃvel a ajuda agradeço...
este código monta um menu em tempo de execução conforme instruções em um código...ou seja...atende em parte o que estou necessitando..a muito tempo faço a menus via meu editor do vb e uso os mesmos....porém estou tentando verificar aqui no site exemplos que me permitam criar um menu sem usar o editor, ou seja, que não precise criar ele no projeto, mas sim importando um de um BD ou até mesmo via código...isso eu ajusto...
esse código cria em tempo de execução cria os itens dentro do menu, mas não cria sub itens...isso que eu preciso..
Caso for possÃvel a ajuda agradeço...
Certo e você entende de onde estão vindo os Ãtens do menu?
opa, agora vi que colei o código sem o ajuste que fiz ....substitui o file.list por um outro procedimento.....mas Kerplunk....pesquisei nos arquivos aqui no site novamente e encontrei algo mais próximo do que preciso (segue abaixo)...porém estou tentando fazer alguns ajustes para os itens do submenu sejam listados conforme a condição apresentada no menu:
estou tentando adptaro código abaixo para que a montagem do menu seja efetuada conforme duas consultas que listo em dois listviews...
no primeiro listview há o nome da conta, exemplo : Lazer, Habitação, despesas financeiras. No segundo listview há as subcontas das contas, exemplo : Gás, Energia e Mercado são subcontas da Conta Habitação...
portanto no menu dinamico necessito percorrer esses listviews e montar o menu e o submenus respeitando a conta e a sub conta. No exemplo abaixo a criação do menu (contas) está Ok! Porém lista todas as subcontas nos submenus.
[ô] Cria um novo menu vazio
Private Declare Function CreatePopupMenu Lib [Ô]user32[Ô] () As Long
[ô] Elimina um especÃfico menu, libertando a memória usada por ele
Private Declare Function DestroyMenu Lib [Ô]user32[Ô] (ByVal hMenu As Long) As Long
[ô] Adiciona um novo item a um menu existente
Private Declare Function AppendMenu Lib [Ô]user32[Ô] Alias [Ô]AppendMenuA[Ô] (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
[ô] Permite verificar qual o menu que foi seleccionado
Private Declare Function TrackPopupMenu Lib [Ô]user32[Ô] (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As Long
[ô] Verifica a posição do cursor no ecrã
Private Declare Function GetCursorPos Lib [Ô]user32[Ô] (lpPoint As PointAPI) As Long
[ô] Declaração das constantes. Estas constantes não estão todas usadas
[ô] mas são as disponÃveis para a utilização de menus dinâmicos
Private Const MF_INSERT As Long = &H0&
Private Const MF_CHANGE As Long = &H80&
Private Const MF_APPEND As Long = &H100&
Private Const MF_DELETE As Long = &H200&
Private Const MF_REMOVE As Long = &H1000&
Private Const MF_BYCOMMAND As Long = &H0&
Private Const MF_BYPOSITION As Long = &H400&
Private Const MF_SEPARATOR As Long = &H800&
Private Const MF_ENABLED As Long = &H0&
Private Const MF_GRAYED As Long = &H1&
Private Const MF_DISABLED As Long = &H2&
Private Const MF_UNCHECKED As Long = &H0&
Private Const MF_CHECKED As Long = &H8&
Private Const MF_USECHECKBITMAPS As Long = &H200&
Private Const MF_STRING As Long = &H0&
Private Const MF_BITMAP As Long = &H4&
Private Const MF_OWNERDRAW As Long = &H100&
Private Const MF_POPUP As Long = &H10&
Private Const MF_MENUBARBREAK As Long = &H20&
Private Const MF_MENUBREAK As Long = &H40&
Private Const MF_UNHILITE As Long = &H0&
Private Const MF_HILITE As Long = &H80&
Private Const MF_SYSMENU As Long = &H2000&
Private Const MF_HELP As Long = &H4000&
Private Const MF_MOUSESELECT As Long = &H8000&
Private Const TPM_RETURNCMD As Long = &H100&
[ô] Tipo para a posição do rato no ecrã
Private Type PointAPI
X As Long
Y As Long
End Type
Private menu As Long
Private submenu As Long
[ô] No evento MouseDown do Form cria o menu
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim cursor As PointAPI
Dim result As Long
Dim i As Integer
[ô] Caso tenha sido usado o botão direito do rato
If Button = vbRightButton Then
[ô] Cria o sub popup menu
submenu = CreatePopupMenu()
For i = 1 To 4 [ô]alteração
Call AppendMenu(submenu, MF_STRING, i, [Ô]Sub-Menu[Ô] & i)
Next i
Call AppendMenu(submenu, MF_STRING, 11, [Ô]Sub-Menu 2[Ô])
[ô] Cria o popup menu
menu = CreatePopupMenu()
Call AppendMenu(menu, MF_STRING, 1, [Ô]Menu 1[Ô])
Call AppendMenu(menu, MF_GRAYED, 2, [Ô]Menu 2[Ô])
Call AppendMenu(menu, MF_SEPARATOR, 3, [Ô][Ô])
[ô] Insere o sub-menu no menu
Call AppendMenu(menu, MF_POPUP, submenu, [Ô]Menu 3[Ô])
Call AppendMenu(menu, MF_CHECKED, 4, [Ô]Menu 4[Ô])
[ô] Recolhe a informação do cursor do rato
Call GetCursorPos(cursor)
[ô] Verifica o resultado seleccionado de acordo com o Ãndice
result = TrackPopupMenu(menu, TPM_RETURNCMD, cursor.X, cursor.Y, 0, Me.hwnd, 0)
[ô] De acordo com o resultado (escolha) executa algo. Neste
[ô] caso mostra apenas na janela “Immediateâ€
Select Case result
Case 1
Debug.Print result [ô][Ô]Menu 1[Ô]
Case 2
Debug.Print result [ô][Ô]Menu 2[Ô]
Case 4
Debug.Print result [ô][Ô]Menu 4[Ô]
Case 10
Debug.Print result [ô][Ô]Sub-Menu 1[Ô]
Case Is > 11
Debug.Print result [ô][Ô]Sub-Menu 2[Ô]
End Select
End If
End Sub
[ô] No evento Unload do Form limpa os menus
Private Sub Form_Unload(Cancel As Integer)
[ô] Limpa os menus criados da memória
Call DestroyMenu(menu)
Call DestroyMenu(submenu)
End Sub
estou tentando adptaro código abaixo para que a montagem do menu seja efetuada conforme duas consultas que listo em dois listviews...
no primeiro listview há o nome da conta, exemplo : Lazer, Habitação, despesas financeiras. No segundo listview há as subcontas das contas, exemplo : Gás, Energia e Mercado são subcontas da Conta Habitação...
portanto no menu dinamico necessito percorrer esses listviews e montar o menu e o submenus respeitando a conta e a sub conta. No exemplo abaixo a criação do menu (contas) está Ok! Porém lista todas as subcontas nos submenus.
[ô] Cria um novo menu vazio
Private Declare Function CreatePopupMenu Lib [Ô]user32[Ô] () As Long
[ô] Elimina um especÃfico menu, libertando a memória usada por ele
Private Declare Function DestroyMenu Lib [Ô]user32[Ô] (ByVal hMenu As Long) As Long
[ô] Adiciona um novo item a um menu existente
Private Declare Function AppendMenu Lib [Ô]user32[Ô] Alias [Ô]AppendMenuA[Ô] (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
[ô] Permite verificar qual o menu que foi seleccionado
Private Declare Function TrackPopupMenu Lib [Ô]user32[Ô] (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As Long
[ô] Verifica a posição do cursor no ecrã
Private Declare Function GetCursorPos Lib [Ô]user32[Ô] (lpPoint As PointAPI) As Long
[ô] Declaração das constantes. Estas constantes não estão todas usadas
[ô] mas são as disponÃveis para a utilização de menus dinâmicos
Private Const MF_INSERT As Long = &H0&
Private Const MF_CHANGE As Long = &H80&
Private Const MF_APPEND As Long = &H100&
Private Const MF_DELETE As Long = &H200&
Private Const MF_REMOVE As Long = &H1000&
Private Const MF_BYCOMMAND As Long = &H0&
Private Const MF_BYPOSITION As Long = &H400&
Private Const MF_SEPARATOR As Long = &H800&
Private Const MF_ENABLED As Long = &H0&
Private Const MF_GRAYED As Long = &H1&
Private Const MF_DISABLED As Long = &H2&
Private Const MF_UNCHECKED As Long = &H0&
Private Const MF_CHECKED As Long = &H8&
Private Const MF_USECHECKBITMAPS As Long = &H200&
Private Const MF_STRING As Long = &H0&
Private Const MF_BITMAP As Long = &H4&
Private Const MF_OWNERDRAW As Long = &H100&
Private Const MF_POPUP As Long = &H10&
Private Const MF_MENUBARBREAK As Long = &H20&
Private Const MF_MENUBREAK As Long = &H40&
Private Const MF_UNHILITE As Long = &H0&
Private Const MF_HILITE As Long = &H80&
Private Const MF_SYSMENU As Long = &H2000&
Private Const MF_HELP As Long = &H4000&
Private Const MF_MOUSESELECT As Long = &H8000&
Private Const TPM_RETURNCMD As Long = &H100&
[ô] Tipo para a posição do rato no ecrã
Private Type PointAPI
X As Long
Y As Long
End Type
Private menu As Long
Private submenu As Long
[ô] No evento MouseDown do Form cria o menu
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim cursor As PointAPI
Dim result As Long
Dim i As Integer
[ô] Caso tenha sido usado o botão direito do rato
If Button = vbRightButton Then
[ô] Cria o sub popup menu
submenu = CreatePopupMenu()
For i = 1 To 4 [ô]alteração
Call AppendMenu(submenu, MF_STRING, i, [Ô]Sub-Menu[Ô] & i)
Next i
Call AppendMenu(submenu, MF_STRING, 11, [Ô]Sub-Menu 2[Ô])
[ô] Cria o popup menu
menu = CreatePopupMenu()
Call AppendMenu(menu, MF_STRING, 1, [Ô]Menu 1[Ô])
Call AppendMenu(menu, MF_GRAYED, 2, [Ô]Menu 2[Ô])
Call AppendMenu(menu, MF_SEPARATOR, 3, [Ô][Ô])
[ô] Insere o sub-menu no menu
Call AppendMenu(menu, MF_POPUP, submenu, [Ô]Menu 3[Ô])
Call AppendMenu(menu, MF_CHECKED, 4, [Ô]Menu 4[Ô])
[ô] Recolhe a informação do cursor do rato
Call GetCursorPos(cursor)
[ô] Verifica o resultado seleccionado de acordo com o Ãndice
result = TrackPopupMenu(menu, TPM_RETURNCMD, cursor.X, cursor.Y, 0, Me.hwnd, 0)
[ô] De acordo com o resultado (escolha) executa algo. Neste
[ô] caso mostra apenas na janela “Immediateâ€
Select Case result
Case 1
Debug.Print result [ô][Ô]Menu 1[Ô]
Case 2
Debug.Print result [ô][Ô]Menu 2[Ô]
Case 4
Debug.Print result [ô][Ô]Menu 4[Ô]
Case 10
Debug.Print result [ô][Ô]Sub-Menu 1[Ô]
Case Is > 11
Debug.Print result [ô][Ô]Sub-Menu 2[Ô]
End Select
End If
End Sub
[ô] No evento Unload do Form limpa os menus
Private Sub Form_Unload(Cancel As Integer)
[ô] Limpa os menus criados da memória
Call DestroyMenu(menu)
Call DestroyMenu(submenu)
End Sub
Faça seu login para responder