VERSION 5.00
Begin VB.UserControl AutoScroll 
   Alignable       =   -1  'True
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ControlContainer=   -1  'True
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   Begin VB.VScrollBar vsMain 
      Height          =   3615
      LargeChange     =   16
      Left            =   4545
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   240
   End
End
Attribute VB_Name = "AutoScroll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Sub Redraw()
Dim uCtl As PictureBox, _
uTop As Long, uHeight As Long, _
uMeWidth As Long, uMeHeight As Long

    With UserControl
    
        If .ContainedControls.Count = 0 Then Exit Sub
    
    uMeWidth = .ScaleWidth
    uMeHeight = .ScaleHeight
    Set uCtl = GetContainerRef()
    uTop = uCtl.Top
    uHeight = uCtl.Height + uCtl.Top
    
        'Vamos aos casos possíveis.
        If (uHeight - uTop) <= uMeHeight Then  'Tem espaço.
        
            If .vsMain.Visible Then
            .vsMain.Visible = False
        
                With uCtl
                .Left = 0
                .Width = uMeWidth
                .Top = 0
                End With

            End If
            
        Else 'Não tem espaço. Agora complicou.
            
            If Not .vsMain.Visible Then
            .vsMain.Visible = True
            .vsMain.Top = 0
            .vsMain.Left = .ScaleWidth - .vsMain.Width
        
                With uCtl
                .Left = 0
                .Width = uMeWidth - UserControl.vsMain.Width
                .Top = 0
                End With

            End If
        
        .vsMain.Height = .ScaleHeight
        
            If (uTop + uHeight) < uMeHeight Then  'O Container está parte escondido.
            uCtl.Top = uMeHeight - uHeight
            End If
            
        Call CalcVS(uCtl)
        End If
        
    End With

End Sub
Function GetContainerRef() As PictureBox
Dim uCtl As Object

    For Each uCtl In UserControl.ContainedControls
    
        If uCtl.Name = "picContainer" Then
        Set GetContainerRef = uCtl
        Exit Function
        End If
        
    Next uCtl

End Function
Sub CalcVS(uContainerControl As PictureBox)
Dim uContHeight As Long, uMeHeight As Long

uContHeight = uContainerControl.Height
uMeHeight = UserControl.ScaleHeight


    With UserControl.vsMain
    .Max = ((uContHeight - uMeHeight) / Screen.TwipsPerPixelY) + 1
    .Min = 1
    .Value = (uContainerControl.Top / 15 * -1) + 1
    End With

End Sub
Private Sub UserControl_Resize()
Call Redraw
End Sub
Private Sub vsMain_Change()
GetContainerRef.Top = (vsMain.Value - 1) * -15
End Sub
Private Sub vsMain_Scroll()
GetContainerRef.Top = (vsMain.Value - 1) * -15
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    PropertyChanged "BackColor"
End Property

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
End Sub

