打印本文 打印本文 关闭窗口 关闭窗口
VB编写一个能显示百分比的自定义进度条控件
作者:武汉SEO闵涛  文章来源:敏韬网  点击数658  更新时间:2009/4/23 16:37:35  文章录入:mintao  责任编辑:mintao

运行效果:

运行效果

设计方法:

1.在UserControl中添加一个Label控件Label1,将它设为平面,用来做外框。添加两个PictureBox控件PictureBox1做为进度指示,PictureBox2控件做为控件背景。

设计状态

2.加入以下代码

Option Explicit

''''定义私有变量用于存储属性值
Private mvarMax As Long
Private mvarMin As Long
Private mvarValue As Long

Private Rate As String

Private Sub UserControl_Initialize()
''''初始化
    Picture2.BackColor = vbBlue
End Sub

Public Property Get BackColor() As OLE_COLOR
''''读取BackColor属性
    BackColor = Picture1.BackColor
End Property

Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
''''设置BackColor属性
    Picture1.BackColor = vNewValue
End Property

Private Sub UserControl_InitProperties()
''''初始化属性
    Max = 100
    Min = 0
    Value = 0
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
''''读取从属性窗体中设置的属性值
    mvarMax = PropBag.ReadProperty("Max", 100)
    mvarMin = PropBag.ReadProperty("Min", 0)
    ''''Value属性值这里未提供,主要是模仿VB自带的进度条控件
    ''''mvarValue = PropBag.ReadProperty("Value", 0)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
''''保存从属性窗体中设置的属性值
    PropBag.WriteProperty "Max", mvarMax, 100
    PropBag.WriteProperty "Min", mvarMin, 0
    ''''PropBag.WriteProperty "Value", mvarValue, 0
End Sub

Private Sub UserControl_Resize()
''''Resize事件
    Label1.Move 0, 0, UserControl.Width / Screen.TwipsPerPixelX, UserControl.Height / Screen.TwipsPerPixelY
    Picture1.Move 1, 1, UserControl.Width / Screen.TwipsPerPixelX - 2, UserControl.Height / Screen.TwipsPerPixelY - 2
    Picture2.Move 1, 1, 1, UserControl.Height / Screen.TwipsPerPixelY - 2
End Sub

Public Property Get Max() As Long
''''读取Max属性
    Max = mvarMax
End Property

Public Property Let Max(ByVal vNewValue As Long)
''''设置Max属性
    mvarMax = vNewValue
    If vNewValue < Min Then Err.Raise "1001", , "Max必须大于Min"
End Property

Public Property Get Min() As Long
''''读取Min属性
    Min = mvarMin
End Property

Public Property Let Min(ByVal vNewValue As Long)
''''设置Min属性
    If vNewValue > Max Then Err.Raise "1000", , "Min必须小于Max"
    mvarMin = vNewValue
End Property

Public Property Get Value() As Long
''''读取Value属性
    Value = mvarValue
End Property

Public Property Let Value(ByVal vNewValue As Long)
''''设置Value属性
''''原理就是在两个PictureBox中以不同颜色打印百分比进度

Dim DX As Long, DY As Long

    If vNewValue > Max Then Err.Raise "1002", , "Value不能大于Max"
    mvarValue = vNewValue
   
    Picture2.Width = Value / (Max - Min) * (UserControl.Width / Screen.TwipsPerPixelX - 2)
    Rate = Int(Value / (Max - Min) * 100) & "%"
    DX = (Picture1.Width - Picture1.TextWidth(Rate)) / 2
    DY = (Picture1.Height - Picture1.TextHeight(Rate)) / 2
    Picture1.ForeColor = vbBlack
    Picture2.ForeColor = vbWhite
    If DX < Picture2.Width Then
        Picture2.Cls
        Picture2.CurrentX = DX
        Picture2.CurrentY = DY
        Picture2.Print Rate
    Else
        Picture1.Cls
        Picture1.CurrentX = DX
        Picture1.CurrentY = DY
        Picture1.Print Rate
    End If
End Property

3.新建另一个测试工程,加入一个自己的进度条控件和一个系统的进度条控件,加入以下代码:

Option Explicit

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Timer1_Timer()
    myProgressBar1.Value = myProgressBar1.Value + 2
    ProgressBar1.Value = ProgressBar1.Value + 2
    If myProgressBar1.Value = myProgressBar1.Max Then Timer1.Enabled = False
End Sub

OK.运行看看效果吧。

打印本文 打印本文 关闭窗口 关闭窗口