| How to fix VB scroll bar bug |
Applies To |
|
| OS: VB: |
NT, 9x, 2000 5, 6 |
|
This has bothered me for a long time. The scrollbars on other programs look great but the VB ones look like they came from Windows version 2.0.
The
standard scrollbar on the left looks great with textured background, while
VB-created one on the right looks boring. The bug is generated when
message WM_CTLCOLORSCROLLBAR is sent to the scrollbar. This single message
causes the scroll bar to repaint using the Window background color. So the
trick is to catch this message before it ever gets to the scroll bar. As
one may have guessed, this requires subclassing and the use of AddressOf
operator.
Warning, never end programs that use AddressOf operator by pressing the End button on the VB toolbar. End the program by clicking the X (close) button on the form.
This project is also available as a download .
| Project Creation Instructions. |
|---|
| Add the following to a .BAS module |
|---|
Option Explicit
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
Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_WNDPROC = -4
Private lpPrevWndProc As Long
Private IsHooked As Boolean
Public gHW As Long
Public Sub Hook()
If IsHooked Then
MsgBox "Don't hook it twice without " & _
"unhooking, or you will be unable to unhook it."
Else
'this tells windows to send all the messages that
'are intended for this form to sub WindowProc
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
AddressOf WindowProc)
IsHooked = True
End If
End Sub
Public Sub Unhook()
Dim temp As Long
'tell windows to no longer send messages to this message handlder
If IsHooked Then
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
IsHooked = False
End If
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const WM_CTLCOLORSCROLLBAR = &H137
'look for and catch the offending message
If WM_CTLCOLORSCROLLBAR = uMsg Then
Debug.Print "Message: "; hw, uMsg, wParam, lParam
Else
'transfer control to the original message handler
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End If
End Function
| Add the following code to Form1 |
|---|
Option Explicit
Private Sub Form_Load()
'tell the sublassing routine which form to subclass
gHW = Me.hwnd
'initiate subclassing
Hook
'show Form2 to compare the fixed and the original VB scrollbar
Form2.Show
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'discontinue subclassing
Unhook
End Sub
| Remarks |
|---|