Are you including a statusbar just for a size grip? Want to know how to handle windows messages in VB? Find out all this right here.
This article will take you through setting up a subclassing module and intercepting windows messages to draw a size grip.
The first thing we need to do is to set up the subclassing module. Open VB, start a new Standard EXE Project and add a module. Rename the module modSubclass, and add the following code:
Option Explicit
' Holds a reference to the previous window
' procedure before we started subclassing
Public OldProc As Long
Public FrmHwnd As Long
Public FrmDC As Long
Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
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
Private Declare Function InvalidateRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT, _
ByVal bErase As Long) As Long
Private Declare Function GetClientRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Declare Function PtInRect Lib "user32" _
(lpRect As RECT, _
ByVal ptY As Long, _
ByVal ptX As Long) As Long
Private Declare Function DrawFrameControl Lib "user32" _
(ByVal hDC As Long, _
lpRect As RECT, _
ByVal un1 As Long, _
ByVal un2 As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Public Const GWL_WNDPROC = (-4)
' Messages to hook
Private Const WM_PAINT = &HF
Private Const WM_NCHITTEST = &H84
Private Const WM_SIZE = &H5
' Flags for DrawFrameControl
Private Const DFC_SCROLL = 3
Private Const DFCS_SCROLLSIZEGRIP = &H8
' Flags for GetSystemMetrics
Private Const SM_CXSIZE = 30
Private Const SM_CYSIZE = 31
' WM_NCHITTEST and MOUSEHOOKSTRUCT Mouse Position Codes
Private Const HTBOTTOMRIGHT = 17
Private Const WM_ENTERSIZEMOVE = &H231
Private Const WM_EXITSIZEMOVE = &H232
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Function WndProc(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim rc1 As RECT
Dim rc2 As RECT
Select Case wMsg
Case WM_SIZE
Call GetClientRect(hwnd, rc2)
If PtInRect(rc2, rc1.Left, rc1.Top) Then
Call InvalidateRect(hwnd, rc1, True)
frmMain.Refresh
Else
Call PostMessage(hwnd, WM_PAINT, 0, 0)
End If
WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam)
Case WM_PAINT
WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam)
Call GetClientRect(hwnd, rc1)
rc1.Left = rc1.Right - GetSystemMetrics(SM_CXSIZE)
rc1.Top = rc1.Bottom - GetSystemMetrics(SM_CYSIZE)
Call DrawFrameControl(FrmDC, rc1, DFC_SCROLL, DFCS_SCROLLSIZEGRIP)
Case WM_NCHITTEST
Call GetWindowRect(hwnd, rc2)
rc2.Left = rc2.Right - GetSystemMetrics(SM_CXSIZE)
rc2.Top = rc2.Bottom - GetSystemMetrics(SM_CYSIZE)
If PtInRect(rc2, WordLo(lParam), WordHi(lParam)) Then
WndProc = HTBOTTOMRIGHT
Else
WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam)
End If
Case Else
WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam)
End Select
End Function
Private Function WordHi(LongIn As Long) As Integer
Call CopyMem(WordHi, ByVal (VarPtr(LongIn) + 2), 2)
End Function
Private Function WordLo(LongIn As Long) As Integer
Call CopyMem(WordLo, ByVal VarPtr(LongIn), 2)
End Function
Now the hardcore stuff is out the way, we can test this out. Either add a new form or use the one provided, and copy the following code into it:
Option Explicit Private Sub Form_Load() ' Start subclassing FrmHwnd = Me.hwnd FrmDC = Me.hDC OldProc = GetWindowLong(FrmHwnd, GWL_WNDPROC) SetWindowLong FrmHwnd, GWL_WNDPROC, AddressOf WndProc End Sub Private Sub Form_Unload(Cancel As Integer) ' End subclassing SetWindowLong FrmHwnd, GWL_WNDPROC, OldProc End Sub
