|
^^ 创建setup类型的进度条（vb6） ^^(1)
^^ 创建setup类型的进度条（VB6） ^^ - 新建一个工程
- 增加一个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 Thenprogress = 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 11Call UpdateStatus(tenth)x = TimerWhile Timer < x + 0.75DoEventsWend NextEnd SubPrivate Sub Form_Load() Picture1.FontBold = True Picture1.AutoRedraw = True Picture1.BackColor = vbWhite Picture1.DrawMode = 10 Picture1.FillStyle = 0 Picture1.ForeColor = vbBlueEnd Sub
|
