dcsimg
November 23, 2020
Hot Topics:

Size Up Your Applications with Subclassing

  • By Sam Huggill
  • Send Email »
  • More Articles »

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




Page 2 of 4



This article was originally published on November 20, 2002

Enterprise Development Update

Don't miss an article. Subscribe to our newsletter below.


Thanks for your registration, follow us on our social networks to keep up-to-date