VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "彩色进度条"
ClientHeight = 3075
ClientLeft = 45
ClientTop = 435
ClientWidth = 6735
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3075
ScaleWidth = 6735
StartUpPosition = 2 'CenterScreen
Begin MSComctlLib.ProgressBar ProgressBar2
Height = 2055
Left = 240
TabIndex = 4
Top = 240
Width = 255
_ExtentX = 450
_ExtentY = 3625
_Version = 393216
Appearance = 0
Orientation = 1
End
Begin VB.CommandButton Command2
Caption = "开始"
Height = 375
Left = 240
TabIndex = 3
Top = 2400
Width = 1215
End
Begin VB.Timer Timer1
Interval = 50
Left = 5280
Top = 240
End
Begin VB.CommandButton Command1
Caption = "开始"
Height = 375
Left = 3360
TabIndex = 1
Top = 1440
Width = 1215
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 255
Left = 1320
TabIndex = 0
Top = 960
Width = 5175
_ExtentX = 9128
_ExtentY = 450
_Version = 393216
BorderStyle = 1
Appearance = 0
Scrolling = 1
End
Begin VB.Label Label1
Caption = "Label1"
Height = 375
Left = 720
TabIndex = 2
Top = 240
Width = 735
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'-------------------------------
'彩色进度条
'大家都知道VB里的 进度条颜色只有一种,不免有些单调.
'本例可以实现彩色的进度条,酷!
'作者:徐剑文
'广西机电职业技术学院
'QQ:64445322
'--------------------------------
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Const CCM_FIRST = &H2000
Const CCM_SETBKCOLOR = (CCM_FIRST + 1)
Const PBM_SETBKCOLOR = CCM_SETBKCOLOR
Const WM_USER = &H400
Const PBM_SETBARCOLOR = (WM_USER + 9)
Private Sub Command2_Click()
Timer1.Enabled = True
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
ProgressBar1.Value = 0
' Set the ProgressBar Barcolor with black color:
SendMessage ProgressBar1.hwnd, PBM_SETBARCOLOR, 0, ByVal QBColor(2) 'RGB(0, 255, 0)
SendMessage ProgressBar2.hwnd, PBM_SETBARCOLOR, 0, ByVal QBColor(2) 'RGB(0, 255, 100)
'Set the ProgressBar Backcolor with blue color:
SendMessage ProgressBar1.hwnd, PBM_SETBKCOLOR, 0, ByVal RGB(255, 0, 0)
SendMessage ProgressBar2.hwnd, PBM_SETBKCOLOR, 0, ByVal RGB(255, 100, 0)
End Sub
Private Sub Command1_Click()
Dim i As Integer
With ProgressBar1
.Min = 0
.Max = 10000
.Visible = True
For i = 0 To 10000
.Value = i
Next i
If .Value = .Max Then
.Visible = False
MsgBox "安装完毕!", vbInformation, "完毕"
Beep
End If
End With
End Sub
Private Sub Timer1_Timer()
Static Num As Integer
If Num = 0 Then Num = 1
Num = Num + 10
If Num <= 100 Then
ProgressBar2.Value = Num
Label1.Caption = Num & "%"
Else
ProgressBar2.Visible = False
Label1.Visible = False
MsgBox "安装完毕!", vbInformation + vbOKOnly, "完成"
Timer1.Enabled = False
End If
End Sub
