平心而论BEARBEN已经说得够清楚了。
回复：（peace）[求助]如何在窗口中加滚动条！
無意中發現了此主題. 平心而言, 這只是討論一種技巧而已.
然而這種技巧卻很容易實現, 只是你不知道罷了.
既然是技巧, 那麽可以將技巧應用到很多的代碼中, 下面我就給窗口添加滾動條舉一個例子:
例子是這樣的, 建立一個 Standard EXE, 在 Form1 中放置一個 Frame1, Frame1 的高度和寬度預設爲比 Form1 的要大, 也就是不能全部顯示 Frame1 控件, 可以在設計時放大 Form1, 放置足夠大的 Frame1, 在 Frame1 裏加上某些需要的控件, 然後再將 Form1 設置爲預期的大小.
然後開開始設計滾動顯示, 當然不是添加 HScroll 或 VScroll 控件, 這樣也可以, 但今天可以用另一種方式來實現它, 就是 Windows API, 是完全來自 Windows 設計的滾動條. 所以此示例也顯示了某些 API 的應用.
給 Project 添加一個 Module (Module1.bas), 放置所需要的 API 函數, 內容是:
' Module1.bas
Option Explicit
Public Declare Function SetScrollInfo Lib "user32" (ByVal hwnd As Long, ByVal n As Long, lpcScrollInfo As SCROLLINFO, ByVal bool As Boolean) As Long
Public Declare Function SetScrollPos Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long, ByVal nPos As Long, ByVal bRedraw As Long) As Long
Public 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
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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 Declare Function GetScrollPos Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public 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
Public Const SIF_RANGE = &H1
Public Const SIF_PAGE = &H2
Public Const SIF_POS = &H4
Public Const SIF_DISABLENOSCROLL = &H8
Public Const SIF_TRACKPOS = &H10
Public Const SIF_ALL = SIF_RANGE Or SIF_PAGE Or SIF_POS Or SIF_DISABLENOSCROLL Or SIF_TRACKPOS
Public Const SB_CTL = 2
Public Const SB_HORZ = 0
Public Const SB_VERT = 1
Public Const SM_CXHSCROLL = 21
Public Const SM_CYHSCROLL = 3
Public Const SM_CXVSCROLL = 2
Public Const SM_CYVSCROLL = 20
Public Const SB_LINEDOWN = 1
Public Const SB_LINELEFT = 0
Public Const SB_LINERIGHT = 1
Public Const SB_LINEUP = 0
Public Const SB_PAGEDOWN = 3
Public Const SB_PAGELEFT = 2
Public Const SB_PAGERIGHT = 3
Public Const SB_PAGEUP = 2
Public Const SB_ENDSCROLL = 8
Public Const SB_THUMBTRACK = 5
Public Const SB_THUMBPOSITION = 4
Public Const GWL_WNDPROC = (-4)
Public Const WM_HSCROLL = &H114
Public Const WM_VSCROLL = &H115
再在 Module1.bas 中添加自己的代碼來實現對滾動條的控制:
Global WndProc As Long
Global sih As SCROLLINFO, siv As SCROLLINFO
Public Function NewWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim nPos As Long
Select Case uMsg
Case WM_HSCROLL
If wParam <> SB_ENDSCROLL Then
nPos = GetScrollPos(hwnd, SB_HORZ)
Select Case wParam
Case SB_LINEUP
nPos = nPos - 1 ' 預調滾動一下爲 1 pixel, 但你也可以根據需要設置適當的值
Case SB_LINEDOWN
nPos = nPos + 1
Case SB_PAGEUP
nPos = nPos - 10 ' 預調滾動一頁爲 10 pixels, 但你也可以根據需要設置適當的值
Case SB_PAGEDOWN
nPos = nPos + 10
Case Else
If (wParam Mod 65536) = SB_THUMBPOSITION Or (wParam Mod 65536) = SB_THUMBTRACK Then nPos = wParam \ 65536
End Select
If nPos < 0 Then nPos = 0
If nPos > sih.nMax Then nPos = sih.nMax
SetScrollPos hwnd, SB_HORZ, nPos, 1
Form1.Frame1.Left = -nPos
End If
Case WM_VSCROLL
nPos = GetScrollPos(hwnd, SB_VERT)
If wParam <> SB_ENDSCROLL Then
Select Case wParam
Case SB_LINEUP
nPos = nPos - 1
Case SB_LINEDOWN
nPos = nPos + 1
Case SB_PAGEUP
nPos = nPos - 10
Case SB_PAGEDOWN
nPos = nPos + 10
Case Else
If (wParam Mod 65536) = SB_THUMBPOSITION Or (wParam Mod 65536) = SB_THUMBTRACK Then nPos = wParam \ 65536
End Select
If nPos < 0 Then nPos = 0
If nPos > siv.nMax Then nPos = siv.nMax
SetScrollPos hwnd, SB_VERT, nPos, 1
Form1.Frame1.Top = -nPos
End If
End Select
NewWndProc = CallWindowProc(WndProc, hwnd, uMsg, wParam, lParam)
End Function
然後在 Form1 模塊 (Form1.frm) 中添加代碼, 以添加主窗口的滾動條
Option Explicit
Private Sub Form_Load()
With sih
.cbSize = Len(sih)
.fMask = SIF_ALL
.nMin = 0
.nPos = 0
.nMax = Frame1.Left + Frame1.Width - Me.ScaleWidth + GetSystemMetrics(SM_CXHSCROLL)
End With
SetScrollInfo Me.hwnd, SB_HORZ, sih, True
With siv
.cbSize = Len(siv)
.fMask = SIF_ALL
.nMin = 0
.nPos = 0
.nMax = Frame1.Top + Frame1.Height - Me.ScaleHeight + GetSystemMetrics(SM_CYVSCROLL)
End With
SetScrollInfo Me.hwnd, SB_VERT, siv, True
DrawMenuBar Me.hwnd ' 調用此函數的原因是, 當添加完滾動條後, 我們期待立即可以看到滾動條, 而不必再等到 Resize 後才可以看到
WndProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf NewWndProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hwnd, GWL_WNDPROC, WndProc
End Sub
可以看下效果(滾動前)
(滾動後)
兩個滾動條交錯的地方是 Windows 自動爲我們預設的 SizeBox, 所以使用這種方法不必添加拼圖.
