dcsimg
June 22, 2018
Hot Topics:

Size Up Your Applications with Subclassing

  • November 19, 2002
  • 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



Comment and Contribute

 


(Maximum characters: 1200). You have characters left.

 

 


Enterprise Development Update

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

By submitting your information, you agree that developer.com may send you developer offers via email, phone and text message, as well as email offers about other products and services that developer believes may be of interest to you. developer will process your information in accordance with the Quinstreet Privacy Policy.

Sitemap

×
We have made updates to our Privacy Policy to reflect the implementation of the General Data Protection Regulation.
Thanks for your registration, follow us on our social networks to keep up-to-date