Aşağıdaki kod parçası da yüzde ölçüsünü kullanarak dosya kopyalamaya yarıyor. Göze güzel görünen uygulamalar yapmak için iyi bir şey.

Function CopyFile (src As String, dst As String) As Single

'L. Serflaten 1996

Static Buf$

Dim BTest!, FSize!

Dim Chunk%, F1%, F2%

Const BUFSIZE = 1024

'This routine will copy a file while providing a means

'to support a percent gauge. Ex. your display routine

'is called "PercentDone" and accepts the values 0-100.

'Error support is provided.

'

'A larger BUFSIZE is best, but do not attempt to exceed

'64 K (60000 would be fine)

'

'The size of the copied file is returned on success

'0 is returned on failure

If Dir(src) = "" Then MsgBox "File not found": Exit Function

If Len(Dir(dst)) Then

If MsgBox(UCase(dst) & Chr(13) & Chr(10) & "File exists. Overwrite?", 4) <> 6 Then Exit Function

Kill dst

End If

On Error GoTo FileCopyError

F1 = FreeFile

Open src For Binary As F1

F2 = FreeFile

Open dst For Binary As F2

FSize = LOF(F1)

BTest = FSize - LOF(F2)

Do

If BTest < BUFSIZE Then

Chunk = BTest

Else

Chunk = BUFSIZE

End If

Buf = String(Chunk, " ")

Get F1, , Buf

Put F2, , Buf

BTest = FSize - LOF(F2)

' __Call percent display here__

'PercentDone ( 100 - Int(100 * BTest/FSize) )

Loop Until BTest = 0

Close F1

Close F2

CopyFile = FSize

Exit Function

FileCopyError:

MsgBox "Copy Error!"

Close F1

Close F2

Exit Function

End Function

Önce formunuza bir ProgressBar kontrolü ekleyip ardından aşağıdaki kodu kullanarak dosya kopyalayabilirsiniz.

ProgressBar1.Value = CopyFile (Which_File*, To_Where**)

* = Kopyalanacak dosya
** = Kopyalanacağı yer