VERSION 5.00
Begin VB.Form frmScroll 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Scrolling Form"
   ClientHeight    =   6015
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8940
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6015
   ScaleWidth      =   8940
   StartUpPosition =   2  'CenterScreen
   Begin VB.VScrollBar VScroll1 
      Height          =   6015
      Left            =   8580
      TabIndex        =   2
      Top             =   0
      Width           =   375
   End
   Begin VB.PictureBox picWindow 
      BorderStyle     =   0  'None
      Height          =   6015
      Left            =   0
      ScaleHeight     =   6015
      ScaleWidth      =   8535
      TabIndex        =   0
      Top             =   0
      Width           =   8535
      Begin VB.PictureBox picI_Scroll 
         BorderStyle     =   0  'None
         Height          =   13000
         Left            =   0
         ScaleHeight     =   13005
         ScaleWidth      =   8535
         TabIndex        =   1
         Top             =   0
         Width           =   8535
         Begin VB.CheckBox Check1 
            Caption         =   "Check1"
            Height          =   495
            Left            =   3720
            TabIndex        =   5
            Top             =   10000
            Width           =   1455
         End
         Begin VB.ComboBox Combo1 
            Height          =   315
            Left            =   3480
            TabIndex        =   4
            Text            =   "Combo1"
            Top             =   2040
            Width           =   1215
         End
         Begin VB.CommandButton cmdExit 
            Caption         =   "&Exit"
            Height          =   375
            Left            =   3863
            TabIndex        =   3
            Top             =   12480
            Width           =   1215
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "More Stuff Below"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   12
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   300
            Left            =   3120
            TabIndex        =   6
            Top             =   5160
            Width           =   2085
         End
      End
   End
End
Attribute VB_Name = "frmScroll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' You have a royalty-free right to use, modify, reproduce and distribute
' the Sample Application Files (and/or any modified version) in any way
' you find useful, provided that you agree that Martin Liss has no warranty,
' obligations or liability for any Sample Application Files.


' All objects that should scroll must be drawn in picI_Scroll

' If you need to edit any of the objects that are below the bottom of the form,
' temporarily change picI_Scroll.Top to -1000, -10000, or whatever it takes

Public Disclaimer

Private Sub cmdExit_Click()

    Unload Me
    Set frmScroll = Nothing
    
End Sub

Private Sub Form_Activate()

    ' So that scrooling will happen if the user immediately presses
    ' PageUp or PageDown
    picI_Scroll.SetFocus
    
End Sub

Private Sub Form_Load()

    
    picWindow.Left = 0
    picWindow.Width = Me.Width - VScroll1.Width
    
    VScroll1.Height = picWindow.Height
    VScroll1.Max = picI_Scroll.Height - picWindow.Height
    VScroll1.SmallChange = 100
    VScroll1.LargeChange = picWindow.Height
    VScroll1.Left = Me.Width - VScroll1.Width - 60
    VScroll1.Top = 0
    
    picI_Scroll.Left = 0
    picI_Scroll.Width = picWindow.Width
    
End Sub


Public Sub CheckKeyCode(KeyCode As Integer)
'***************************************************************************
'Purpose: Intercept and act on special keys on me so
'         that up and down arrows and scroll bar works as expected. Also
'         automatically scroll screen when Tab key would otherwise disappear
'         off the screen.
'Inputs:  KeyCode - The ASCII(?) value of the key pressed
'Outputs: None
'***************************************************************************

    Dim nScrollValue As Double
    Dim nOnePage As Integer
    
    nOnePage = Me.VScroll1.Height
    
    If KeyCode = vbKeyPageUp Or KeyCode = vbKeyPageDown Then
        If KeyCode = vbKeyPageDown Then
            nScrollValue = -Me.picI_Scroll.Top + nOnePage
        Else
            nScrollValue = -Me.picI_Scroll.Top - nOnePage
        End If
        'Make sure that the scroll bar 'handle' is not attempted to be positioned
        'below the bottom of the scroll bar.
        If nScrollValue > Me.VScroll1.Max Then
            nScrollValue = Me.VScroll1.Max
            Me.picI_Scroll.Top = -Me.VScroll1.Max
        End If
        If nScrollValue > 0 Then
            Me.VScroll1.Value = nScrollValue
        Else
            Me.VScroll1.Value = 0
        End If
    End If
    
End Sub


Private Sub picI_Scroll_KeyDown(KeyCode As Integer, Shift As Integer)

    CheckKeyCode KeyCode
    
End Sub

Private Sub VScroll1_Change()

    picI_Scroll.Top = -(VScroll1.Value)
    
    ' So that the scrollbar doesn't blink
    cmdExit.SetFocus

End Sub