程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> Visual Basic語言 >> VB6 >> 創建setup類型的進度條

創建setup類型的進度條

編輯:VB6

新建一個工程

增加一個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就可以看到效果.

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved