Scrolling a form?

**Platypus1** · Sep 27th, 2000, 09:42 AM

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.

Sep 27th, 2000, 11:13 AM

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

Sep 27th, 2000, 11:18 AM

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

Sep 27th, 2000, 02:11 PM

If you need an example, here is one on how to make a scrollable form.

**Platypus1** · Sep 27th, 2000, 02:56 PM

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.

Sep 27th, 2000, 03:18 PM

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

**spiritwolf** · Oct 6th, 2000, 04:03 PM

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!

**Platypus1** · Oct 6th, 2000, 04:48 PM

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.

**Jop** · Oct 8th, 2000, 08:35 AM

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

Thread: Scrolling a form?

Thread Tools

Display

RE: Scrolling Form

scrolling form

RE: spiritwolf

Posting Permissions