设计方法： 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,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,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.运行看看效果吧。
