Option Explicit
Enum ScrollingBars
None = 0
Vertical = 1
Horizontal = 2
Both = 3
End Enum
Dim ScrlBars As ScrollingBars
Dim strFileName As String
Dim lngBackColor As Long
Dim VerticalValue As Long
Dim HorizontalValue As Long
Public Property Get ViewWidth() As Long
ViewWidth = picView.Width
End Property
Public Property Let ViewWidth(ByVal vNewValue As Long)
picView.Width = vNewValue
Call ScrollingValues
PropertyChanged "ViewWidth"
End Property
Public Property Get ViewWidthPosition() As Long
ViewWidthPosition = ScrollingHorizontal.Value
End Property
Public Property Let ViewWidthPosition(ByVal vNewValue As Long)
If vNewValue > ScrollingHorizontal.Max Then vNewValue = ScrollingHorizontal.Max
If vNewValue < 0 Then vNewValue = 0
ScrollingHorizontal.Value = vNewValue
PropertyChanged "ViewWidthPosition"
End Property
Public Property Get ViewHeigth() As Long
ViewHeigth = picView.Height
End Property
Public Property Let ViewHeigth(ByVal vNewValue As Long)
picView.Height = vNewValue
Call ScrollingValues
PropertyChanged "ViewHeight"
End Property
Public Property Get ViewHeigthPosition() As Long
ViewHeigthPosition = ScrollingVertical.Value
End Property
Public Property Let ViewHeigthPosition(ByVal vNewValue As Long)
If vNewValue > ScrollingVertical.Max Then vNewValue = ScrollingVertical.Max
If vNewValue < 0 Then vNewValue = 0
ScrollingVertical.Value = vNewValue
PropertyChanged "ViewHeightPosition"
End Property
Public Property Get ShowScrollingBars() As ScrollingBars
ShowScrollingBars = ScrlBars
End Property
Public Property Let ShowScrollingBars(ByVal vNewValue As ScrollingBars)
ScrlBars = vNewValue
If vNewValue = None Then
ScrollingHorizontal.Visible = False
ScrollingVertical.Visible = False
Picture1.Visible = False
ElseIf vNewValue = Horizontal Then
ScrollingHorizontal.Visible = True
ScrollingVertical.Visible = False
Picture1.Visible = False
ElseIf vNewValue = Vertical Then
ScrollingHorizontal.Visible = False
ScrollingVertical.Visible = True
Picture1.Visible = False
ElseIf vNewValue = Both Then
Picture1.Visible = True
ScrollingHorizontal.Visible = True
ScrollingVertical.Visible = True
End If
Call UserControl_Resize
PropertyChanged "ShowScrollingBars"
End Property
Private Sub picView_Resize()
ViewWidth = picView.Width
ViewHeigth = picView.Height
End Sub
Private Sub ScrollingHorizontal_Change()
Dim i As Long
If HorizontalValue > ScrollingHorizontal.Value Then
picView.Top = picView.Top + (Abs(ScrollingHorizontal.Value - HorizontalValue))
ElseIf HorizontalValue < ScrollingHorizontal.Value Then
picView.Top = picView.Top - (Abs(ScrollingHorizontal.Value - HorizontalValue))
End If
For i = 0 To UserControl.ContainedControls.Count - 1
If HorizontalValue > ScrollingHorizontal.Value Then
UserControl.ContainedControls(i).Left = UserControl.ContainedControls(i).Left + (Abs(ScrollingHorizontal.Value - HorizontalValue)) * Screen.TwipsPerPixelX
ElseIf HorizontalValue < ScrollingHorizontal.Value Then
UserControl.ContainedControls(i).Left = UserControl.ContainedControls(i).Left - (Abs(ScrollingHorizontal.Value - HorizontalValue)) * Screen.TwipsPerPixelX
End If
Next i
HorizontalValue = ScrollingHorizontal.Value
End Sub
Private Sub ScrollingVertical_Change()
Dim i As Long
If VerticalValue > ScrollingVertical.Value Then
picView.Top = picView.Top + (Abs(ScrollingVertical.Value - VerticalValue))
ElseIf VerticalValue < ScrollingVertical.Value Then
picView.Top = picView.Top - (Abs(ScrollingVertical.Value - VerticalValue))
End If
For i = 0 To UserControl.ContainedControls.Count - 1
If VerticalValue > ScrollingVertical.Value Then
UserControl.ContainedControls(i).Top = UserControl.ContainedControls(i).Top + (Abs(ScrollingVertical.Value - VerticalValue)) * Screen.TwipsPerPixelX
ElseIf VerticalValue < ScrollingVertical.Value Then
UserControl.ContainedControls(i).Top = UserControl.ContainedControls(i).Top - (Abs(ScrollingVertical.Value - VerticalValue)) * Screen.TwipsPerPixelX
End If
Next i
VerticalValue = ScrollingVertical.Value
End Sub
Private Sub Timer1_Timer()
Picture1.ZOrder 0
ScrollingHorizontal.ZOrder 0
ScrollingVertical.ZOrder 0
End Sub
Private Sub UserControl_Initialize()
lngBackColor = &H8000000F
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
ViewWidth = PropBag.ReadProperty("ViewWidth", 0)
ViewWidthPosition = PropBag.ReadProperty("ViewWidthPosition", 0)
ViewHeigth = PropBag.ReadProperty("ViewHeigth", 0)
ViewHeigthPosition = PropBag.ReadProperty("ViewHeigthPosition", 0)
ShowScrollingBars = PropBag.ReadProperty("ShowScrollingBars", 0)
FileName = PropBag.ReadProperty("FileName", "")
BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
picView.Picture = PropBag.ReadProperty("Image", Nothing)
End Sub
Private Sub UserControl_Resize()
ScrollingHorizontal.Top = UserControl.Height / Screen.TwipsPerPixelY - ScrollingHorizontal.Height - 4
ScrollingHorizontal.Width = UserControl.Width / Screen.TwipsPerPixelX - 4
ScrollingVertical.Left = UserControl.Width / Screen.TwipsPerPixelX - ScrollingHorizontal.Height - 4
ScrollingVertical.Height = UserControl.Height / Screen.TwipsPerPixelY - 4
If ScrlBars = Both Then
ScrollingVertical.Height = ScrollingVertical.Height - 16
ScrollingHorizontal.Width = ScrollingHorizontal.Width - 16
End If
Picture1.Top = UserControl.Height / Screen.TwipsPerPixelY - Picture1.Height - 4
Picture1.Left = UserControl.Width / Screen.TwipsPerPixelX - Picture1.Width - 4
Call ScrollingValues
End Sub
Private Sub UserControl_Show()
Picture1.ZOrder 0
ScrollingHorizontal.ZOrder 0
ScrollingVertical.ZOrder 0
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "ViewWidth", ViewWidth, 0
PropBag.WriteProperty "ViewWidthPosition", ViewWidthPosition, 0
PropBag.WriteProperty "ViewHeigth", ViewWidth, 0
PropBag.WriteProperty "ViewHeigthPosition", ViewHeigthPosition, 0
PropBag.WriteProperty "ShowScrollingBars", ShowScrollingBars, 0
PropBag.WriteProperty "FileName", FileName, ""
PropBag.WriteProperty "BackColor", BackColor, &H8000000F
PropBag.WriteProperty "Image", Image, Null
PropBag.WriteProperty "Image", picView.Image, Nothing
End Sub
Public Property Get FileName() As String
FileName = strFileName
End Property
Public Property Let FileName(ByVal vNewValue As String)
strFileName = vNewValue
picView.Picture = LoadPicture(strFileName)
picView.AutoSize = True
picView.AutoSize = False
Call ScrollingValues
HorizontalValue = ScrollingHorizontal.Value
VerticalValue = ScrollingVertical.Value
PropertyChanged "FileName"
End Property
Public Property Get BackColor() As OLE_COLOR
BackColor = lngBackColor
End Property
Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
lngBackColor = vNewValue
picView.BackColor = lngBackColor
Call ChangeBackcolor(picView, lngBackColor)
PropertyChanged "BackColor"
End Property
Private Sub ScrollingValues()
ScrollingVertical.Max = picView.Height - UserControl.ScaleHeight
If ScrlBars = Vertical Or ScrlBars = Both Then ScrollingVertical.Max = ScrollingVertical.Max + 17
ScrollingHorizontal.Max = picView.Width - UserControl.ScaleWidth
If ScrlBars = Horizontal Or ScrlBars = Both Then ScrollingHorizontal.Max = ScrollingHorizontal.Max + 17
If picView.ScaleHeight <= UserControl.ScaleHeight Then ScrollingVertical.Max = 0
If picView.ScaleWidth <= UserControl.ScaleWidth Then ScrollingHorizontal.Max = 0
End Sub
Public Property Let Image(ByVal img As Picture)
Set picView.Picture = img
PropertyChanged "Image"
End Property
Public Property Get Image() As Picture
Set Image = picView.Image
End Property