创建setup类型的进度条

会计考友

　　新建一个工程
, t) N. R2 N- C- P9 I2 a3 q( h( R　　增加一个picture box和command button
　　加入下面的代码：
8 H+ B: q2 A, \1 v/ a  t% d( B　　Dim tenth As Long
　　'条件编译
　　#If Win32 Then
4 ~5 b# }* [5 p8 E1 D0 ]/ `& g  g  `　　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 _
& u, Q  ?1 R+ d) O+ `3 h" \　　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 _
2 m: g" X+ W$ A' A) {  K. c( g: Z　　Long) As Integer
　　#End If
　　Sub UpdateStatus(FileBytes As Long)
　　'--------------------------------------------------------------------
　　' 更新Picture1 status bar
. @2 C0 k; t! E/ w　　'--------------------------------------------------------------------
　　Static progress As Long
　　Dim r As Long
# |+ `. a) R; l  g7 n: f$ C　　Const SRCCOPY = &HCC0020
7 f& Y3 j% n+ x- o. f) N　　Dim Txt$
　　progress = progress + FileBytes
  o9 ?1 V6 ]1 ^9 |3 P　　If progress > Picture1.ScaleWidth Then
0 w& B; q9 l: _5 u　　progress = Picture1.ScaleWidth
　　End If
　　Txt$ = Format$(CLng((progress / Picture1.ScaleWidth) * 100)) + "%"
3 Z" H3 W/ R; O5 a- K! f6 H$ p　　Picture1.Cls
　　Picture1.CurrentX = _
　　(Picture1.ScaleWidth - Picture1.TextWidth(Txt$)) \ 2
　　Picture1.CurrentY = _
　　(Picture1.ScaleHeight - Picture1.TextHeight(Txt$)) \ 2
　　Picture1.Print Txt$
% j9 I0 |8 V2 h2 `　　Picture1.Line (0, 0)-(progress, Picture1.ScaleHeight), _
　　Picture1.ForeColor, BF
　　r = BitBlt(Picture1.hDC, 0, 0, Picture1.ScaleWidth, _
/ B$ O  @+ A1 r7 A* k" E　　Picture1.ScaleHeight, Picture1.hDC, 0, 0, SRCCOPY)
  I5 n9 k' n5 G1 d' n( B　　End Sub
　　Private Sub Command1_Click()
　　Picture1.ScaleWidth = 109
1 k& D+ M1 i7 {0 s, y3 i　　tenth = 10
　　For i = 1 To 11
　　Call UpdateStatus(tenth)
: E5 n% J' e2 {6 B9 P. ^* l# z0 P　　x = Timer
　　While Timer < x + 0.75
　　DoEvents
  E' b1 o8 b: r9 b; H2 Q6 y4 y* I6 W　　Wend
2 ~5 M% T$ t4 J2 h* C/ f7 g% d5 ^　　Next
$ m0 N2 p$ D& O% y% p　　End Sub
　　Private Sub Form_Load()
+ P5 E3 w. @8 X! i, b/ y/ s5 t3 f　　Picture1.FontBold = True
* z( p3 T3 ^1 q; U- F  q0 M　　Picture1.AutoRedraw = True
1 ?$ `7 n5 W; n$ z/ l* Y$ E8 m　　Picture1.BackColor = vbWhite
' J1 {, p4 z' i8 a: |6 m　　Picture1.DrawMode = 10
　　Picture1.FillStyle = 0
4 }/ S/ ~( }+ s6 K9 p　　Picture1.ForeColor = vbBlue
" @$ c" t$ e: _　　End Sub
　　F5 运行, 点击 Command1就可以看到效果.