运行效果：

设计方法：

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

2.加入以下代码

Option Explicit

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

Private Rate As String

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

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

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

Private Sub UserControl_InitProperties()'初始化属性    Max = 100    Min = 0    Value = 0End 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, 0End 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 - 2End Sub

Public Property Get Max() As Long'读取Max属性    Max = mvarMaxEnd 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 = mvarMinEnd Property

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

Public Property Get Value() As Long'读取Value属性    Value = mvarValueEnd 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 IfEnd Property

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

Option Explicit

Private Sub Command1_Click()    Unload MeEnd Sub

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

OK.运行看看效果吧。