Blog Diego Silva: subclassing

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.

Olá.

Hoje estive vendo e estudando sobre subclassing, e estarei ensinando de um modo fácil a entender e usar subclassing.

Subclassing serve para receber os comandos de uma janela em uma função específica;nessa função o programador pode, por exemplo, criar menus personalizados, limitar o tamanho ou posição de uma janela, enfim, o que ser possível, através das variáveis que tal função recebe.

Criando um subclassing local

Para se criar um subclassing, use a API SetWindowLong com a constante GWL_WNDPROC = (-4), sendo o terceiro parâmetro o endereço da função que irá receber as mensagens do subclassing, como mostrado abaixo:

OBSERVAÇÕES IMPORTANTES: antes de definir um subclassing, é necessário obter o endereço da função de subclassing padrão. Para isso, simplismente atribua o SetWindowLong com tais parâmetros acima, à uma variável do tipo Long. A variável, então, receberá o valor antigo do endereço que processa por padrão as mensagens da janela. Isso é importante para quando finalizarmos o formulário, restaurarmos a função padrão, para não ocorrer um crash no sistema.

Recebendo dados através do subclassing

Na seção acima aprendemos a configurar o formulário para enviar as mensagens para nossa função. Nesta seção aprenderemos a MONTAR essa função.

A função, seja ela com qual nome for (isso vai do gosto do programador), tem obrigatoriamente QUATRO parâmetros, entre eles:

ByVal Hwnd as Long: irá retornar a handle do formulário
ByVal wMsg as Long: irá retornar o WM relacionado ao comando atual da janela (explicarei na próxima seção)
ByVal wParam as Long: irá retornar um valor relacionado ao wmsg, tipo como um parâmetro
ByVal lParam as Long: dependendo do wMsg, retorna o endereço de uma estrutura, seja ela WINDOWPOS ou KBDSTRUCT. Só temos de declarar o tipo que será usado para a finalidade desejada.

A função deve ter essa estrutura:

[Private/Public] Function [NomeDaFunção] (ByVal hWnd as Long, ByVal wMsg as Long, ByVal wParam as Long, ByVal lParam as Long)
'Aqui serão feitas as condições para executar determinada ação
If wMsg = WM_MENSAGEMDESEJADA then
'executa uma ação caso o wmsg seja a constante desejada
NomeDaFunção=1 'Continua recebendo os valores, entretanto, executa a própria ação definida pelo programador
Else
NomeDaFunção = CallWindowProc(OldProcAddr, hWnd, wMsg, wParam, lParam)
'necessário para fazer a ação padrão relacionada ao wMsg.
End If
End Function
Hwnd, wParam, wmsg e lparam podem receber outros nomes, mas tem necessariamente que estarem na mesma posição padrão.

Entendendo o wMsg e as constantes WM_

Como vimos na seção anterior, o wMsg (ou seja lá qual for o nome escolhido pelo programador para declarar tal variável na função) recebe um valor oriundo das constantes iniciadas por "WM_". Irei explicar algumas delas e pra que servem.

WM_ACTIVATE (&H6): mensagem executada quando o formulário é ativado.
WM_SHOWWINDOW (&H18): mensagem executada quando o formulário aparece. É o primeiro comando executado quando o formulário se inicia
WM_WINDOWPOSCHANGING (&H46): mensagem executada quando o sistema processa a posição e tamanho da janela. Sucedido por:
WM_WINDOWPOSCHANGED (&H47): mensagem executada após o sistema processar a posição e tamanho da janela. Ambos (WINDOWPOSCHANGING e WINDOWPOSCHANGED) recebem como lParam o endereço de uma estrutura WINDOWPOS.
WM_KILLFOCUS (&H8): mensagem executada quando o usuário deixa o formulário em questão.
WM_MOUSEMOVE (&H200): mensagem executada quando o usuário move o mouse dentro do formulário.
WM_NCPAINT (&H85): mensagem executada quando o sistema desenha a titlebar e os botões da janela em questão. Interceptar essa mensagem permite ao programador criar seu próprio titlebar.
WM_NCHITTEST (&H84): mensagem executada para determinar se o mouse está em um determinado ponto da janela (digo, das bordas e do título). O CallWindowProc retorna uma das constantes precedidas por "HT" (HTCaption=título da janela)
WM_CAPTURECHANGED (&h215): mensagem executada quando o formulário perde a captura do mouse (relacionado com SetCapture, ReleaseCapture e GetCapture)

Mais constantes de wMsg você encontra detalhado no site da Microsoft, aqui (em inglês).

No próximo artigo veremos um exemplo pronto de subclassing.
Até o próximo artigo.

segunda-feira, 8 de agosto de 2011

VB Tip: utilidade para Subclassing.