home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / imagebox / scrlimg.ctl < prev    next >
Encoding:
Text File  |  1998-07-10  |  11.8 KB  |  354 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ScrollImgBox 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00808080&
  5.    ClientHeight    =   3765
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   3930
  9.    ScaleHeight     =   3765
  10.    ScaleWidth      =   3930
  11.    Begin VB.VScrollBar VScroll1 
  12.       Height          =   3420
  13.       Left            =   3645
  14.       TabIndex        =   3
  15.       Top             =   0
  16.       Width           =   240
  17.    End
  18.    Begin VB.HScrollBar HScroll1 
  19.       Height          =   240
  20.       Left            =   15
  21.       TabIndex        =   2
  22.       Top             =   3495
  23.       Width           =   3600
  24.    End
  25.    Begin VB.PictureBox Picture2 
  26.       AutoRedraw      =   -1  'True
  27.       BorderStyle     =   0  'None
  28.       Height          =   3345
  29.       Left            =   120
  30.       ScaleHeight     =   223
  31.       ScaleMode       =   3  'Pixel
  32.       ScaleWidth      =   234
  33.       TabIndex        =   1
  34.       Top             =   120
  35.       Width           =   3510
  36.    End
  37.    Begin VB.PictureBox Picture1 
  38.       AutoRedraw      =   -1  'True
  39.       AutoSize        =   -1  'True
  40.       Height          =   2235
  41.       Left            =   60
  42.       ScaleHeight     =   145
  43.       ScaleMode       =   3  'Pixel
  44.       ScaleWidth      =   117
  45.       TabIndex        =   0
  46.       Top             =   60
  47.       Visible         =   0   'False
  48.       Width           =   1815
  49.    End
  50. End
  51. Attribute VB_Name = "ScrollImgBox"
  52. Attribute VB_GlobalNameSpace = False
  53. Attribute VB_Creatable = True
  54. Attribute VB_PredeclaredId = False
  55. Attribute VB_Exposed = True
  56. Option Explicit
  57. Enum Styles
  58. None
  59. SingleLine
  60. End Enum
  61.  
  62. 'Default Property Values:
  63. Const m_def_PictureFromURL = ""
  64. Const m_def_PictureWidth = 0
  65. Const m_def_PictureHeight = 0
  66.  
  67. 'Property Variables:
  68. Private m_PictureFromURL As String
  69. Private m_PictureWidth As Integer
  70. Private m_PictureHeight As Integer
  71.  
  72. 'Event Declarations:
  73. Event Click() 'MappingInfo=Picture1,Picture1,-1,Click
  74. Event DblClick() 'MappingInfo=Picture1,Picture1,-1,DblClick
  75. Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=Picture1,Picture1,-1,KeyDown
  76. Event KeyPress(KeyAscii As Integer) 'MappingInfo=Picture1,Picture1,-1,KeyPress
  77. Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=Picture1,Picture1,-1,KeyUp
  78. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Picture1,Picture1,-1,MouseDown
  79. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Picture1,Picture1,-1,MouseMove
  80. Event ScrollX(X As Integer) 'MappingInfo=HScroll1,HScroll1,-1,Scroll
  81. Event ScrollY(Y As Integer) 'MappingInfo=VScroll1,VScroll1,-1,Scroll
  82. Event ChangeX(X As Integer) 'MappingInfo=HScroll1,HScroll1,-1,Change
  83. Event ChangeY(Y As Integer) 'MappingInfo=VScroll1,VScroll1,-1,Change
  84. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
  85.  
  86. Event DownloadFailed()
  87. Event DownloadCompleted()
  88.  
  89. Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
  90. On Error GoTo NoImage
  91.     If AsyncProp.PropertyName = "PictureFromURL" Then
  92.         Set Picture1.Picture = AsyncProp.Value
  93.         Debug.Print "Download complete"
  94.         ArrangeControl
  95.         UserControl_Paint
  96.         RaiseEvent DownloadCompleted
  97.     End If
  98.     Exit Sub
  99.  
  100. NoImage:
  101.     RaiseEvent DownloadFailed
  102.     Debug.Print "Download failed"
  103. End Sub
  104.  
  105. Private Sub UserControl_Initialize()
  106.     ArrangeControl
  107.     UserControl_Paint
  108. End Sub
  109.  
  110. Private Sub UserControl_Paint()
  111. On Error Resume Next
  112.     Picture2.PaintPicture Picture1.Picture, 0, 0, _
  113.     Picture2.Width, Picture2.Height, _
  114.     HScroll1.Value, VScroll1.Value, _
  115.     Picture2.Width, Picture2.Height
  116. End Sub
  117.  
  118. Private Sub ArrangeControl()
  119.     Picture2.Top = 0
  120.     Picture2.Left = 0
  121.     Picture2.Width = UserControl.Width - VScroll1.Width
  122.     Picture2.Height = UserControl.Height - HScroll1.Height
  123.     HScroll1.Left = 0
  124.     HScroll1.Width = UserControl.Width - VScroll1.Width
  125.     HScroll1.Top = UserControl.Height - HScroll1.Height
  126.     VScroll1.Left = UserControl.Width - VScroll1.Width
  127.     VScroll1.Top = 0
  128.     VScroll1.Height = UserControl.Height - HScroll1.Height
  129.     SetScrollbars
  130. End Sub
  131.  
  132. Public Sub ScrollTo(X As Integer, Y As Integer)
  133.     If HScroll1.Enabled Then
  134.         If X > HScroll1.Max Then X = HScroll1.Max
  135.         HScroll1.Value = X
  136.     End If
  137.     If VScroll1.Enabled Then
  138.         If Y > VScroll1.Max Then Y = VScroll1.Max
  139.         VScroll1.Value = Y
  140.     End If
  141. End Sub
  142.  
  143. 'Initialize Properties for User Control
  144. Private Sub UserControl_InitProperties()
  145.     m_PictureWidth = m_def_PictureWidth
  146.     m_PictureHeight = m_def_PictureHeight
  147.     m_PictureFromURL = m_def_PictureFromURL
  148. End Sub
  149.  
  150. 'Load property values from storage
  151. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  152.     m_PictureWidth = PropBag.ReadProperty("PictureWidth", m_def_PictureWidth)
  153.     m_PictureHeight = PropBag.ReadProperty("PictureHeight", m_def_PictureHeight)
  154.     Set Picture = PropBag.ReadProperty("Picture", Nothing)
  155.     Picture2.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
  156.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  157.     m_PictureFromURL = PropBag.ReadProperty("PictureFromURL", m_def_PictureFromURL)
  158.     HScroll1.Value = PropBag.ReadProperty("XPosition", 0)
  159.     VScroll1.Value = PropBag.ReadProperty("YPosition", 0)
  160. End Sub
  161.  
  162. 'Write property values to storage
  163. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  164.     Call PropBag.WriteProperty("PictureWidth", m_PictureWidth, m_def_PictureWidth)
  165.     Call PropBag.WriteProperty("PictureHeight", m_PictureHeight, m_def_PictureHeight)
  166.     Call PropBag.WriteProperty("Picture", Picture, Nothing)
  167.     Call PropBag.WriteProperty("BorderStyle", Picture2.BorderStyle, 0)
  168.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  169.     Call PropBag.WriteProperty("PictureFromURL", m_PictureFromURL, m_def_PictureFromURL)
  170.     Call PropBag.WriteProperty("XPosition", HScroll1.Value, 0)
  171.     Call PropBag.WriteProperty("YPosition", VScroll1.Value, 0)
  172. End Sub
  173.  
  174. Public Property Get PictureWidth() As Integer
  175.     PictureWidth = m_PictureWidth
  176. End Property
  177.  
  178. Public Property Get PictureHeight() As Integer
  179.     PictureHeight = m_PictureHeight
  180. End Property
  181.  
  182. Public Property Get VisibleWidth() As Integer
  183.     VisibleWidth = (UserControl.Width - VScroll1.Width) / Screen.TwipsPerPixelX
  184. End Property
  185.  
  186. Public Property Get VisibleHeight() As Integer
  187.     VisibleHeight = (UserControl.Height - HScroll1.Height) / Screen.TwipsPerPixelY
  188. End Property
  189. b
  190. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  191. 'MappingInfo=Picture2,Picture2,-1,BorderStyle
  192. Public Property Get BorderStyle() As Integer
  193. Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
  194.     BorderStyle = Picture2.BorderStyle
  195. End Property
  196.  
  197. Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
  198.     Picture2.BorderStyle() = New_BorderStyle
  199.     PropertyChanged "BorderStyle"
  200. End Property
  201.  
  202. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  203. 'MappingInfo=UserControl,UserControl,-1,Refresh
  204. Public Sub Refresh()
  205. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  206.     UserControl.Refresh
  207. End Sub
  208.  
  209. Private Sub picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  210.     RaiseEvent MouseUp(Button, Shift, X, Y)
  211. End Sub
  212.  
  213. Public Property Get Picture() As Picture
  214.     Set Picture = Picture1.Picture
  215. End Property
  216.  
  217. Public Property Set Picture(ByVal New_Picture As Picture)
  218.     Set Picture1.Picture = New_Picture
  219.     ArrangeControl
  220.     UserControl_Paint
  221. End Property
  222.  
  223. Private Sub SetScrollbars()
  224.     m_PictureWidth = ScaleX(Picture1.Picture.Width, 8, vbPixels)
  225.     m_PictureHeight = ScaleY(Picture1.Picture.Height, 8, vbPixels)
  226.     HScroll1.Enabled = True
  227.     VScroll1.Enabled = True
  228.     HScroll1.Visible = True
  229.     VScroll1.Visible = True
  230. ' should we disable horizontal scrollbar?
  231.     If m_PictureWidth <= Picture2.ScaleWidth Then
  232.         Picture2.Width = m_PictureWidth * Screen.TwipsPerPixelX
  233.         HScroll1.Enabled = False
  234.         HScroll1.Width = Picture2.Width
  235.         HScroll1.Visible = False
  236.         VScroll1.Left = Picture2.Left + Picture2.Width
  237.     End If
  238. ' should we disable vertical scrollbar?
  239.     If m_PictureHeight <= Picture2.ScaleHeight Then
  240.         Picture2.Height = m_PictureHeight * Screen.TwipsPerPixelY
  241.         VScroll1.Enabled = False
  242.         VScroll1.Height = Picture2.Height
  243.         VScroll1.Visible = False
  244.         HScroll1.Top = Picture2.Top + Picture2.Height
  245.     End If
  246.     HScroll1.Min = 0
  247.     HScroll1.Max = m_PictureWidth - Picture2.ScaleWidth
  248.     HScroll1.LargeChange = 10
  249.     HScroll1.SmallChange = 1
  250.     VScroll1.Min = 0
  251.     VScroll1.Max = m_PictureHeight - Picture2.ScaleHeight
  252.     VScroll1.LargeChange = 10
  253.     VScroll1.SmallChange = 1
  254. End Sub
  255.  
  256. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  257. 'MappingInfo=UserControl,UserControl,-1,Enabled
  258. Public Property Get Enabled() As Boolean
  259. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  260.     Enabled = UserControl.Enabled
  261. End Property
  262.  
  263. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  264.     UserControl.Enabled() = New_Enabled
  265.     PropertyChanged "Enabled"
  266. End Property
  267.  
  268. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  269. 'MemberInfo=13,0,0,
  270. Public Property Get PictureFromURL() As String
  271.     PictureFromURL = m_PictureFromURL
  272. End Property
  273.  
  274. Public Property Let PictureFromURL(ByVal newValue As String)
  275.     m_PictureFromURL = newValue
  276.     If Ambient.UserMode And newValue <> "" Then
  277.         AsyncRead newValue, vbAsyncTypePicture, "PictureFromURL"
  278.     End If
  279.     PropertyChanged "PictureFromURL"
  280. End Property
  281.  
  282. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  283. 'MappingInfo=HScroll1,HScroll1,-1,Value
  284. Public Property Get XPosition() As Integer
  285. Attribute XPosition.VB_Description = "Returns/sets the value of an object."
  286.     XPosition = HScroll1.Value
  287. End Property
  288.  
  289. Public Property Let XPosition(ByVal New_XPosition As Integer)
  290.     HScroll1.Value() = New_XPosition
  291.     PropertyChanged "XPosition"
  292. End Property
  293.  
  294. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  295. 'MappingInfo=VScroll1,VScroll1,-1,Value
  296. Public Property Get YPosition() As Integer
  297. Attribute YPosition.VB_Description = "Returns/sets the value of an object."
  298.     YPosition = VScroll1.Value
  299. End Property
  300.  
  301. Public Property Let YPosition(ByVal New_YPosition As Integer)
  302.     VScroll1.Value() = New_YPosition
  303.     PropertyChanged "YPosition"
  304. End Property
  305.  
  306. Private Sub HScroll1_Scroll()
  307.     UserControl_Paint
  308.     RaiseEvent ScrollX(HScroll1.Value)
  309. End Sub
  310.  
  311. Private Sub VScroll1_Scroll()
  312.     UserControl_Paint
  313.     RaiseEvent ScrollY(VScroll1.Value)
  314. End Sub
  315.  
  316. Private Sub HScroll1_Change()
  317.     UserControl_Paint
  318.     RaiseEvent ChangeX(HScroll1.Value)
  319. End Sub
  320.  
  321. Private Sub VScroll1_Change()
  322.     UserControl_Paint
  323.     RaiseEvent ChangeY(HScroll1.Value)
  324. End Sub
  325.  
  326. Private Sub Picture2_Click()
  327.     RaiseEvent Click
  328. End Sub
  329.  
  330. Private Sub Picture2_DblClick()
  331.     RaiseEvent DblClick
  332. End Sub
  333.  
  334. Private Sub Picture2_KeyDown(KeyCode As Integer, Shift As Integer)
  335.     RaiseEvent KeyDown(KeyCode, Shift)
  336. End Sub
  337.  
  338. Private Sub Picture2_KeyPress(KeyAscii As Integer)
  339.     RaiseEvent KeyPress(KeyAscii)
  340. End Sub
  341.  
  342. Private Sub Picture2_KeyUp(KeyCode As Integer, Shift As Integer)
  343.     RaiseEvent KeyUp(KeyCode, Shift)
  344. End Sub
  345.  
  346. Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  347.     RaiseEvent MouseDown(Button, Shift, X, Y)
  348. End Sub
  349.  
  350. Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  351.     RaiseEvent MouseMove(Button, Shift, X, Y)
  352. End Sub
  353.  
  354.