发信人: flashboy()
整理人: (2000-07-01 14:20:44), 站内信件
|
一、创建一般工程，在窗体上加4个标签控件，目的是显示通过API生成的滚动条
的数据。名称分别是:lblmin、lblmax、lblstep、lblpos
二、在窗体FORM1的代码中添加：
Private Sub Form_Load()
'SUBCLASS窗口,设定新的窗体过程
prevProc = GetWindowLong(Form1.hwnd, GWL_WNDPROC)
SetWindowLong Form1.hwnd, GWL_WNDPROC, AddressOf wndProc
'为窗口加载滚动条,并设置其相应参数
a.cbSize = Len(a)
a.fMask = SIF_ALL
a.nMax = 3000
a.nMin = 100
a.nPage = hStep
a.nPos = 100
ShowScrollBar Form1.hwnd, SB_BOTH, True
SetScrollInfo Form1.hwnd, SB_HORZ, a, True
lblmin.Caption = a.nMin
lblmax.Caption = a.nMax
lblpos.Caption = a.nPos
lblstep.Caption = a.nPage
End Sub
Private Sub Form_Unload(Cancel As Integer)
'恢复窗口的原过程,避免数据丢失
SetWindowLong Form1.hwnd, GWL_WNDPROC, prevProc
End Sub
三、添加一标准模块。
'滚动条信息结构体
Public Type SCROLLINFO
cbSize As Long
fMask As Long
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type
'显示滚动条与设置滚动条信息函数
Public Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long
, ByVal wBar As Long, ByVal bShow As Long) As Long
Public Declare Function SetScrollInfo Lib "user32" (ByVal hwnd As Long
, ByVal n As Long, lpcScrollInfo As SCROLLINFO, ByVal bool As Boolean)
As Long
'滚动条相应常量与标志
Public Const SIF_RANGE = &H1
Public Const SIF_PAGE = &H2
Public Const SIF_POS = &H4
Public Const SIF_ALL = SIF_RANGE Or SIF_PAGE Or SIF_POS
Public Const SB_HORZ = 0
Public Const SB_BOTH = 3
Public Const SB_BOTTOM = 7
Public Const SB_ENDSCROLL = 8
Public Const SB_LINEDOWN = 1
Public Const SB_LINELEFT = 0
Public Const SB_PAGELEFT = 2
Public Const SB_PAGERIGHT = 3
Public Const SB_LINERIGHT = 1
Public Const SB_THUMBTRACK = 5
Public Const SB_THUMBPOSITION = 4
Public Const SB_TOP = 6
'获取窗口过程与设置窗口过程函数及其常量
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLon
gA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long
) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLon
gA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowP
rocA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As L
ong, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const GWL_WNDPROC = (-4)
'窗体滚动条消息
Public Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115
'三个全局变量与常量
Public prevProc As Long
Public a As SCROLLINFO
Public Const hStep = 100
Public Function wndProc(ByVal hwnd As Long, ByVal msg As Long, ByVal w
p As Long, ByVal lp As Long) As Long
Select Case msg
Case WM_HSCROLL
Call setHScrollbar(wp) '截取到横向滚动消息后,调用处理过程
Case WM_VSCROLL
Call setVScrollbar(wp) '截取到纵向滚动条消息后,调用处理过程
End Select
wndProc = CallWindowProc(prevProc, hwnd, msg, wp, lp) '将滚动条以外的消
息交给原过程处理
End Function
Public Sub setHScrollbar(ByVal wp As Long) '对横向滚动条的消息进行处理
的过程
Dim pos As Long
Dim flag As Long
pos = wp \ 65536 '拖拽时返回的滚动条值
flag = wp Mod 65536 '判断滚动条的动作
Debug.Print "我移动了!!" & flag & "---" & pos
Select Case flag
Case SB_LINERIGHT '点右按钮
a.nPos = a.nPos + hStep
If a.nPos >= a.nMax Then a.nPos = 3000
SetScrollInfo Form1.hwnd, SB_HORZ, a, True
Case SB_LINELEFT '点左按钮
a.nPos = a.nPos - hStep
If a.nPos <= a.nMin Then a.nPos = 100
SetScrollInfo Form1.hwnd, SB_HORZ, a, True
Case SB_PAGELEFT '点滚动条左边
a.nPos = a.nPos - hStep
If a.nPos <= a.nMin Then a.nPos = 100
SetScrollInfo Form1.hwnd, SB_HORZ, a, True
Case SB_PAGERIGHT '点滚动条右边
a.nPos = a.nPos + hStep
If a.nPos >= a.nMax Then a.nPos = 3000
SetScrollInfo Form1.hwnd, SB_HORZ, a, True
Case SB_THUMBTRACK '拖拽滚动条
a.nPos = pos
SetScrollInfo Form1.hwnd, SB_HORZ, a, True
Case SB_BOTTOM '到最右端
a.nPos = a.nMax
SetScrollInfo Form1.hwnd, SB_HORZ, a, True
Case SB_TOP '到最左端
a.nPos = a.nMin
SetScrollInfo Form1.hwnd, SB_HORZ, a, True
End Select
Form1.lblpos.Caption = a.nPos
End Sub
Public Sub setVScrollbar(ByVal wp As Long) '对纵向滚动条的消息进行处理
的过程
MsgBox "纵向滚动条相应参数没有设置,方法与设置横向滚动条相同!"
'关于具体设置参见横向滚动条设置
End Sub
如有相应问题，请联系[email protected] OR [email protected]
以上的滚动条加入进去之后,可直接在滚动条上单击右键,可弹出相应菜单!
--
※ 修改:．flashboy 于 Jun 30 20:27:54 修改本文．[FROM: 202.110.182.89]
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.110.182.198]
|
|