VB Code:
'In a form
Option Explicit
Private Sub Form_Load()
Call Hook(Me.hWnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Unhook(Me.hWnd)
End Sub
'In a standard module
Option Explicit
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 DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const GWL_WNDPROC = (-4)
Private Const WM_CTLCOLORSCROLLBAR = &H137
Private mPrevProc As Long
Public Sub Hook(hWnd As Long)
mPrevProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Public Sub Unhook(hWnd As Long)
Call SetWindowLong(hWnd, GWL_WNDPROC, mPrevProc)
mPrevProc = 0&
End Sub
Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Static hBrush As Long
If uMsg = WM_CTLCOLORSCROLLBAR Then
If hBrush = 0 Then hBrush = CreateSolidBrush(vbRed) 'For a red background
WndProc = hBrush
Exit Function
End If
'Call DeleteObject(hBrush)
If mPrevProc Then
WndProc = CallWindowProc(mPrevProc, hWnd, uMsg, wParam, lParam)
Else
WndProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
End If
End Function