显示窗口的水平和垂直滚动条

显示窗口的水平和垂直滚动条

2023年7月16日发(作者:)

显示窗口的水平和垂直滚动条

由于在外读书,上网都是在网吧,所以回答问题,通常都是三言二语,没有说清楚,不过这一篇可是在寝室的电脑上完成的,当然还有上次回答天水的那篇。我学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)

n = "隐藏垂直滚动条"

n = "隐藏水平滚动条"

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

n = "显示垂直滚动条"

ShowScrollBar hWnd, SB_VERT, False

VVisible = False

Else

n = "隐藏垂直滚动条"

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

1 = 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

2 = xPos

End Select

WindowProc = CallWindowProc(preWndProc, hWnd, uMsg, wParam, lParam)

End Function

Public Sub SubClass(frm As Form)

preWndProc = SetWindowLong(, GWL_WNDPROC, AddressOf WindowProc)

End Sub

Public Sub UnSubClass(frm As Form)

Call SetWindowLong(, 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就当掉了

发布者:admin,转转请注明出处:http://www.yc00.com/xiaochengxu/1689446657a249643.html

相关推荐

发表回复

评论列表(0条)

  • 暂无评论

联系我们

400-800-8888

在线咨询: QQ交谈

邮件:admin@example.com

工作时间:周一至周五,9:30-18:30,节假日休息

关注微信