主程序代码：
Option Explicit Dim i As Double Private Sub Command1_Click() i = 0 Timer1.Enabled = True End Sub Private Sub Timer1_Timer() i = i + 0.05 ProcessBar1.Percent = i If i > 1 Then Timer1.Enabled = False End Sub
控件代码：
Option Explicit Public Enum EFigureStyle eOnlyValueInt eOnlyValueDouble ePercentInt ePercentDouble End Enum Public Enum EAppearance eFlat e3D End Enum Private dblMyPercent As Double Private lngMyValue As Long Private isShowMsg As Boolean Private strMsg As String Private intMsgStyle As EFigureStyle Private Max As Long, Min As Long Const CPerCent = "%" '/100 Private Sub UserControl_Initialize() Min = 0 Max = 100 ' lngMyValue = 30 dblMyPercent = lngMyValue / (Max - Min) lblValue.Caption = Int(dblMyPercent * 100) & CPerCent UserControl.Height = lblBase.Height intMsgStyle = ePercentInt Call setLabelSize End Sub Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) MsgBox "aa" End Sub Private Sub UserControl_Resize() Call setLabelSize End Sub Private Sub setLabelSize() lblBase.Move 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight lblTop.Move lblBase.Left, lblBase.Top, dblMyPercent * lblBase.Width, lblBase.Height lblValue.Move lblBase.Left, (lblBase.Height - lblValue.Height) / 2 + 20, lblBase.Width End Sub 'set the value Public Property Let Value(ByVal Value As Long) If Value < Min Then lngMyValue = Min ElseIf Value > Max Then lngMyValue = Max Else lngMyValue = Value End If dblMyPercent = lngMyValue / (Max - Min) lblTop.Width = dblMyPercent * lblBase.Width Select Case intMsgStyle Case eOnlyValueInt: strMsg = Int(dblMyPercent * 100) Case eOnlyValueDouble: strMsg = CStr(dblMyPercent * 100) Case ePercentInt: strMsg = Int(dblMyPercent * 100) & CPerCent Case ePercentDouble: strMsg = CStr(dblMyPercent * 100) & CPerCent End Select lblValue.Caption = strMsg End Property ' Public Property Get Value() As Long Value = lngMyValue End Property 'set the percent Public Property Let Percent(ByVal Percent As Double) If Percent < 0 Then dblMyPercent = 0 ElseIf Percent > 1 Then dblMyPercent = 1 Else dblMyPercent = Percent End If lngMyValue = dblMyPercent * (Max - Min) lblTop.Width = dblMyPercent * lblBase.Width Select Case intMsgStyle Case eOnlyValueInt: strMsg = Int(dblMyPercent * 100) Case eOnlyValueDouble: strMsg = CStr(dblMyPercent * 100) Case ePercentInt: strMsg = Int(dblMyPercent * 100) & CPerCent Case ePercentDouble: strMsg = CStr(dblMyPercent * 100) & CPerCent End Select lblValue.Caption = strMsg End Property Public Property Get Percent() As Double Percent = dblMyPercent End Property 'is show msg Public Property Let ShowMsg(ByVal ShowMsg As Boolean) isShowMsg = ShowMsg lblValue.Visible = isShowMsg End Property Public Property Get ShowMsg() As Boolean ShowMsg = isShowMsg End Property 'set Appearance Public Property Let Appearance(ByVal Appearance As EAppearance) lblBase.Appearance = Appearance End Property 'get Appearance Public Property Get Appearance() As EAppearance Appearance = lblBase.Appearance End Property 'msg style Public Property Let MsgStyle(ByVal MsgStyle As EFigureStyle) intMsgStyle = MsgStyle Select Case intMsgStyle Case eOnlyValueInt: strMsg = Int(dblMyPercent * 100) Case eOnlyValueDouble: strMsg = CStr(dblMyPercent * 100) Case ePercentInt: strMsg = Int(dblMyPercent * 100) & CPerCent Case ePercentDouble: strMsg = CStr(dblMyPercent * 100) & CPerCent End Select lblValue.Caption = strMsg End Property Public Property Get MsgStyle() As EFigureStyle MsgStyle = intMsgStyle End Property
以下为运行状态：
整个工程下载：http://download.csdn.net/source/1725895
