Blog Diego Silva: menu

Olá.
Neste artigo irei disponibilizar uma nova classe/livraria que criei, chamada MenuCreator, cuja classe chama-se cMenu. O objetivo principal dele é criar e manipular menus de modo bem simples. O link dele é https://skydrive.live.com/?cid=b278d5e7a71b5dca&sc=documents&nl=1&uc=1&id=B278D5E7A71B5DCA%21146# (pasta do SkyDrive). Nele há cinco métodos, entre eles:

Add (menuh as Long, Pos as Long, Text as String, [Flags as long, lpimage as stdpicture]): Adiciona um item à um menu existente.
Menuh recebe o endereço handle do menu.
Pos recebe um número que posteriormente será identificado por sua função, número este maior que 0.
Text recebe o texto do item. Flags (opcional) recebe as opções do item, listadas abaixo (que podem ser combinadas com o operador binário OR):
* MF_DISABLED = &H2& - Desabilita o item (mas não o torna cinza, veremos isso depois);
* MF_GRAYED = &H1& - Torna o item cinza (mas não o torna desabilitado; para desabilitá-lo e torná-lo cinza, use (MF_DISABLED OR MF_GRAYED).);
* MF_SEPARATOR = &H800& (NÃO COMBINÁVEL!) - Torna o item em uma barra horizontal de separação de itens.
* MF_POPUP = &H10& - Inicia um novo menu ao lado.

Count (menuh as Long) as Long: Retorna a quantidade de itens em um determinado menu. Menuh recebe o endereço handle do menu.

Create () As Long: Cria um novo menu, e retorna seu handle para ser manipulado pelas outras quatro funções.

Destroy (menuHandle as Long): remove um menu da memória, menu este determinado pelo endereço handle em menuHandle.

Show (menuh as Long, owner as Long, x as Double, y as Double) as Long: Exibe um menu. Menuh recebe o endereço handle do menu, owner recebe o endereço handle do formulário pai (Me.hWnd), x e y recebem a posição absoluta (em pixels) do menu, na tela.

Para o valor de x e y no método show, usamos uma das duas APIs seguintes:
* ClientToScreen - Transforma uma coordenada local do formulário em uma coordenada absoluta da tela.
* GetCursorPos - Obtém a posição atual do cursor do mouse.

Ambos usam a estrutura POINTAPI, cujos elementos são X, como LONG, e Y, também LONG.

Abaixo vai um exemplo. Crie um form em um projeto do tipo Standard Exe, adicione um botão no topo esquerdo do form e adicione o seguinte código no formulário:

"h=m.create" cria um novo menu e atribui o endereço do novo menu ao h. m.add adiciona os itens de 1 a 20 no menu criado. pt.x, pt.y, e clienttoscreen transformam a posição do botão em coordenadas absolutas da tela.

"r=m.show" exibe o menu na tela e retorna o item selecionado, e, caso nenhum item for selecionado, retorna zero. Daí a necessidade dos itens adicionados terem identificação (Pos as long) maior que 0.
"m.destroy" e "set m=nothing" são necessários para liberar memória, tanto do menu (destroy h) quanto da classe cMenu (set m=nothing).

Para manipulações mais complexas como por exemplo, adição de linhas verticais no menu para dispô-los em colunas, deve-se usar APIs externas à classe, como SetMenuItemInfo e similares.

Com essa classe, você pode criar um menu customizado para um formulário borderless (BorderStyle=0), abaixo do que seria o título.
Enfim, você poderá usar essa classe para facilitar a programação com menus.
Em breve, nova versão do Multisystem com formulários renovados e com menus, com auxílio dessa nova classe por mim criada.
É isso, pessoal.
Até o próximo artigo!

Olá.

Como prometido em alguns posts anteriores, achei uma utilidade para o subclassing nos formulários. Trata-se de conhecer comandos que levem a uma determinada ação.

Por exemplo: numa janela sem borda (BorderStyle=0) não há menu de contexto do sistema (aquele com opções da janela:

). E para fazer que o contexto do título funcione no nosso formulário customizado, devemos criar um menu para substituir o menu padrão do título. Para isso temos de saber o momento em que o usuário clica com o botão direito na janelinha do aplicativo na barra de tarefas. Daí vem o subclassing.

Escutando comandos para detectar chamada ao menu de contexto da janela

O projeto pronto (zipado) se encontra em https://skydrive.live.com/?cid=b278d5e7a71b5dca&sc=documents&nl=1&uc=1&id=B278D5E7A71B5DCA%21144 (pasta pessoal do Windows Live SkyDrive). Caso cair em alguma outra pasta, procure pela pasta Subclassing e pelo arquivo SubClassMenu.zip.
Dentro do arquivo zipado há o programa compilado, mas também há o código usado no subclassing criado, cujo código postarei abaixo por partes.

Iniciando o projeto

1º: Inicie um novo projeto Standard Exe.
2º: Vá em project > Add Module e adicione um módulo comum.
3º: No módulo, cole o seguinte código:

Public oldproc 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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const WM_SYSCOMMAND = &H112
Public Const WM_CONTEXTMENU = &H7B
Public Const SC_MOVE = &HF010&
Public Const SC_SIZE = &HF000&
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Type POINTAPI
        X As Long
        Y As Long
End Type
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Const GWL_WNDPROC = (-4)
Public Const WM_POPUPSYSTEMMENU = &H313
Public Function WProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_POPUPSYSTEMMENU Or Msg = WM_CONTEXTMENU Then
    Dim mc As New cMenu
    Dim h As Long
    h = mc.Create
    mc.Add h, 800, "--Menu--", 3
    mc.Add h, 801, "", &H800
    mc.Add h, 1, "Restaurar", IIf(Form1.WindowState <> 0, 0, 3)
    mc.Add h, 2, "Mover", IIf(Form1.WindowState <> 0, 3, 0)
    mc.Add h, 3, "Tamanho", IIf(Form1.WindowState <> 0, 3, 0)
    mc.Add h, 4, "Minimizar", IIf(Form1.WindowState <> vbMinimized, 0, 3)
    mc.Add h, 5, "Maximizar", IIf(Form1.WindowState <> vbMaximized, 0, 3)
    mc.Add h, 6, "", &H800&
    mc.Add h, 7, "Fechar"
    Dim pt As POINTAPI
    GetCursorPos pt
    Dim retval As Long
    retval = mc.Show(h, Form1.hwnd, pt.X, pt.Y)
    mc.Destroy h
    Set mc = Nothing
        Select Case retval
        Case 1
        Form1.WindowState = vbNormal
        Case 2
        SendMessage Form1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
        Case 3
        SendMessage Form1.hwnd, WM_SYSCOMMAND, SC_SIZE, 0
        Case 4
        Form1.WindowState = vbMinimized
        Case 5
        Form1.WindowState = vbMaximized
        Case 7
        Unload Form1
        End Select
    WProc = 1
    Else
    WProc = CallWindowProc(oldproc, hwnd, Msg, wParam, lParam)
    End If
End Function

4º: Adicione uma classe, de nome cMenu.
5º: Na nova classe, cole o seguinte código:

Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private 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
Private Declare Function SetMenuItemBitmaps Lib "user32" _
        (ByVal hMenu As Long, ByVal nPosition _
        As Long, ByVal wFlags As Long, ByVal _
        hBitmapUnchecked As Long, ByVal _
        hBitmapChecked As Long) As Long

Private Declare Function GetMenu Lib "user32" _
   (ByVal hwnd As Long) As Long

Private Declare Function GetMenuItemCount Lib "user32" _
   (ByVal hMenu As Long) As Long

Private Declare Function GetSubMenu Lib "user32" _
   (ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function GetMenuItemInfo Lib "user32" _
    Alias "GetMenuItemInfoA" _
   (ByVal hMenu As Long, ByVal un As Long, _
    ByVal b As Boolean, lpmii As MENUITEMINFO) As Long

Private Declare Function SetMenuItemInfo Lib "user32" _
    Alias "SetMenuItemInfoA" _
   (ByVal hMenu As Long, ByVal uItem As Long, _
    ByVal fByPosition As Long, lpmii As MENUITEMINFO) As Long
Private Declare Function CreatePopupMenu Lib "user32" () As Long
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 RECT) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
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
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private hMenu As Long

Private Const MIIM_STATE As Long = &H1
Private Const MIIM_ID As Long = &H2
Private Const MIIM_SUBMENU As Long = &H4
Private Const MIIM_CHECKMARKS As Long = &H8
Private Const MIIM_TYPE As Long = &H10
Private Const MIIM_DATA As Long = &H20

Private Const MFT_RADIOCHECK As Long = &H200
Private Const MFT_STRING As Long = &H0

Private Const RGB_STARTNEWCOLUMNWITHVERTBAR As Long = &H20
Private Const RGB_STARTNEWCOLUMN As Long = &H40
Private Const RGB_EMPTY As Long = &H100
Private Const RGB_VERTICALBARBREAK As Long = &H160
Private Const RGB_SEPARATOR As Long = &H800
Private Const MF_CHECKED = &H8&
Private Const MF_APPEND = &H100&
Private Const TPM_LEFTALIGN = &H0&
Private Const MF_DISABLED = &H2&
Private Const MF_GRAYED = &H1&
Private Const MF_SEPARATOR = &H800&
Private Const MF_STRING = &H0&

Public Function Create() As Long
On Error GoTo fim
Create = CreatePopupMenu
Exit Function
fim:
Create = CLng(False)
End Function
Public Function Count(ByVal menuh As Long) As Long
GetMenuItemCount menuh
End Function
Public Function Show(ByVal menuh As Long, ByVal owner As Long, ByVal X As Double, ByVal Y As Double) As Long
Dim rc As RECT
Show = TrackPopupMenu(menuh, 256, X, Y, 0, owner, rc)
End Function
Public Sub Add(ByVal menuh As Long, ByVal pos As Long, ByVal Text As String, Optional ByVal Flags As Long = 0, Optional lpImage As StdPicture)
On Error Resume Next
AppendMenu menuh, Flags, pos, Text
    If lpImage Then SetMenuItemBitmaps menuh, pos, 0, lpImage, lpImage
End Sub
Public Sub Destroy(ByVal menuHandle As Long)
On Error Resume Next
DestroyMenu menuHandle
End Sub

A classe acima eu irei explicar no próximo artigo, ainda hoje, mas a função dele é criar menus e manipulá-los.
6º: Volte ao form1 criado por padrão pelo VB, e adicione o seguinte código no load do form:

7º: Execute o programa. Ao clicar com o botão direito do mouse no título da janela você verá que o mesmo irá exibir o nosso menu customizado e não mais o menu padrão da janela. Isso é útil para janelas com BorderStyle 0 (borderless form).

Considerações finais

O Subclassing tem ilimitadas funcionalidades, seja para criar um título customizado sem usar picturebox, seja para, como vimos acima, criar um menu próprio de janela, ou também para obter quando o formulário foi abandonado ou foi focalizado pelo usuário (pois o lostfocus e gotfocus nativos dos formulários do VB não funcionam..).
É isso aí, pessoal. No próximo artigo, irei explicar a classe acima, de menus, e disponibilizá-la, seja em cls ou em dll.
Até o próximo artigo.

segunda-feira, 8 de agosto de 2011

VB Tip: Criando menu de modo fácil - MenuCreator

VB Tip: utilidade para Subclassing.

Escutando comandos para detectar chamada ao menu de contexto da janela

Iniciando o projeto

Considerações finais