Create a new project
Add a picture box and command button
Add the following code:
Dim Tenth as Long
' Conditional compilation
#If Win32 Then
Private Declare Function BitBlt Lib "GDI32" _
(ByVal hdestdc as Long, ByVal x as Long, ByVal y as Long, _
ByVal nwidth as Long, ByVal nheight as Long, _
ByVal HSRCDC as Long, ByVal xsrc as Long, ByVal ysrc as Long, _
ByVal Dwrop as Long) as long
#Else
Private Declare Function BitBlt Lib "GDI" (ByVal Hdestdc as _
Integer, ByVal x As Integer, ByVal y As Integer, ByVal nwidth _
As Integer, ByVal nheight As Integer, ByVal hsrcdc As Integer, _
ByVal xsrc As Integer, ByVal ysrc As Integer, ByVal dwrop as _
Long) as Integer
#End If
Sub UpdateStatus (filebytes as Long)
'--------------------------------------------------------------------
' Update Picture1 status bar
'--------------------------------------------------------------------
Static Progress as Long
Dim R as Long
Const srccopy = &hcc0020
Dim txt$
Progress = progress + filebytes
If Progress > Picture1.scalewidth Then
progress = Picture1.scalewidth
End If
txt$ = format$ (CLng ((progress/picture1.scalewidth) * 100)) + "%"
Picture1.cls
Picture1.currentx = _
(Picture1.scalewidth-picture1.textwidth (txt$)) \ 2
Picture1.currenty = _
(Picture1.scaleheight-picture1.textheight (txt$)) \ 2
Picture1.Print txt$
Picture1.line (0, 0)-(progress, picture1.scaleheight), _
Picture1.forecolor, BF
R = BitBlt (PICTURE1.HDC, 0, 0, Picture1.scalewidth, _
Picture1.scaleheight, PICTURE1.HDC, 0, 0, srccopy)
End Sub
Private Sub Command1_Click ()
Picture1.scalewidth = 109
Tenth = 10
For i = 1 to 11
Call UpdateStatus (tenth)
x = Timer
While Timer < x + 0.75
DoEvents
Wend
Next
End Sub
Private Sub Form_Load ()
Picture1.fontbold = True
Picture1.autoredraw = True
Picture1.backcolor = Vbwhite
Picture1.drawmode = 10
Picture1.fillstyle = 0
Picture1.forecolor = Vbblue
End Sub
F5 Run, click Command1 to see the effect.