Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32.dll" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const GWL_WNDPROC = -4
Private Const WM_ERASEBKGND = &H14
Private OldWndProc As Long
Sub SetWindowProc(ByVal hwnd As Long, DoSet As Boolean)
If DoSet Then
If OldWndProc = 0 Then
' thuc hien subclassing - set new address for the window procedure
OldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End If
Else
If OldWndProc <> 0 Then
' tra lai ham cua so goc - address for the window procedure
SetWindowLong hwnd, GWL_WNDPROC, OldWndProc
OldWndProc = 0
End If
End If
End Sub
' ham cua so
Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim hBrush As Long
Dim rc As RECT
Select Case uMsg
' phuc vu thong diep WM_ERASEBKGND
Case WM_ERASEBKGND:
' tao brush
hBrush = CreateSolidBrush([B][COLOR=#ff0000]RGB(128, 255, 255)[/COLOR][/B])
' doc toa do - vung chiem boi DTP
GetClientRect hwnd, rc
' "do mau" vao vung DTP
FillRect wParam, rc, hBrush
' giai phong tai nguyen - brush
DeleteObject hBrush
Exit Function
Case Else:
' voi cac thong diep khac thi truyen vao ham cua so goc (original address for the window procedure)
WindowProc = CallWindowProc(OldWndProc, hwnd, uMsg, wParam, lParam)
End Select
End Function
