Как организовать длительное копирование файлов с анимац картинкой летящих листочков как в Windows - VB

Формулировка задачи:

Как организовать длительное копирование файлов с анимационной картинкой летящих листочков как в Windows и ProgressBar'ом, и желательно оценкой времени оставшегося до конца копирования. Если есть пример или готовый компонент киньте ,плиз, на мыло!

Решение задачи: «Как организовать длительное копирование файлов с анимац картинкой летящих листочков как в Windows»

textual
                            Листинг программы 
                        

                            '---------------------------
'Copy any file (include open files)
'--------------------------------
Private Declare Function SHFileOperation Lib 'shell32.dll' _
    Alias 'SHFileOperationA' (lpFileOp As SHFILEOPSTRUCT) As Long
 
Private Type SHFILEOPSTRUCT
    hwnd As Long                ' Window owner of any dialogs
    wFunc As Long               ' Copy, move, rename, or delete code
    pFrom As String             ' Source file
    pTo As String               ' Destination file or directory
    fFlags As Integer           ' Options to control the operations
    fAnyOperationsAbortedLo As Integer ' Indicates partial failure
    fAnyOperationsAbortedHi As Integer
    hNameMappingsLo As Long     ' Array indicating each success
    hNameMappingsHi As Long
    lpszProgressTitleLo As Long ' Title for progress dialog
    lpszProgressTitleHi As Long
End Type
 
 
 
' Better version of FileCopy (CopyAnyFile) and matching MoveAnyFile,
' DeleteAnyFile, and RenameAnyFile
Function CopyAnyFile(sSrc As String, sDst As String, _
                     Optional ByVal fConfirmMsgShow As Boolean = True, Optional ByVal fProgressShow As Boolean = True, _
                     Optional Owner As Long) As Boolean
    If True Then    'в NT не будет работать!!
        Dim fo As SHFILEOPSTRUCT, f As Long
        fo.wFunc = 2 'FO_COPY
        Debug.Print TypeName(fo.wFunc)
        fo.pFrom = sSrc
        fo.pTo = sDst
        fo.fFlags = SetOpFlagsForCopyAny(fConfirmMsgShow, fProgressShow)
        fo.hwnd = Owner
        ' Mask out invalid flags
        fo.fFlags = fo.fFlags And 989   'FOF_COPYFLAGS
        f = SHFileOperation(fo)
        CopyAnyFile = (f = 0)
    Else         ' For Windows NT 3.51
        On Error Resume Next
        ' FileCopy expects full name of destination file
        FileCopy sSrc, sDst
        If Err Then
            MsgBox 'Path error.', vbCritical, 'Error'
        End If
        CopyAnyFile = (Err = 0)
    End If
End Function
 
Private Function SetOpFlagsForCopyAny(Optional ByVal fConfirmMsgShow As Boolean = True, Optional ByVal fProgressShow As Boolean = True) As Long
    Dim lFlags As Long
    lFlags = 0
    If Not fConfirmMsgShow Then lFlags = lFlags Or 16        'FOF_NOCONFIRMATION
    If fProgressShow Then lFlags = lFlags Or 256          'FOF_SIMPLEPROGRESS
    SetOpFlagsForCopyAny = lFlags
End Function
                        