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

来源:互联网 发布:mac怎样取消开机密码 编辑:程序博客网 时间:2024/06/06 02:07
<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 728x15, 创建于 08-4-23MSDN */google_ad_slot = "3624277373";google_ad_width = 728;google_ad_height = 15;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>
<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 160x600, 创建于 08-4-23MSDN */google_ad_slot = "4367022601";google_ad_width = 160;google_ad_height = 600;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>

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

  1. 新建一个工程
  2. 增加一个picture box和command button
  3. 加入下面的代码: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 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 SubPrivate 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    NextEnd SubPrivate Sub Form_Load()    Picture1.FontBold = True    Picture1.AutoRedraw = True    Picture1.BackColor = vbWhite    Picture1.DrawMode = 10    Picture1.FillStyle = 0    Picture1.ForeColor = vbBlueEnd Sub 


  4.  F5 运行, 点击 Command1就可以看到效果.

<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 728x15, 创建于 08-4-23MSDN */google_ad_slot = "3624277373";google_ad_width = 728;google_ad_height = 15;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>
<script type="text/javascript"><!--google_ad_client = "pub-2947489232296736";/* 160x600, 创建于 08-4-23MSDN */google_ad_slot = "4367022601";google_ad_width = 160;google_ad_height = 600;//--></script><script type="text/javascript"src="http://pagead2.googlesyndication.com/pagead/show_ads.js"></script>
原创粉丝点击