创建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就可以看到效果.