Create a progress bar for the setup type

Source: Internet
Author: User
Tags integer

Create a new project

Add a picture box and command button

Add the following code:
Dim Tenth as Long
' Conditional compilation
#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
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)
' Update 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.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
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 Run, click Command1 to see the effect.

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.