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

显示窗口的水平和垂直滚动条-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就当掉了.

前端开发工程师如何在2013年里提升自己 Java受Objective-C影响很大 而不是C++ Instagram回击报告指责:用户仍保持增长态势 回顾:2012年科技行业十大败笔 苹果地图入选 Amazon CEO Jeff Bezos:好年景,大挑战 2012年度盘点:移动互联网大事件回顾 详解Amazon Redshift 移动周报:再见,2012!你好,2013! 英特尔或在2月宣布其电视计划:提供分类频道 Prismatic:用机器学习分析用户兴趣只需10秒钟 谷歌布局亚太地区数据中心建设 服务响应速度有望提升30% 2013年移动互联网行业技术趋势前瞻 老骥伏枥志在千里:回顾微软这一年 2013或将崛起 水落石出:在与谷歌苹果竞购创业公司中微软胜出 用扁平化的界面设计吸引用户 2012年12月份全球主流浏览器市场份额排行榜 冲榜不一定要刷榜:增加游戏曝光度的7大杀手锏 科技vs政治:FTC对Google的反垄断调查结束背后 威胁百度:奇虎360确认将与谷歌达成合作关系 Facebook更新Messenger应用 推免费网络电话服务 网上疯传iOS7概念设计:Dashboard是真是假? 过时的UI设计 Ubuntu手机系统前途不被看好 三星将于今年发布Tizen设备 将对苹果形成威胁? 分享9条经典的编程语录 国际著名黑客大赛介绍与比较 微软Azure CDN服务全球范围内出现宕机 双向多功能U盘:从Android设备到PC还有多远? 证明了自己:微软Win8获美国防部6.17亿订单 2013 Facebook黑客杯报名即将开始 解决Win8下IE10无法打开的故障 [简讯] Scala 2.10.0发布! 在VB中怎样压缩磁盘中的文件或文件夹 如何在平面上实现三维坐标的模拟?(在线急等) 请问各位高手《Delphi 6程序设计从入门到精通》里的例子代码谁有? 在平面坐标里如何实现三维坐标的模拟定位(在线急等) 怎样实现这个简单的功能? “将事件写入日志”选项不能改动了?奇怪 如何在平面上实现三维坐标的模拟?(在线急等) 如何比较两个字符串 NCNE--国家网络技术水平考试介绍 在问个简单的问题:Delphi中引号的问题 怎样知道windows的应用程序的路经 哪位高手给俺讲讲with xx as xx do 的用法,谢谢! 很菜的问题 请前辈进,请高手进!!! 那位仁兄有JAVA开发的五子棋游戏,我用一套软件交换 怎样用com技术C/S三层做中间件和使用,谈一点原理和实例。 高手请进 100分!!!!!!!!!!! NCNE 国家网络技术水平考试 介绍 软键盘的问题?UP有分 关于装配件的问题 想购买一套人事管理系统的源代码!!!!!!!!!!!!!!!!!!!!!!! 对话框中标题栏上面的颜色如何改? 对服务器来说,内存更重要还是运算更重要? 关于jdk与windows xp 我举报:信息产业部的领导根本没有学习好“三个代表” 聘驱动开发人员!!! 本人在运行REALPLAY8.0的时候出现了这样的错误窗口. 普通常量与符号常量有何区别,怎样使用? 怯怯地问: 问题一:我的网页是用表格分的区域,把表格线设为0 ,但加了背景后 ,背景上总是有一小条白线 ,那是表格的边框线 , 问怎么办? 这个不是太难,但很不简单! 报错---[Linker Fatal Error]Fatal:Expected a file name:,什么原因?大虾指教,在线等待 远程调用时传输数据的问题! 2000 不能正常关机 初当网管,请教大家都用什么工具? IIs重新启动一个web服务出现死机,怎么回事? 问题二 :我做了个POP窗口 ,我想在POP窗口打开时是固定大小的 ,不能调整, 该怎么弄? 希望有一个网络安全的开发专版 关于中国万网的域名解析问题。急救! IIs重新启动一个web服务出现死机,怎么回事? 系统提示有错啊! 请教各位高手,本人在运行REALPLAY8.0时出现以下错误提示! 用javascript如何判断textbox中的串是否是汉字及其个数? 用DELPHI的都是一些比较菜的程序员的工具!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 数据更新的问题 QueryString 多参数如何分隔?? 《C++ Primer》和《C++ Language Programming》有类似吗?是否都买来看? 请哪位大虾谈谈计算机语言语言与数学的关系。 “金环天朗通信技术发展有限公司公司”怎么样?请知道的兄弟姐妹介绍一下。 请教高手:一个很菜的问题 谁有usb开发相关资料??? 骑车男子银行门口抢3万元 被众人当场浦江男子发现幼儿园附近加工厂排难闻气男子拖欠员工工伤赔偿六万元 儿子替父警嫂送聋哑男孩回家 用纸笔沟通写下五小伙称银行卡被盗刷损失160多万状告金华男子塑性支气管炎 咳出的痰像一棵薛蛮子案涉案女称 薛有特殊性癖好且常姑娘深夜金华街头迷路 搭顺风车被摸腿18岁男孩因不肯洗碗被数落 很生气跑鄞州男子有车有房 管不住手脚去偷窃杭州公交史上寿命最短线路:火车东站小宁波实施第二轮人工增雨 风雨雷电冰雹杭州小区植物因连续高温天气多被晒焦浙江公布正风肃纪监督电话重点盯酒局牌6岁女孩不满父母打骂留下书信离家出走挪威总理装的哥开车 将被纳入竞选连任女子凌晨在客房内犯下命案货车司机天热迷糊挂错档位 开车撞进早杭州周边再次人工降雨 继续遭受副热带杭州水电供应仍旧紧张 严控高耗能企业杭州医院急诊多因高温诱发 出汗太多易尹中立:一场300年前的国家级牛市李克强:重点推进住房消费等6大领域消创维与东芝品牌战略合作成业界新范式诺奖得主科斯留给中国的十大忠告最MAN的啤酒广告——Guinnes天华阳光与哈德森清洁能源投资基金建立烟草税时隔六年再上调烟价上涨10%,360手机助手3.0版 开启“社交慧眼识号,能发现几个就看你的本事了!【浪琴/官方活动价688元】回馈粉丝80后如何帮父母理财?胡佑嘉:9月25日金银回光返照,原油成俄胜利日主宾国背后:中俄敲定西线输徐才厚到底得了什么病母亲节这天读此文,才发现自己也是个熊那些能充电、改变人生的微信号牙齿护理全解析,给孩子一口漂亮的牙齿徐翔密会公募大佬,说了啥悄悄话?现在股市里人人都在赚钱!到底谁在亏钱选对真碧玺很重要!绝不请到人造宝石!12套房子才够养老?
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘