创建setup类型的进度条

　　新建一个工程

　　增加一个picture box和command button

加入下面的代码：Dim tenth As Long'条件编译#If Win32 ThenPrivate 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#ElsePrivate 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 IfSub 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 SubPrivate 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　　NextEnd SubPrivate Sub Form_Load()　　Picture1.FontBold = True　　Picture1.AutoRedraw = True　　Picture1.BackColor = vbWhite　　Picture1.DrawMode = 10　　Picture1.FillStyle = 0　　Picture1.ForeColor = vbBlueEnd Sub 

　　 F5 运行, 点击 Command1就可以看到效果.