运行效果：

设计方法：

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.运行看看效果吧。