顯示窗口的水平和垂直滾動條


由于在外讀書,上網都是在網吧,所以回答問題,通常都是三言二語,沒有說清楚,不過這一篇可是在寢室的電腦上完成的,當然還有上次回答天水的那篇.我學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就當掉了.