home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD122291212000.psc / AsyncBitmap.ctl next >
Encoding:
Text File  |  2000-11-28  |  4.7 KB  |  160 lines
  1. VERSION 5.00
  2. Begin VB.UserControl AsyncBitmap 
  3.    ClientHeight    =   2055
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   2340
  7.    ScaleHeight     =   2055
  8.    ScaleWidth      =   2340
  9.    Begin VB.PictureBox picBitmap 
  10.       AutoSize        =   -1  'True
  11.       Height          =   1695
  12.       Left            =   120
  13.       ScaleHeight     =   1635
  14.       ScaleWidth      =   1995
  15.       TabIndex        =   1
  16.       Top             =   120
  17.       Width           =   2055
  18.    End
  19.    Begin VB.PictureBox Picture1 
  20.       Height          =   135
  21.       Left            =   480
  22.       ScaleHeight     =   135
  23.       ScaleWidth      =   15
  24.       TabIndex        =   0
  25.       Top             =   480
  26.       Width           =   15
  27.    End
  28. End
  29. Attribute VB_Name = "AsyncBitmap"
  30. Attribute VB_GlobalNameSpace = False
  31. Attribute VB_Creatable = True
  32. Attribute VB_PredeclaredId = False
  33. Attribute VB_Exposed = False
  34. Option Explicit
  35. Dim g_Counter As Integer
  36. Private mstrPictureFromURL As String
  37. Private mstrFileName As String
  38. Private m_bDownloadCompleted As Boolean
  39. Public Event DownloadCompleted()
  40. Public Property Get DownloadCompleted() As Boolean
  41.     DownloadCompleted = m_bDownloadCompleted
  42. End Property
  43. Public Property Let DownloadCompleted(ByVal newVal As Boolean)
  44.     m_bDownloadCompleted = newVal
  45. End Property
  46. Public Property Get SaveToFileName() As String
  47.    SaveToFileName = mstrPictureFromURL
  48. End Property
  49.  
  50. Public Property Let SaveToFileName(ByVal NewString As String)
  51.    mstrFileName = NewString
  52.    PropertyChanged "SaveToFileName"
  53. End Property
  54. Public Property Get PictureFromURL() As String
  55.    PictureFromURL = mstrPictureFromURL
  56. End Property
  57.  
  58. Public Property Let PictureFromURL(ByVal NewString As String)
  59.    On Error GoTo ErrHandler
  60.    ' (Code to validate path or URL omitted.)
  61.    mstrPictureFromURL = NewString
  62.    If (Ambient.UserMode = True) And (NewString <> "") Then
  63.       ' If program is in run mode, and the URL string
  64.       ' is not empty, begin the download.
  65.     'AsyncRead NewString, vbAsyncTypePicture, "PictureFromURL"
  66.     m_bDownloadCompleted = False
  67.     'AsyncRead NewString, vbAsyncTypeFile, "FileFromURL", 1
  68.     AsyncRead NewString, vbAsyncTypeFile, mstrFileName & CStr(1000 * Rnd), 1
  69.    End If
  70.    Exit Property
  71. ErrHandler:
  72.     RaiseEvent DownloadCompleted
  73. End Property
  74.  
  75. Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
  76.    On Error Resume Next
  77.    'Select Case AsyncProp.PropertyName
  78.     '  Case "PictureFromURL"
  79.      '    Set Picture = AsyncProp.Value
  80.       '   Debug.Print "Download complete"
  81.     'Case "FileFromURL"
  82.         CopyToFile (AsyncProp.Value)
  83.    'End Select
  84. End Sub
  85. Private Sub picBitmap_Resize()
  86.    ' If there's a Picture assigned, resize.
  87.    If picBitmap.Picture <> 0 Then
  88.       UserControl.Size picBitmap.Width, _
  89.          picBitmap.Height
  90.    End If
  91. End Sub
  92.  
  93. Private Sub UserControl_Resize()
  94.    If picBitmap.Picture = 0 Then
  95.       picBitmap.Move 0, 0, ScaleWidth, ScaleHeight
  96.    Else
  97.       If (Width <> picBitmap.Width) _
  98.             Or (Height <> picBitmap.Height) Then
  99.          Size picBitmap.Width, picBitmap.Height
  100.       End If
  101.    End If
  102. End Sub
  103.  
  104. Private Sub UserControl_InitProperties()
  105.    ' Use Nothing as the default when initializing,
  106.    '   reading, and writing the Picture property,
  107.    '   so than an .frx file won't be needed if
  108.    '   there's no picture.
  109.    m_bDownloadCompleted = True
  110.    Set Picture = Nothing
  111. End Sub
  112.  
  113. Private Sub UserControl_ReadProperties( _
  114.          PropBag As PropertyBag)
  115.    Set Picture = _
  116.       PropBag.ReadProperty("Picture", Nothing)
  117. End Sub
  118.  
  119. Private Sub UserControl_WriteProperties( _
  120.          PropBag As PropertyBag)
  121.    PropBag.WriteProperty "Picture", Picture, Nothing
  122. End Sub
  123.  
  124.  
  125.  
  126. Public Property Get Picture() As Picture
  127.    Set Picture = picBitmap.Picture
  128. End Property
  129.  
  130. Public Property Let Picture(ByVal NewPicture _
  131.       As Picture)
  132.    Set picBitmap.Picture = NewPicture
  133.    PropertyChanged "Picture"
  134. End Property
  135.  
  136. Public Property Set Picture(ByVal NewPicture _
  137.       As Picture)
  138.    Set picBitmap.Picture = NewPicture
  139.    'PropertyChanged "Picture"
  140. End Property
  141.  
  142. Private Function CopyToFile(ByVal filename As String)
  143. Dim nHandle As Integer, nHandleRead As Integer
  144. Dim sPath As String, sFile As String
  145. Dim byteTmp As Byte
  146.     nHandle = FreeFile
  147.     Open mstrFileName For Binary Access Write As nHandle
  148.      nHandleRead = FreeFile
  149.     Open filename For Binary Access Read As nHandleRead
  150.     Do While Not EOF(nHandleRead)
  151.         Get nHandleRead, , byteTmp
  152.         Put nHandle, , byteTmp
  153.     Loop
  154.     Close nHandle
  155.     Close nHandleRead
  156.     m_bDownloadCompleted = True
  157.     RaiseEvent DownloadCompleted
  158. End Function
  159.  
  160.