運(yùn)行效果：



設(shè)計(jì)方法：

1.在UserControl中添加一個(gè)Label控件Label1，將它設(shè)為平面，用來(lái)做外框。添加兩個(gè)PictureBox控件PictureBox1做為進(jìn)度指示，PictureBox2控件做為控件背景。



2.加入以下代碼

Option Explicit

'定義私有變量用于存儲(chǔ)屬性值
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)
'設(shè)置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)
'讀取從屬性窗體中設(shè)置的屬性值
mvarMax = PropBag.ReadProperty("Max", 100)
mvarMin = PropBag.ReadProperty("Min", 0)
'Value屬性值這里未提供，主要是模仿VB自帶的進(jìn)度條控件
'mvarValue = PropBag.ReadProperty("Value", 0)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
'保存從屬性窗體中設(shè)置的屬性值
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)
'設(shè)置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)
'設(shè)置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)
'設(shè)置Value屬性
'原理就是在兩個(gè)PictureBox中以不同顏色打印百分比進(jìn)度
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.新建另一個(gè)測(cè)試工程，加入一個(gè)自己的進(jìn)度條控件和一個(gè)系統(tǒng)的進(jìn)度條控件，加入以下代碼：

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.運(yùn)行看看效果吧。