I have a form with many controls on it that is too long to view on the screen even when it is maximized.
What is the best way to add a scroll bar to the form?
Thanks.
Printable View
I have a form with many controls on it that is too long to view on the screen even when it is maximized.
What is the best way to add a scroll bar to the form?
Thanks.
The best way is to make it a child in an MDI app because the parent will take care of the scrolling automatically.
Otherwise, move the controls in the scrollbar_change event:
This is code to show a dynamic number of pictures in a matrix on a single form. It uses a scroll bar to let the user see the rest of the pictures off the form. You may not be able to copy/paste the code, but you'll get the idea (look at the VScroll_change event).
Code:Dim gMaxTravel As Long ' Furthest a control will have to travel
Const gVisibleRows = 2 ' Rows visible on the screen
Const gVisibleCols = 3
Dim gTotalRows As Integer ' Dynamically set with no. of rows (pieces / pieces per row)
Const gColWidth = 3855 ' From left of column to left of next column
Const gLeftMargin = 345 ' From left of form to left of first column
Const gBotMargin = 600 ' From bottom of last label to bottom of form
Const gTopMargin = 600 ' From top of form to top of first picture
Const gRowHeight = 3480 ' From top of picture to top of next picture
Const gLabelSpacer = 2850 ' From top of picture to top of label
Private Sub btnClose_Click()
Me.Hide
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyEscape, vbKeyF2
Me.Hide
Case vbKeyUp
' Move 20%
If VScroll1.value < 800 Then VScroll1.value = VScroll1.value + 200
Case vbKeyDown
If VScroll1.value > 200 Then VScroll1.value = VScroll1.value - 200
End Select
End Sub
Private Sub VScroll1_Change()
' Scroll bar is set 0 to 1000 for better resolution
valPercent = VScroll1.value / 10
' Use CLng to prevent coersion to integers from Longs
gMaxTravel = Abs(gTotalRows - gVisibleRows) * CLng(gRowHeight) + gBotMargin
sigma = valPercent / 100 * gMaxTravel
moveLabel = gTopMargin + gLabelSpacer - sigma
moveImage = gTopMargin - sigma
Dim x As Image
For Each x In imgSumm
' Image/label index 0 is invisible and copied for each element. Minus one here, and
' three times below accounts for this
x.top = ((x.Index - 1) \ gVisibleCols) * CLng(gRowHeight) + moveImage
Next
Dim Y As Label
For Each Y In lblSumm
Y.top = ((Y.Index - 1) \ gVisibleCols) * CLng(gRowHeight) + moveLabel
Next
Dim z As Label
For Each z In lblRetail
z.top = ((z.Index - 1) \ gVisibleCols) * CLng(gRowHeight) + moveImage - 270
Next
End Sub
'This is the entry point for this form
Public Sub showSummary(orderIn As String, showMe As Boolean)
Me.VScroll1.value = 0
Me.Caption = "Order Summary - Order " & orderIn
'Me.lblTotalItems.Caption = Me.lblTotalItems.Caption & " " & datSumm.Recordset.RecordCount
'Me.lblTotalItems.ZOrder
On Error Resume Next
With datSumm.Recordset
.MoveLast
.MoveFirst
gTotalRows = datSumm.Recordset.RecordCount \ gVisibleCols
If datSumm.Recordset.RecordCount Mod gVisibleCols Then gTotalRows = gTotalRows + 1
For n = 1 To .RecordCount
For m = 1 To gVisibleCols
If Round(n Mod gVisibleCols, 2) = Round(m Mod gVisibleCols, 2) Then colNumber = m
Next m
Load imgSumm(n)
Load lblSumm(n)
Load lblRetail(n)
imgSumm(n).Picture = LoadPicture("picts\" & !lin_fpict)
lblSumm(n).Caption = !lin_comp
lblRetail(n).Caption = "$ " & !lin_retail
imgSumm(n).Visible = True
lblSumm(n).Visible = True
lblRetail(n).Visible = False ' Retail price is used for printing
imgSumm(n).top = ((n - 1) \ gVisibleCols) * gRowHeight + gTopMargin
lblSumm(n).top = ((n - 1) \ gVisibleCols) * gRowHeight + gTopMargin + gLabelSpacer
lblRetail(n).top = ((n - 1) \ gVisibleCols) * gRowHeight + gTopMargin - 270
imgSumm(n).left = gLeftMargin + ((colNumber - 1) * gColWidth)
lblSumm(n).left = imgSumm(n).left
lblRetail(n).left = imgSumm(n).left
.MoveNext
Next n
End With
If showMe Then Me.Show
End Sub
Add the following code to a Form with an HScroll and a VScroll.
Code:Dim VPos As Integer
Dim HPos As Integer
Private Sub Form_Load()
'Change the following numbers to the Full height and width of your Form
intFullHeight = 8000
intFullWidth = 8000
'This is the how much of your Form is displayed
intDisplayHeight = Me.Height
intDisplayWidth = Me.Width
With VScroll1
.Height = Me.ScaleHeight
.Min = 0
.Max = intFullHeight - intDisplayHeight
.SmallChange = Screen.TwipsPerPixelX * 10
.LargeChange = .SmallChange
End With
With HScroll1
.Width = Me.ScaleWidth
.Min = 0
.Max = intFullWidth - intDisplayWidth
.SmallChange = Screen.TwipsPerPixelX * 10
.LargeChange = .SmallChange
End With
End Sub
Sub ScrollForm(Direction As Byte)
Dim CTL As Control
'Scroll Vertically
If Direction = 0 Then
For Each CTL In Me.Controls
'Make sure it's not a ScrollBar
If Not (TypeOf CTL Is VScrollBar) And Not (TypeOf CTL Is HScrollBar) Then
'If it's a Line then
If TypeOf CTL Is Line Then
CTL.Y1 = CTL.Y1 + VPos - VScroll1.Value
CTL.Y2 = CTL.Y2 + VPos - VScroll1.Value
Else
CTL.Top = CTL.Top + VPos - VScroll1.Value
End If
End If
Next
VPos = VScroll1.Value
Else
'Scroll Horizontally
For Each CTL In Me.Controls
'Make sure it's not a ScrollBar
If Not (TypeOf CTL Is VScrollBar) And Not (TypeOf CTL Is HScrollBar) Then
'If it's a Line then
If TypeOf CTL Is Line Then
CTL.X1 = CTL.X1 + HPos - HScroll1.Value
CTL.X2 = CTL.X2 + HPos - HScroll1.Value
Else
CTL.Left = CTL.Left + HPos - HScroll1.Value
End If
End If
Next
HPos = HScroll1.Value
End If
End Sub
Private Sub HScroll1_Change()
ScrollForm 1
End Sub
Private Sub HScroll1_Scroll()
ScrollForm 1
End Sub
Private Sub VScroll1_Change()
ScrollForm 0
End Sub
Private Sub VScroll1_Scroll()
ScrollForm 0
End Sub
If you need an example, here is one on how to make a scrollable form.
Megatron and Matthew these solutions work except for the fact that my forms have frames and a tab control which are not scrolling up. The frames are still in the original position and the controls within them disappear.
When I scroll the form back down it works fine.
Also this method only works when the form is maximized; If the form is resized the form is truncated and no scroll bars appear.
How do you handle the resize and the other controls?
Also the scroll bar is not the full length of the form.
Thanks.
Scrolling TabStrips and Frames work find on my machine. This next example will fix the resizing problem.
Code:Dim VPos As Integer
Dim HPos As Integer
Private Sub Form_Load()
'Change the following numbers to the Full height and width of your Form
intFullHeight = 8000
intFullWidth = 8000
'This is the how much of your Form is displayed
intDisplayHeight = Me.Height
intDisplayWidth = Me.Width
With VScroll1
.Height = Me.ScaleHeight
.Min = 0
.Max = intFullHeight - intDisplayHeight
.SmallChange = Screen.TwipsPerPixelX * 10
.LargeChange = .SmallChange
End With
With HScroll1
.Width = Me.ScaleWidth
.Min = 0
.Max = intFullWidth - intDisplayWidth
.SmallChange = Screen.TwipsPerPixelX * 10
.LargeChange = .SmallChange
End With
End Sub
Sub ScrollForm(Direction As Byte)
Dim CTL As Control
'Scroll Vertically
If Direction = 0 Then
For Each CTL In Me.Controls
'Make sure it's not a ScrollBar
If Not (TypeOf CTL Is VScrollBar) And Not (TypeOf CTL Is HScrollBar) Then
'If it's a Line then
If TypeOf CTL Is Line Then
CTL.Y1 = CTL.Y1 + VPos - VScroll1.Value
CTL.Y2 = CTL.Y2 + VPos - VScroll1.Value
Else
CTL.Top = CTL.Top + VPos - VScroll1.Value
End If
End If
Next
VPos = VScroll1.Value
Else
'Scroll Horizontally
For Each CTL In Me.Controls
'Make sure it's not a ScrollBar
If Not (TypeOf CTL Is VScrollBar) And Not (TypeOf CTL Is HScrollBar) Then
'If it's a Line then
If TypeOf CTL Is Line Then
CTL.X1 = CTL.X1 + HPos - HScroll1.Value
CTL.X2 = CTL.X2 + HPos - HScroll1.Value
Else
CTL.Left = CTL.Left + HPos - HScroll1.Value
End If
End If
Next
HPos = HScroll1.Value
End If
End Sub
Private Sub Form_Resize()
If WindowState <> 1 Then
HScroll1.Left = 300
VScroll1.Top = 0
HScroll1.Width = Me.ScaleWidth
VScroll1.Height = Me.ScaleHeight - 240
HScroll1.Top = Me.ScaleHeight - 250
HScroll1.Height = Me.ScaleHeight / 25
End If
End Sub
Private Sub HScroll1_Change()
ScrollForm 1
End Sub
Private Sub HScroll1_Scroll()
ScrollForm 1
End Sub
Private Sub VScroll1_Change()
ScrollForm 0
End Sub
Private Sub VScroll1_Scroll()
ScrollForm 0
End Sub
I have tryed the code Megatron posted and it works except for it only scrolls one way. What can I do to fix this? When I test it to scroll weither I push up or down it only scrolls up!!. I also looked at the tip code Mathew posted and all the comments stated that it was no good!
It worked for me when I followed the suggestion to add a frame in the background and scroll the frame only.
I copied all my controls on the form to a new form that I placed a large frame on. I copied my code to the new form, deleted the old form and named my new form the same name as the removed form.
This work for scrolling up and down and left to right or vice versus.
My problem is still with the sizing issue. There is code on this site for resizing that does not work.
For a nice look make a flat toolbar.. the code may need some modifications, hope you'll work it out
Code:Const WS_VSCROLL = &H200000
Const WS_HSCROLL = &H100000
Const GWL_STYLE = (-16)
Const WSB_PROP_CYVSCROLL = &H1
Const WSB_PROP_CXHSCROLL = &H2
Const WSB_PROP_CYHSCROLL = &H4
Const WSB_PROP_CXVSCROLL = &H8
Const WSB_PROP_CXHTHUMB = &H10
Const WSB_PROP_CYVTHUMB = &H20
Const WSB_PROP_VBKGCOLOR = &H40
Const WSB_PROP_HBKGCOLOR = &H80
Const WSB_PROP_VSTYLE = &H100
Const WSB_PROP_HSTYLE = &H200
Const WSB_PROP_WINSTYLE = &H400
Const WSB_PROP_PALETTE = &H800
Const WSB_PROP_MASK = &HFFF
Const FSB_FLAT_MODE = 2
Const FSB_ENCARTA_MODE = 1
Const FSB_REGULAR_MODE = 0
Const SB_HORZ = 0
Const SB_VERT = 1
Const SB_BOTH = 3
Const ESB_ENABLE_BOTH = &H0
Const ESB_DISABLE_BOTH = &H3
Const ESB_DISABLE_LEFT = &H1
Const ESB_DISABLE_RIGHT = &H2
Const ESB_DISABLE_UP = &H1
Const ESB_DISABLE_DOWN = &H2
Const ESB_DISABLE_LTUP = ESB_DISABLE_LEFT
Const ESB_DISABLE_RTDN = ESB_DISABLE_RIGHT
Const SIF_RANGE = &H1
Const SIF_PAGE = &H2
Const SIF_POS = &H4
Const SIF_ALL = (SIF_RANGE Or SIF_PAGE Or SIF_POS)
Private 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
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function InitializeFlatSB Lib "comctl32" (ByVal hWnd As Long) As Long
Private Declare Function UninitializeFlatSB Lib "comctl32" (ByVal hWnd As Long) As Long
Private Declare Function FlatSB_SetScrollProp Lib "comctl32" (ByVal hWnd As Long, ByVal index As Long, ByVal newValue As Long, ByVal fRedraw As Boolean) As Boolean
Private Declare Function FlatSB_EnableScrollBar Lib "comctl32" (ByVal hWnd As Long, ByVal wSBflags As Long, ByVal wArrows As Long) As Long
Private Declare Function FlatSB_GetScrollInfo Lib "comctl32" (ByVal hWnd As Long, ByVal fnBar As Long, lpsi As SCROLLINFO) As Boolean
Private Declare Function FlatSB_GetScrollProp Lib "comctl32" (ByVal hWnd As Long, ByVal index As Long, pValue As Long) As Boolean
Private Declare Function FlatSB_GetScrollRange Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, lpMinPos As Long, lpMaxPos As Long) As Boolean
Private Declare Function FlatSB_SetScrollInfo Lib "comctl32" (ByVal hWnd As Long, ByVal fnBar As Long, lpsi As SCROLLINFO, ByVal fRedraw As Boolean) As Long
Private Declare Function FlatSB_SetScrollPos Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, ByVal nPos As Long, ByVal fRedraw As Boolean) As Long
Private Declare Function FlatSB_SetScrollRange Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, ByVal nMinPos As Long, ByVal nMaxPos As Long, ByVal fRedraw As Boolean) As Long
Private Declare Function FlatSB_ShowScrollBar Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long, ByVal fShow As Boolean) As Boolean
Private Declare Function FlatSB_GetScrollPos Lib "comctl32" (ByVal hWnd As Long, ByVal code As Long) As Long
Private Sub Form_Activate()
Dim SI As SCROLLINFO
'Initialize
InitializeFlatSB Me.hWnd
'Set the vertical scrollbar to Encarta-mode
FlatSB_SetScrollProp Me.hWnd, WSB_PROP_VSTYLE, FSB_ENCARTA_MODE, False
'Disable the Up-button from the vertical scrollbar
'FlatSB_EnableScrollBar Me.hWnd, SB_VERT, ESB_DISABLE_UP
'Set the vertical scroll range
FlatSB_SetScrollRange Me.hWnd, SB_VERT, 20, 80, False
'Set the scroll position to 50
FlatSB_SetScrollPos Me.hWnd, SB_VERT, 0, False
'Hide the horizontal scrollbar
FlatSB_ShowScrollBar Me.hWnd, SB_HORZ, True
'Get the scrollbar information
SI.cbSize = Len(SI)
SI.fMask = SIF_ALL
FlatSB_GetScrollInfo Me.hWnd, SB_VERT, SI
SI.nPos = SI.nPos - 10
'Set the new scrollbar information
FlatSB_SetScrollInfo Me.hWnd, SB_VERT, SI, True
'Show some scrollbar information on the form
Dim RetMin As Long, RetMax As Long
FlatSB_GetScrollRange Me.hWnd, SB_VERT, RetMin, RetMax
Me.AutoRedraw = True
' Me.Print "Scroll Position:" + Str$(Int(100 * (FlatSB_GetScrollPos(Me.hWnd, SB_VERT) / RetMax))) + "%"
FlatSB_GetScrollProp Me.hWnd, WSB_PROP_VSTYLE, RetMin
Me.Print "Vertical Scrollbar Mode:" + Str$(RetMin)
End Sub
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Dim Ret As Long
'Create the scrollbars on the form
Ret = GetWindowLong(Me.hWnd, GWL_STYLE)
Ret = Ret Or WS_VSCROLL Or WS_HSCROLL
SetWindowLong Me.hWnd, GWL_STYLE, Ret
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Remove the Flat style
UninitializeFlatSB Me.hWnd
End Sub