说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

显示窗口的水平和垂直滚动条-VB资料

HTML文档下载 WORD文档下载 PDF文档下载
显示窗口的水平和垂直滚动条-VB资料


由于在外读书,上网都是在网吧,所以回答问题,通常都是三言二语,没有说清楚,不过这一篇可是在寝室的电脑上完成的,当然还有上次回答天水的那篇.我学VB的时候,根本没有交流,那种困难不言而喻.现在能与大家一起谈论VB,是我当初所不敢想象的.好了,言归正传,切入今天的话题----显示窗口的水平和垂直滚动条:
在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就当掉了.

JavaScript社区开发者调查结果 欢乐淘、求PS大神获腾讯开放平台应用创新大赛年度金奖 2012是响应式设计之年 12月28日:1903年计算机之父冯&#183;诺依曼出生 Android木马病毒:伪装成Google Play图标进行DDoS攻击 IE10 CSS Hack 程序员技术分享:训练机器学习 SVM算法解析 2013,谷歌的数据科学家都将干什么呢? Facebook“也”对服务器进行浸泡冷却 日本最大电脑商:Windows 8表现并不好 日均新增415个应用,Windows 8应用总数突破35000 百度推出图像搜索引擎“百度识图” 可基于图像实现全网人脸搜索 解决专利纠纷 RIM向诺基亚预付6500万 巨头的得意与失落:2012移动游戏十大收购案 Mozilla或许将发布iOS平台浏览器Junior Mozilla:Facebook手机将采用Firefox OS Anonymous2013年将放慢脚步,McAfee预测遭质疑 一周消息树:Facebook公布2012年Hackathon大赛顶级“黑客作品” HTML+CSS+JS 开发 Firefox OS 应用编程实战 前端开发工程师如何在2013年里提升自己 Java受Objective-C影响很大 而不是C++ Instagram回击报告指责:用户仍保持增长态势 回顾:2012年科技行业十大败笔 苹果地图入选 Amazon CEO Jeff Bezos:好年景,大挑战 2012年度盘点:移动互联网大事件回顾 详解Amazon Redshift 移动周报:再见,2012!你好,2013! 英特尔或在2月宣布其电视计划:提供分类频道 Prismatic:用机器学习分析用户兴趣只需10秒钟 谷歌布局亚太地区数据中心建设 服务响应速度有望提升30% 2013年移动互联网行业技术趋势前瞻 網頁url傳遞參數變量及Form表單提交問題? 50分! 又是字符串,怎么总与我过不去 怎样把文件写入服务器端中映射的驱动器中,急 在线等。。。 [我贴我灌]世锦赛罗雪娟夺第三金 关于用户离职和升级后的处理? 代码问题,高手进 急,在线等待 DNS服务器的问题,高手救命!!!问题解决不了,老板要我走人了!!!!!(痛哭中 &&&&&&&&&) 鼠标当前位置的值与窗体位置如me.left 的值是怎么样换算的? 英文OS,我加一个中文字库,我要在我的程序中显示中文,该做些什么? 一个硬件问题,来看看吧!问了好多人多不明白 bcb6自带的install??? 简单要求 CSDN出的《JBuilder实用技术手册》到底怎么样呀?我看目录怎么像垃圾? 在jsp怎么取得用javabean连接得数据库中得记录总数 请教各位大师,如何用VB做一个象ComboBox一样的控件 web Service里的Application的问题 有没有能够打印固定行数的报表? 对XML不太熟悉,麻烦大家再看看! 关于bho及控制ie行为的问题, 如何动态的设置datawindow的计算域的表达式,及从程序中如何得到该计算域的值 [我贴我灌]巴塞罗那凯旋归来 “花样姑娘”泪洒观澜湖 一个到现在还没有解决的问题!我着急用啊!请哪位高手帮忙解决了,有高分相送! WIN32 CONSOLE APPLICATION 中怎么调用DLL (动态连接库) 怎么增加不了行,插入不了了?请大虾给个提示 50美元求作业! 如果没有学过C语言,能不能学J2SE啊? 100分请教:一个串行接口通信的问题————在线等待?!!!! 急,给个jb8中解决编辑jsp问题的补丁。谢谢 关于sendmail的设置以及PostNuke的安装 关于XML,XSL的兼容性问题 在SQL SERVER的视图不支持CASE语句吗?若要实现该如何写呢? 现在最标准的软件开发预算,各阶段的百分比是多少? ==========天哪!怎么会这样呢?我在全屏窗口中打开的任何窗口都是全屏显示的,可我不希望在全屏幕窗口中打开的窗口也是全屏怎么办啊?== 如何在远程服务器上安装web服务程序? 考虑到类的属性(表的字段)以后会增加,应该用怎样的设计模式或设计方法。 如何在子目录下获得根目录的网络路径? 急,IE每次打开都是最小化状态,怎样实现每次打开时将其最大化! 希望和大家讨论一下关于WebService的事务继承性的问题 请教一个关于日期使用的问题 急!!一个建表问题 WSAD怎么显示代码行号?? 50美元求作业!access 有没有能够打印固定行数的报表? 请教接收视频信号的问题 VBscript转换为JScript? treeview的初级问题(解决立刻给分),关于节点的OnSelectedIndexChanged事件? 如何知道Clientdataset中哪些记录改变了? 如何构建Access数据库? 有没有soap client for ce 呀? 请把我国年画的四大产区告诉我 我国年画的四大产区是什么 我国四大年画产区在哪 急用 请问“君子成人之美”下一句是怎么讲 求平面几何大神 求几何大神. 几何大神 快来 几何啊, 赐子千金,不如教子一艺;教子一艺,不如赐子一名这个"名" 都寓含哪些意思? 古人云:“赐子千金,不如教子一艺;教子一艺,不如赐子一名",我家宝宝明年正月末2月初出生.按男孩名字来好了,在医院做B超说是男孩,要求最好 好听 顺口 儒雅 的名字,家谱是 培 字辈,中间 赐子千金,不如教子一艺. 金华市金东区换届试点中查处3起贿选案杭州市委常委会专题研究三季度经济形势明治奶粉宣布撤出中国大陆市场韩国抗议日本“竹岛宣传片”日本自卫队逾3万人下月演练“夺岛”(韩国视宣传片为挑衅要日本删视频韩国议员获准访问开城工业园马来西亚一私立学校向金正恩颁发荣誉博中国周边外交发力 区域影响力再提升手机通信遭窥视?默克尔向奥巴马要说法巴基斯坦总理:赶快停止无人机空袭!昆明人才博览会启幕 妈妈团雄起帮儿子2万余游客周六涌入昆明圆通山观樱潮 抚今追昔忆严复史上最长时间咸潮入侵长江口 涉及供水走在南京明城墙上国五新标准拟3月实施 国四车7月或停今年植树节市民可认养树木 有意者可网千年浩叹一汀州中国队迎来“奖牌之夜”崇明自来水污染追踪:水源苯酚超标 污广东省未来两天阴沉沉 温湿上升但早晚
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘