完整的"滚动条"方案,除了上面的程序外,还要加一个模块,代码如下:
补充一点:该“滚动条”方案还必需实现用鼠标滚轮对超长页面进行上下移动。
目前偶发现该模块的一个不足之处,就是每增加一个超长页面都要相应的增加三组代码,一但页面增加多时,软件运行的速度就会很慢。也许这是VB6又一个不可优化的缺陷。
Option Explicit
Public Type POINTL
x As Long
y As Long
End Type
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
clare Function SystemParametersInfo _
Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, _
ByVal uParam As Long, _
lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Declare Function ScreenToClient Lib "user32" _
(ByVal Hwnd As Long, xyPoint As POINTL) As Long
Public Const GWL_WNDPROC = -4
Public Const SPI_GETWHEELSCROLLLINES = 104
Public Const WM_MOUSEWHEEL = &H20A
Public WHEEL_SCROLL_LINES As Long
Global lpPrevWndProc As Long
Public Sub Hook(ByVal Hwnd As Long)
lpPrevWndProc = SetWindowLong(Hwnd, GWL_WNDPROC, AddressOf WindowProc)
Call SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, WHEEL_SCROLL_LINES, 0)
If WHEEL_SCROLL_LINES > xj1.VScroll1.Max Then
WHEEL_SCROLL_LINES = xj1.VScroll1.Max
End If
End Sub
Public Sub UnHook(ByVal Hwnd As Long)
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(Hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim pt As POINTL
Select Case uMsg
Case WM_MOUSEWHEEL
If wParam = -7864320 Then
If xj1.VScroll1.Value <= xj1.VScroll1.Max - 1000 Then '其中-1000是用鼠标滚轮移动页面时速度快慢的调整,可取300-1000
xj1.VScroll1.Value = xj1.VScroll1.Value + 1000
Else
xj1.VScroll1.Value = xj1.VScroll1.Max
End If
ElseIf wParam = 7864320 Then
If xj1.VScroll1.Value >= 1000 Then
xj1.VScroll1.Value = xj1.VScroll1.Value - 1000
Else
xj1.VScroll1.Value = 0
End If
End If
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function
Public Function HIWORD(LongIn As Long) As Integer
HIWORD = (LongIn And &HFFFF0000) \ &H10000
End Function
Public Function LOWORD(LongIn As Long) As Integer
LOWORD = LongIn And &HFFFF&
End Function