VERSION 5.00
Begin VB.UserControl VPort 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   2145
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2550
   ScaleHeight     =   143
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   170
   Begin VB.HScrollBar HS 
      Height          =   255
      Left            =   600
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   840
      Visible         =   0   'False
      Width           =   1215
   End
   Begin VB.VScrollBar VS 
      Height          =   1215
      Left            =   1200
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   480
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.PictureBox Pic 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1800
      Left            =   0
      ScaleHeight     =   120
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   120
      TabIndex        =   2
      Top             =   0
      Visible         =   0   'False
      Width           =   1800
   End
End
Attribute VB_Name = "VPort"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Enum eBorderStyle
 None
 [Fixed Single]
End Enum
Public Enum eAppearance
 Flat
 [3D]
End Enum
Private Sub UserControl_Resize()
 SetScroll
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
 Set Picture = PropBag.ReadProperty("Picture", Nothing)
 UserControl.Appearance = PropBag.ReadProperty("Appearance", 1)
 UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
 Call PropBag.WriteProperty("Picture", Picture, Nothing)
 Call PropBag.WriteProperty("Appearance", UserControl.Appearance, 1)
 Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 1)
End Sub

Private Sub VS_Change()
 Pic.Top = -VS.Value
End Sub

Private Sub VS_Scroll()
 Pic.Top = -VS.Value
End Sub

Private Sub HS_Change()
 Pic.Left = -HS.Value
End Sub

Private Sub HS_Scroll()
 Pic.Left = -HS.Value
End Sub

Public Property Get Picture() As Picture
 Set Picture = Pic.Picture
End Property

Public Property Set Picture(ByVal New_Picture As Picture)
 Set Pic.Picture = New_Picture
 PropertyChanged "Picture"
 Pic.Visible = Not New_Picture Is Nothing
 SetScroll
End Property

Private Sub SetScroll()
 Dim PicW As Long
 Dim PicH As Long
 Dim VSVis As Boolean
 Dim HSVis As Boolean
 PicW = Pic.ScaleX(Pic.Picture.Width, vbHimetric, vbPixels)
 PicH = Pic.ScaleY(Pic.Picture.Height, vbHimetric, vbPixels)
 Pic.Width = PicW
 Pic.Height = PicH
 HSVis = PicW > ScaleWidth
 VSVis = PicH > ScaleHeight
 HS.Visible = HSVis
 VS.Visible = VSVis
 HS.Max = Abs(PicW - ScaleWidth) + IIf(VSVis, VS.Width, 0)
 HS.LargeChange = HS.Max \ 10
 HS.Move 0, ScaleHeight - HS.Height, ScaleWidth - IIf(VSVis, VS.Width, 0), HS.Height
 VS.Max = Abs(PicH - ScaleHeight) + IIf(HSVis, HS.Height, 0)
 VS.LargeChange = VS.Max \ 10
 VS.Move ScaleWidth - VS.Width, 0, VS.Width, ScaleHeight - IIf(HSVis, HS.Height, 0)
End Sub
Public Property Get Appearance() As eAppearance
Attribute Appearance.VB_Description = "Returns/sets whether or not an object is painted at run time with 3-D effects."
 Appearance = UserControl.Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As eAppearance)
 UserControl.Appearance() = New_Appearance
 PropertyChanged "Appearance"
End Property
Public Property Get BorderStyle() As eBorderStyle
Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
 BorderStyle = UserControl.BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As eBorderStyle)
 UserControl.BorderStyle() = New_BorderStyle
 PropertyChanged "BorderStyle"
End Property