VB Tip: utilidade para Subclassing.
Autor: Diego Silva | Publicado: 2011-08-08T19:46:00-03:00

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:

Private Sub Form_Load()
oldproc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WProc)
End Sub

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.