Const WS_VSCROLL = &H200000
Const WS_HSCROLL = &H100000
Const GWL_STYLE = (-16)Const WSB_PROP_CYVSCROLL = &H1
Const WSB_PROP_CXHSCROLL = &H2
Const WSB_PROP_CYHSCROLL = &H4
Const WSB_PROP_CXVSCROLL = &H8
Const WSB_PROP_CXHTHUMB = &H10
Const WSB_PROP_CYVTHUMB = &H20
Const WSB_PROP_VBKGCOLOR = &H40
Const WSB_PROP_HBKGCOLOR = &H80
Const WSB_PROP_VSTYLE = &H100
Const WSB_PROP_HSTYLE = &H200
Const WSB_PROP_WINSTYLE = &H400
Const WSB_PROP_PALETTE = &H800
Const WSB_PROP_MASK = &HFFF
Const FSB_FLAT_MODE = 2
Const FSB_ENCARTA_MODE = 1
Const FSB_REGULAR_MODE = 0Const SB_HORZ = 0
Const SB_VERT = 1
Const SB_BOTH = 3Const ESB_ENABLE_BOTH = &H0
Const ESB_DISABLE_BOTH = &H3
Const ESB_DISABLE_LEFT = &H1
Const ESB_DISABLE_RIGHT = &H2
Const ESB_DISABLE_UP = &H1
Const ESB_DISABLE_DOWN = &H2
Const ESB_DISABLE_LTUP = ESB_DISABLE_LEFT
Const ESB_DISABLE_RTDN = ESB_DISABLE_RIGHTConst SIF_RANGE = &H1
Const SIF_PAGE = &H2
Const SIF_POS = &H4
Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS)Private 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
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
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 InitializeFlatSB Lib "comctl32" (ByVal hWnd As Long) As Long
Private Declare Function UninitializeFlatSB Lib "comctl32" (ByVal hWnd As Long) As Long
Private Declare Function FlatSB_SetScrollProp Lib "comctl32" (ByVal hWnd As Long, ByVal index As Long, ByVal newValue As Long, ByVal fRedraw As Boolean) As Boolean
Private Declare Function FlatSB_EnableScrollBar Lib "comctl32" (ByVal hWnd As Long, ByVal wSBflags As Long, ByVal wArrows As Long) As Long
Private Declare Function FlatSB_GetScrollInfo Lib "comctl32" (ByVal hWnd As Long, ByVal fnBar As Long, lpsi As SCROLLINFO) As Boolean
Private Declare Function FlatSB_GetScrollProp Lib "comctl32" (ByVal hWnd As Long, ByVal index As Long, pValue As Long) As Boolean
Private Declare Function FlatSB_GetScrollRange Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, lpMinPos As Long, lpMaxPos As Long) As Boolean
Private Declare Function FlatSB_SetScrollInfo Lib "comctl32" (ByVal hWnd As Long, ByVal fnBar As Long, lpsi As SCROLLINFO, ByVal fRedraw As Boolean) As Long
Private Declare Function FlatSB_SetScrollPos Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, ByVal nPos As Long, ByVal fRedraw As Boolean) As Long
Private Declare Function FlatSB_SetScrollRange Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, ByVal nMinPos As Long, ByVal nMaxPos As Long, ByVal fRedraw As Boolean) As Long
Private Declare Function FlatSB_ShowScrollBar Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, ByVal fShow As Boolean) As Boolean
Private Declare Function FlatSB_GetScrollPos Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long) As Long
Private Sub Form_Activate()
Dim SI As SCROLLINFO
'Initialize
InitializeFlatSB Me.hWnd
'Set the vertical scrollbar to Encarta-mode
FlatSB_SetScrollProp Me.hWnd, WSB_PROP_VSTYLE, FSB_ENCARTA_MODE, False
'Disable the Up-button from the vertical scrollbar
FlatSB_EnableScrollBar Me.hWnd, SB_VERT, ESB_DISABLE_UP
'Set the vertical scroll range
FlatSB_SetScrollRange Me.hWnd, SB_VERT, 20, 80, False
'Set the scroll position to 50
FlatSB_SetScrollPos Me.hWnd, SB_VERT, 60, False
'Hide the horizontal scrollbar
FlatSB_ShowScrollBar Me.hWnd, SB_HORZ, False
'Get the scrollbar information
SI.cbSize = Len(SI)
SI.fMask = SIF_ALL
FlatSB_GetScrollInfo Me.hWnd, SB_VERT, SI
SI.nPos = SI.nPos - 10
'Set the new scrollbar information
FlatSB_SetScrollInfo Me.hWnd, SB_VERT, SI, True
'Show some scrollbar information on the form
Dim RetMin As Long, RetMax As Long
FlatSB_GetScrollRange Me.hWnd, SB_VERT, RetMin, RetMax
Me.AutoRedraw = True
Me.Print "Scroll Position:" + Str$(Int(100 * (FlatSB_GetScrollPos(Me.hWnd, SB_VERT) / RetMax))) + "%"
FlatSB_GetScrollProp Me.hWnd, WSB_PROP_VSTYLE, RetMin
Me.Print "Vertical Scrollbar Mode:" + Str$(RetMin)
End Sub
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Dim Ret As Long
'Create the scrollbars on the form
Ret = GetWindowLong(Me.hWnd, GWL_STYLE)
Ret = Ret Or WS_VSCROLL Or WS_HSCROLL
SetWindowLong Me.hWnd, GWL_STYLE, Ret
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Remove the Flat style
UninitializeFlatSB Me.hWnd
End Sub
Const WS_HSCROLL = &H100000
Const GWL_STYLE = (-16)Const WSB_PROP_CYVSCROLL = &H1
Const WSB_PROP_CXHSCROLL = &H2
Const WSB_PROP_CYHSCROLL = &H4
Const WSB_PROP_CXVSCROLL = &H8
Const WSB_PROP_CXHTHUMB = &H10
Const WSB_PROP_CYVTHUMB = &H20
Const WSB_PROP_VBKGCOLOR = &H40
Const WSB_PROP_HBKGCOLOR = &H80
Const WSB_PROP_VSTYLE = &H100
Const WSB_PROP_HSTYLE = &H200
Const WSB_PROP_WINSTYLE = &H400
Const WSB_PROP_PALETTE = &H800
Const WSB_PROP_MASK = &HFFF
Const FSB_FLAT_MODE = 2
Const FSB_ENCARTA_MODE = 1
Const FSB_REGULAR_MODE = 0Const SB_HORZ = 0
Const SB_VERT = 1
Const SB_BOTH = 3Const ESB_ENABLE_BOTH = &H0
Const ESB_DISABLE_BOTH = &H3
Const ESB_DISABLE_LEFT = &H1
Const ESB_DISABLE_RIGHT = &H2
Const ESB_DISABLE_UP = &H1
Const ESB_DISABLE_DOWN = &H2
Const ESB_DISABLE_LTUP = ESB_DISABLE_LEFT
Const ESB_DISABLE_RTDN = ESB_DISABLE_RIGHTConst SIF_RANGE = &H1
Const SIF_PAGE = &H2
Const SIF_POS = &H4
Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS)Private 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
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
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 InitializeFlatSB Lib "comctl32" (ByVal hWnd As Long) As Long
Private Declare Function UninitializeFlatSB Lib "comctl32" (ByVal hWnd As Long) As Long
Private Declare Function FlatSB_SetScrollProp Lib "comctl32" (ByVal hWnd As Long, ByVal index As Long, ByVal newValue As Long, ByVal fRedraw As Boolean) As Boolean
Private Declare Function FlatSB_EnableScrollBar Lib "comctl32" (ByVal hWnd As Long, ByVal wSBflags As Long, ByVal wArrows As Long) As Long
Private Declare Function FlatSB_GetScrollInfo Lib "comctl32" (ByVal hWnd As Long, ByVal fnBar As Long, lpsi As SCROLLINFO) As Boolean
Private Declare Function FlatSB_GetScrollProp Lib "comctl32" (ByVal hWnd As Long, ByVal index As Long, pValue As Long) As Boolean
Private Declare Function FlatSB_GetScrollRange Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, lpMinPos As Long, lpMaxPos As Long) As Boolean
Private Declare Function FlatSB_SetScrollInfo Lib "comctl32" (ByVal hWnd As Long, ByVal fnBar As Long, lpsi As SCROLLINFO, ByVal fRedraw As Boolean) As Long
Private Declare Function FlatSB_SetScrollPos Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, ByVal nPos As Long, ByVal fRedraw As Boolean) As Long
Private Declare Function FlatSB_SetScrollRange Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, ByVal nMinPos As Long, ByVal nMaxPos As Long, ByVal fRedraw As Boolean) As Long
Private Declare Function FlatSB_ShowScrollBar Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, ByVal fShow As Boolean) As Boolean
Private Declare Function FlatSB_GetScrollPos Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long) As Long
Private Sub Form_Activate()
Dim SI As SCROLLINFO
'Initialize
InitializeFlatSB Me.hWnd
'Set the vertical scrollbar to Encarta-mode
FlatSB_SetScrollProp Me.hWnd, WSB_PROP_VSTYLE, FSB_ENCARTA_MODE, False
'Disable the Up-button from the vertical scrollbar
FlatSB_EnableScrollBar Me.hWnd, SB_VERT, ESB_DISABLE_UP
'Set the vertical scroll range
FlatSB_SetScrollRange Me.hWnd, SB_VERT, 20, 80, False
'Set the scroll position to 50
FlatSB_SetScrollPos Me.hWnd, SB_VERT, 60, False
'Hide the horizontal scrollbar
FlatSB_ShowScrollBar Me.hWnd, SB_HORZ, False
'Get the scrollbar information
SI.cbSize = Len(SI)
SI.fMask = SIF_ALL
FlatSB_GetScrollInfo Me.hWnd, SB_VERT, SI
SI.nPos = SI.nPos - 10
'Set the new scrollbar information
FlatSB_SetScrollInfo Me.hWnd, SB_VERT, SI, True
'Show some scrollbar information on the form
Dim RetMin As Long, RetMax As Long
FlatSB_GetScrollRange Me.hWnd, SB_VERT, RetMin, RetMax
Me.AutoRedraw = True
Me.Print "Scroll Position:" + Str$(Int(100 * (FlatSB_GetScrollPos(Me.hWnd, SB_VERT) / RetMax))) + "%"
FlatSB_GetScrollProp Me.hWnd, WSB_PROP_VSTYLE, RetMin
Me.Print "Vertical Scrollbar Mode:" + Str$(RetMin)
End Sub
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Dim Ret As Long
'Create the scrollbars on the form
Ret = GetWindowLong(Me.hWnd, GWL_STYLE)
Ret = Ret Or WS_VSCROLL Or WS_HSCROLL
SetWindowLong Me.hWnd, GWL_STYLE, Ret
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Remove the Flat style
UninitializeFlatSB Me.hWnd
End Sub
解决方案 »
- vb将excel导入数据库
- 请教:为什么会出现类型不匹配?
- 求一可以判断长度的正则表达式...(急急急)
- 关于Ado多个数据库的事务处理的问题?急!!!!
- 急急急急急急急急急急急急急急急DBgrid问题在线等啊 (我就剩这么点分了)
- VB数据环境中的connetion的连接属性用字符串怎么写才能连上呢?
- 怎么在VB中嵌入EXCEL表格?
- 请问有没有什么visual basic 控件可以读取dxf(autocad)文档?
- 自动填表单,163自需写游戏,正文部分是什以域啊。
- 有关文件系统控件的问题,帮帮忙
- 问个菜问题,已编译了CHM文件,在VB工程里也设置了联接,使用F1键能启动CHM文件,问:如何在菜单栏里点击“帮助主题”启动CHM文件?
- 哪里有ie6.0英文版的下载???? @@@不是微软网站的那个在线安装版本!!要一次可以下载的*****************************300分************************************8
Private Sub Form_Resize()
With VScroll1
.Left = Me.ScaleWidth - .Width
.Top = 0
.Height = Me.ScaleHeight
End With
End Sub是这个意思吗?2.
应用.Value建立与你想要显示的部分的联系。
Private Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
Private Const SB_HORZ = 0
Private Const SB_VERT = 1
Private Const SB_BOTH = 3
Private Sub Form_Load()
'preset the textbox to multiline
'and since the ScrollBars property is
'read-only during runtime, you can use this
'API function to set the Scrollbars
'This examples shows how to show both horizontal and
'vertical scrollbars on a textbox during runtime
ShowScrollBar Me.hwnd, SB_BOTH, True
End Sub
滚动条不管用.
《在VB中创建独立控制界面的 ActiveX Dll 部件》
http://microinfo.top263.net/Txt/EasyView.txt
例程下载:
http://microinfo.top263.net/Zip/EasyView.exe
在Delphi中,它的TFORM类可以自动显示水平和垂直滚动条,这不能不让我们这些VB Fan们有些嫉妒,为了实现这个功能,我们不得不自已动手了.
首先从窗口谈起,窗口有许多风格,到API浏览器中可以看到许多以WS_或WS_EX_开头的常量,都是用来指定风格的.要实现水平和垂直滚动条就要修改窗口风格,同时还要响应来自滚动条的消息,才能实现其功能.其实我并不认为直接使用窗口自带的滚动条是一个好方法,使用滚动条控件要灵活的多,你可以在窗口中放入任意多的滚动条控件,但窗口自带的就只能有一个.但使用自带滚动条也有其优点,比如其位置不要用额外的代码进行调整,其它好像就没有了.
在使用方面来说,主要的难点在于其消息的响应,尤其对初学者来说,因为要构造一个子类窗口.其他的min,max值的设置,滚动框的位置的设定,都有对应的API函数来实现.
程序实现:
先在窗口上放两个Lable,两个Botton.
'1.窗口风格的设置
'在窗口声明部分加入
Dim HVisible as Boolean,VVisible as Boolean
Private Sub Form_Load()
Dim OldStyle As Long
Dim hsWidth As Integer
'保存旧风格
OldStyle = SetWindowLong(hWnd, GWL_STYLE, 0)
'设置新风格
Call SetWindowLong(hWnd, GWL_STYLE, OldStyle Or WS_VSCROLL Or WS_HSCROLL)
Command1.Caption = "隐藏垂直滚动条"
Command2.Caption = "隐藏水平滚动条"
Label1 = "垂直滚动条的值"
Label2 = "水平滚动条的值"
'得到水平滚动条的宽度
hsWidth = GetSystemMetrics(SM_CXVHSCROLL)
'改变窗口宽度与高度
Width = Width + hsWidth
Height = Height + hsHeight
VVisible = True
HVisible = True
'怎么样,滚动条显示出来了没有?没有?那么是我眼花了?@_@
'2.滚动范围的设置
yMin = 0: yMax = 100
xMin = 0: xMax = 100
SetScrollRange hWnd, SB_HORZ, xMin, xMax, True
SetScrollRange hWnd, SB_VERT, yMin, yMax, True
'建立子类窗口
SubClass Me
End Sub'End Of Form_Load
'3.滚动条的显示与隐藏
Private Sub Command1_Click()
If VVisible Then
Command1.Caption = "显示垂直滚动条"
ShowScrollBar hWnd, SB_VERT, False
VVisible = False
Else
Command1.Caption = "隐藏垂直滚动条"
ShowScrollBar hWnd, SB_VERT, True
VVisible = True
End If
End Sub
'4.子类窗口的撤消
Private Sub Form_Unload(Cancel As Integer)
UnSubClass Me
End Sub
'从1.窗口风格的设置直到此处都可以直接COPY到窗口代码中
'5.消息响应机制
'添加一个公共模块,在模块中加入以下代码和声明
Public Const SM_CXHSCROLL = 21
Public Const GWL_STYLE = (-16)
Public Const WS_HSCROLL = &H100000
Public Const WS_VSCROLL = &H200000
Public Const SB_BOTH = 3
Public Const SB_HORZ = 0
Public Const SB_VERT = 1
'以下以SB_开头的是用户的滚动请求
Public Const SB_LINEDOWN = 1
Public Const SB_LINELEFT = 0
Public Const SB_LINERIGHT = 1
Public Const SB_LINEUP = 0
Public Const SB_PAGERIGHT = 3
Public Const SB_PAGELEFT = 2
Public Const SB_PAGEDOWN = 3
Public Const SB_PAGEUP = 2
Public Const SB_ENDSCROLL = 8
Public Const SB_THUMBPOSITION = 4
Public Const SB_THUMBTRACK = 5
Public Const GWL_WNDPROC = (-4)
Public Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Declare Function ShowScrollBar Lib "user32" (ByVal hWnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
Declare Function SetScrollPos Lib "user32" (ByVal hWnd As Long, ByVal nBar As Long, ByVal nPos As Long, ByVal bRedraw As Long) As Long
Declare Function SetScrollRange Lib "user32" (ByVal hWnd As Long, ByVal nBar As Long, ByVal nMinPos As Long, ByVal nMaxPos As Long, ByVal bRedraw 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
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
Public preWndProc As Long
Public xMin As Integer, xMax As Integer
Public yMin As Integer, yMax As Integer
Public xPos As Integer, yPos As Integer
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim xInc As Integer, yInc As Integer
Select Case uMsg
Case WM_VSCROLL'垂直滚动条消息
Select Case LoWord(wParam)
Case SB_LINEUP, SB_LINEDOWN
If LoWord(wParam) Then
yInc = 1
Else
yInc = -1
End If
Case SB_PAGEUP, SB_PAGEDOWN
If LoWord(wParam) = SB_PAGEUP Then
yInc = -10
Else
yInc = 10
End If
Case SB_THUMBTRACK
yInc = HiWord(wParam) - yPos
End Select
yPos = yPos + yInc
If yPos < yMin Then yPos = yMin
If yPos > yMax Then yPos = yMax
SetScrollPos hWnd, SB_VERT, yPos, True
Form1.Label1 = yPos
Case WM_HSCROLL'垂直水平条消息
Select Case LoWord(wParam)
Case SB_LINELEFT, SB_LINERIGHT
If LoWord(wParam) Then
xInc = 1
Else
xInc = -1
End If
Case SB_PAGELEFT, SB_PAGERIGHT
If LoWord(wParam) = SB_PAGELEFT Then
xInc = -10
Else
xInc = 10
End If
Case SB_THUMBTRACK
xInc = HiWord(wParam) - xPos
End Select
xPos = xPos + xInc
If xPos < xMin Then xPos = xMin
If xPos > xMax Then xPos = xMax
SetScrollPos hWnd, SB_HORZ, xPos, True
Form1.Label2 = xPos
End Select
WindowProc = CallWindowProc(preWndProc, hWnd, uMsg, wParam, lParam)
End Function
Public Sub SubClass(frm As Form)
preWndProc = SetWindowLong(frm.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnSubClass(frm As Form)
Call SetWindowLong(frm.hWnd, GWL_WNDPROC, preWndProc)
End Sub
'The function below is much useful in API development.
Private Function LoWord(num As Long) As Integer
LoWord = num Mod &H10000
End Function
Private Function HiWord(num As Long) As Integer
HiWord = (num And &HFFFF0000) / &H10000
End Function
说明:
此程序调试比较困难,应注意不要用VB工具栏中的"结束"按钮来结束该程序,只能通过窗口上的"关闭"按钮,而且在程序中不能出错,否则VB就当掉了