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

創建setup類型的進度條

編輯:VB綜合教程

  

  1. 新建一個工程

      

  2. 增加一個picture box和command button

      

  3. 加入下面的代碼:
    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 

      

  4.  F5 運行, 點擊 Command1就可以看到效果.

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