Option Explicit Event DownloadProgress(CurBytes As Long, MaxBytes
As Long, SaveFile As String) Event DownloadError(SaveFile As
String) Event DownloadComplete(MaxBytes As Long, SaveFile As
String) 'Public downStat As Boolean
Public Function
CancelAsyncRead() As Boolean On Error Resume
Next UserControl.CancelAsyncRead End Function
'Private Sub
Timer1_Timer() ' If Not downStat Then ' Timer1.Enabled =
False ' Exit Sub ' End If ' Static Cs As Integer ' If Cs >
2 Then Cs = 0 ' UserControl.Picture = P1(Cs).Picture ' Cs = Cs +
1 ' DoEvents 'End Sub
Private Sub
UserControl_AsyncReadComplete(AsyncProp As AsyncProperty) On Error
Resume Next Dim f() As Byte, fn As Long If AsyncProp.BytesMax
<> 0 Then fn = FreeFile f = AsyncProp.Value Open
AsyncProp.PropertyName For Binary Access Write As #fn Put #fn, ,
f Close #fn Else RaiseEvent
DownloadError(AsyncProp.PropertyName) End If RaiseEvent
DownloadComplete(CLng(AsyncProp.BytesMax),
AsyncProp.PropertyName) downStat = False End Sub Private Sub
UserControl_AsyncReadProgress(AsyncProp As AsyncProperty) On Error
Resume Next If AsyncProp.BytesMax <> 0 Then RaiseEvent
DownloadProgress(CLng(AsyncProp.BytesRead),
CLng(AsyncProp.BytesMax),AsyncProp.PropertyName) downStat = True:
Timer1.Enabled = True End If End Sub 'Private Sub
UserControl_Resize() ' SizeIt 'End Sub
Public Sub
BeginDownload(url As String, SaveFile As String) On Error GoTo
ErrorBeginDownload downStat = True UserControl.AsyncRead url,
vbAsyncTypeByteArray, SaveFile, vbAsyncReadForceUpdate Timer1.Enabled
= True Exit Sub ErrorBeginDownload: downStat = False MsgBox
Err & "开始下载数据失败！" _ & vbCrLf & vbCrLf & "错误：" &
Err.Description, vbCritical, "错误" End Sub
'Public Sub
SizeIt() ' On Error GoTo ErrorSizeIt ' With UserControl ' .Width
= ScaleX(32, vbPixels, vbTwips) ' .Height = ScaleY(32, vbPixels,
vbTwips) ' End With ' Exit Sub 'ErrorSizeIt: 'End
Sub 'Public Sub kill() ' downStat = False ' Dim m As
AsyncProperty ' MsgBox m.Value 'End
Sub
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
