VB语言

本类阅读TOP10

·Visual Basic 安装程序的制作!!
·VB中使用EXCEL输出
·一个简单的MP3播放器
·VB程序实现WindowsXP效果的界面!!
·VB打造超酷个性化菜单(六)
·透明位图
·平铺与拉伸MDI窗口的背景图 ~!~
·对《VB程序实现WindowsXP效果的界面》一文的补遗
·从Windows资源管理器中拖动文件
·VB打造超酷个性化菜单(一)

分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
^^ 创建setup类型的进度条(vb6) ^^

作者:未知 来源:月光软件站 加入时间:2005-2-28 月光软件站

       ^^             创建setup类型的进度条(vb6)          ^^

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




相关文章

相关软件