初学者自制进度条控件ProgressBar.OCX，请大家多指教

控件的测试如下图：

 

下载地址：

http://download.csdn.net/source/540968

源代码如下：

Option Explicit
Private b_Value As Integer
Private b_BackColor As OLE_COLOR
Private b_ForeColor As OLE_COLOR
Private b_BorderStyle As Integer
Private b_FontSize As Integer
Private b_MaxValue As Integer
Private b_MinValue As Integer

Const b_def_Value = 0
Const b_def_BackColor = vbWhite
Const b_def_ForeColor = vbBlue
Const b_def_BorderStyle = 1
Const b_def_FontSize = 12
Const b_def_MaxValue = 100
Const b_def_MinValue = 0

Public Enum BarBorderStyles
    [None] = 0
    [Fixed] = 1
End Enum

Event Click()
Event DblClick()

Private Sub UserControl_Initialize()
   
    UserControl.Height = 260
    UserControl.Width = 1500
    Picture1.Height = UserControl.Height
    Picture1.Width = UserControl.Width
    Shape1.Height = Picture1.Height
    Shape1.Width = 0

    Label2.Caption = ""
    Label3.Caption = ""
   
    b_Value = b_def_Value
    b_BackColor = b_def_BackColor
    b_ForeColor = b_def_ForeColor
    b_BorderStyle = b_def_BorderStyle
    b_FontSize = b_def_FontSize
    b_MaxValue = b_def_MaxValue
    b_MinValue = b_def_MinValue
    Refresh
   
End Sub

Private Sub UserControl_InitProperties()
    b_Value = b_def_Value
    b_BackColor = b_def_BackColor
    b_ForeColor = b_def_ForeColor
    b_BorderStyle = b_def_BorderStyle
    b_FontSize = b_def_FontSize
    b_MaxValue = b_def_MaxValue
    b_MinValue = b_def_MinValue
    Refresh
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    b_Value = PropBag.ReadProperty("Value", b_def_Value)
    b_BackColor = PropBag.ReadProperty("BackColor", b_def_BackColor)
    b_ForeColor = PropBag.ReadProperty("ForeColor", b_def_ForeColor)
    b_BorderStyle = PropBag.ReadProperty("BorderStyle", b_def_BorderStyle)
    b_FontSize = PropBag.ReadProperty("FontSize", b_def_FontSize)
    b_MaxValue = PropBag.ReadProperty("MaxValue", b_def_MaxValue)
    b_MinValue = PropBag.ReadProperty("Minvalue", b_def_MinValue)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Value", b_Value, b_def_Value)
    Call PropBag.WriteProperty("BackColor", b_BackColor, b_def_BackColor)
    Call PropBag.WriteProperty("ForeColor", b_ForeColor, b_def_ForeColor)
    Call PropBag.WriteProperty("BorderStyle", b_BorderStyle, b_def_BorderStyle)
    Call PropBag.WriteProperty("FontSize", b_FontSize, b_def_FontSize)
    Call PropBag.WriteProperty("MaxValue", b_MaxValue, b_def_MaxValue)
    Call PropBag.WriteProperty("MinValue", b_MinValue, b_def_MinValue)
End Sub

Private Sub UserControl_Resize()
    Picture1.Height = UserControl.Height
    Picture1.Width = UserControl.Width
    Shape1.Height = Picture1.Height + 15
    Label1.Top = (Picture1.Height - Label1.Height) / 2
    Label2.Top = (Picture1.Height - Label1.Height) / 2
    Label3.Top = (Picture1.Height - Label1.Height) / 2
    Label4.Top = (Picture1.Height - Label1.Height) / 2
    setPos
End Sub

Public Property Get Value() As Integer
    Value = b_Value
End Property

Public Property Let Value(ByVal bValue As Integer)
    If bValue < 0 Or bValue > 100 Or b_Value = bValue Then Exit Property
    b_Value = bValue
    PropertyChanged "Value"
    Refresh
End Property

Public Property Get BorderStyle() As BarBorderStyles
    BorderStyle = b_BorderStyle
End Property

Public Property Let BorderStyle(ByVal bStyle As BarBorderStyles)
    If bStyle <> b_BorderStyle Then
        b_BorderStyle = bStyle
    End If
    PropertyChanged "BorderStyle"
    Refresh
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = b_BackColor
End Property

Public Property Let BackColor(ByVal NewColor As OLE_COLOR)
    If b_BackColor <> NewColor Then
        b_BackColor = NewColor
    End If
    PropertyChanged "BackColor"
    Refresh
End Property

Public Property Get ForeColor() As OLE_COLOR
    ForeColor = b_ForeColor
End Property

Public Property Let ForeColor(ByVal NewColor As OLE_COLOR)
    If b_ForeColor <> NewColor Then
        b_ForeColor = NewColor
    End If
    PropertyChanged "ForeColor"
    Refresh
End Property

Public Property Get FontSize() As Integer
    FontSize = b_FontSize
End Property

Public Property Let FontSize(ByVal NewFontSize As Integer)
    If NewFontSize < 6 Then Exit Property
    b_FontSize = NewFontSize
    PropertyChanged "FontSize"
    Refresh
End Property

Public Property Get MaxValue() As Integer
    MaxValue = b_MaxValue
End Property

Public Property Let MaxValue(ByVal NewMaxValue As Integer)
    If NewMaxValue > b_MinValue Then
        b_MaxValue = NewMaxValue
        PropertyChanged "MaxValue"
        Refresh
    End If
End Property

Public Property Get MinValue() As Integer
    MinValue = b_MinValue
End Property

Public Property Let MinValue(ByVal NewMinValue As Integer)
    If NewMinValue >= 0 And NewMinValue < b_MaxValue Then
        b_MinValue = NewMinValue
        PropertyChanged "MinValue"
        Refresh
    End If
End Property

Public Sub Refresh()
    Picture1.BorderStyle = b_BorderStyle
    Picture1.BackColor = b_BackColor
    Shape1.FillColor = b_ForeColor
    Label1.FontSize = b_FontSize
    Label2.FontSize = b_FontSize
    Label3.FontSize = b_FontSize
    Label4.FontSize = b_FontSize
    setPos
End Sub

Private Sub setPos()
On Error Resume Next

    Shape1.Width = b_Value * Picture1.Width / (b_MaxValue - b_MinValue)
    Dim Svalue As String
    Svalue = Str(Int(b_Value * 100 / (b_MaxValue - b_MinValue)))
   
    If Val(Svalue) < 10 Then
        Label4.Left = Picture1.Width / 2
        Label1.Left = Label4.Left - Label1.Width
    ElseIf Val(Svalue) < 100 Then
        Label1.Left = (Picture1.Width - Label1.Width) / 2
        Label4.Left = Label1.Left + Label1.Width
        Label2.Left = Label1.Left - Label2.Width
    Else
        Label1.Left = Picture1.Width / 2
        Label4.Left = Label1.Left + Label1.Width
        Label2.Left = Label1.Left - Label2.Width
        Label3.Left = Label2.Left - Label3.Width
    End If
   
    Label1.Top = (Picture1.Height - Label1.Height) / 2
    Label2.Top = (Picture1.Height - Label1.Height) / 2
    Label3.Top = (Picture1.Height - Label1.Height) / 2
    Label4.Top = (Picture1.Height - Label1.Height) / 2
   
    Label1.Caption = Right(Svalue, 1)
    Svalue = Left(Svalue, Len(Svalue) - 1)
    Label2.Caption = Right(Svalue, 1)
    If Len(Svalue) > 2 Then
        Label3.Caption = 1
    Else
        Label3.Caption = ""
    End If
       
    If Shape1.Width > Label1.Left + Label1.Width / 2 Then Label1.ForeColor = vbWhite Else Label1.ForeColor = vbBlack
    If Shape1.Width > Label2.Left + Label2.Width / 2 Then Label2.ForeColor = vbWhite Else Label2.ForeColor = vbBlack
    If Shape1.Width > Label3.Left + Label3.Width / 2 Then Label3.ForeColor = vbWhite Else Label3.ForeColor = vbBlack
    If Shape1.Width > Label4.Left + Label4.Width / 2 Then Label4.ForeColor = vbWhite Else Label4.ForeColor = vbBlack

End Sub

Private Sub Picture1_Click()
RaiseEvent Click
End Sub

Private Sub Picture1_DblClick()
RaiseEvent DblClick
End Sub

我是控件初学者，有不合理的地方敬请大家多多指教，共同探讨！