如何实现像Windows中的拷贝进度的效果

Question

如题
想做一个显示进度的窗口，像Windows中拷贝文件那样的效果
如何做了，Windows中有没有这样的控件，怎么用

Answer 1

我机子上的文件,不记得何时就有了Public sub CopyFile(Src As String, Dst As String) As Single 
     Dim BTest!, FSize! 
     Dim F1%, F2% 
     Dim sArray() As Byte 
     Dim buff As Integer 
     
     Const BUFSIZE = 1024 
     
     buff = 1024 
     
     F1 = FreeFile 
     Open Src For Binary As F1 
     F2 = FreeFile 
     Open Dst For Binary As F2 
     
     FSize = LOF(F1) 
     BTest = FSize - LOF(F2) 
     ReDim sArray(BUFSIZE) As Byte 
     
     Do 
     If BTest < BUFSIZE Then 
     buff = BTest 
     ReDim sArray(buff) As Byte 
     End If 
     
     Get F1, , sArray 
     Put F2, , sArray 
     
     BTest = FSize - LOF(F2) 
     If BTest < 0 Then 
     ProgressBar.Value = 100 
     Else 
     ProgressBar.Value = (100 - Int(100 * BTest / FSize)) 
     End If 
     Loop Until BTest <= 0 
     
     Close F1 
     Close F2 
     CopyFile = FSize 
     
    End sub

Answer 2

拷贝文件带进度条 
http://community.csdn.net/Expert/topic/4550/4550323.xml?temp=.7952234

Answer 3

'http://www.china-askpro.com/msg8/qa86.shtml 这里有更详细的解释
Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
Private Const FO_DELETE As Long = &H3
Private Const FO_RENAME As Long = &H4
Private Const FOF_MULTIDESTFILES As Long = &H1
Private Const FOF_CONFIRMMOUSE As Long = &H2
Private Const FOF_SILENT As Long = &H4
Private Const FOF_RENAMEONCOLLISION As Long = &H8
Private Const FOF_NOCONFIRMATION As Long = &H10
Private Const FOF_WANTMAPPINGHANDLE As Long = &H20
Private Const FOF_CREATEPROGRESSDLG As Long = &H0
Private Const FOF_ALLOWUNDO As Long = &H40
Private Const FOF_FILESONLY As Long = &H80
Private Const FOF_SIMPLEPROGRESS As Long = &H100
Private Const FOF_NOCONFIRMMKDIR As Long = &H200Private Type SHFILEOPSTRUCT
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Long
     fAnyOperationsAborted As Long
     hNameMappings As Long
     lpszProgressTitle As String
End TypePrivate Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As LongPrivate Sub Command1_Click()
    Dim result As Long
    Dim fileop As SHFILEOPSTRUCT
    With fileop
        .hwnd = Me.hwnd
        .wFunc = FO_COPY
        .pFrom = "C:\PROGRAM FILES\MICROSOFT VISUAL BASIC\VB.HLP" & vbNullChar & "C:\PROGRAM FILES\MICROSOFT VISUAL BASIC\README.HLP" & vbNullChar & vbNullChar
        .pFrom = "C:\*.txt" & vbNullChar & vbNullChar
        .pTo = "C:\testfolder" & vbNullChar & vbNullChar
        .fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY
    End With
    result = SHFileOperation(fileop)
    If result <> 0 Then
        ' Operation failed
        MsgBox Err.LastDllError
    Else
        If fileop.fAnyOperationsAborted <> 0 Then
            MsgBox "Operation Failed"
        End If
    End If
End Sub

Answer 4

你可以在SHELL32.DLL文件中找到该资源，是一个AVI文件

Answer 5

//我不要拷贝文件，只要那个进度条，带文件件夹飘浮动画效果的。
谁能解？可以用Animation控件，想播什么就播什么，呵呵
那个.AVI文件我好像有现成的，
留个mail吧~~传给你

Answer 6

[email protected] ，谢谢你了visualbear(void)