创建setup类型的进度条

新建一个工程

增加一个picture box和command button

加入下面的代码：
Dim tenth As Long
'条件编译
#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)
'--------------------------------------------------------------------
' 更新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 运行,点击 Command1就可以看到效果.