自己编写vb进度条控件

简介: 自己编写vb进度条控件

image.png

主程序代码:

Option Explicit
Dim i As Double
Private Sub Command1_Click()
    i = 0
    Timer1.Interval = 50
    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

image.png

控件代码:

Option Explicit
Public Enum FigureStyle
    eOnlyValueInt
    eOnlyValueDouble
    ePercentInt
    ePercentDouble
End Enum
Private dblMyPercent As Double
Private lngMyValue As Long
Private isShowMsg As Boolean
Private strMsg As String
Private intMsgStyle As FigureStyle
Private Max As Long, Min As Long
Private Sub UserControl_Initialize()
    Min = 0
    Max = 100
'    lngMyValue = 30
    dblMyPercent = lngMyValue / (Max - Min)
    lblValue.Caption = Int(dblMyPercent * 100) & "/100"
    UserControl.Height = lblBase.Height
    intMsgStyle = ePercentInt
    Call setLabelSize
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) & "/100"
        Case ePercentDouble: strMsg = CStr(dblMyPercent * 100) & "/100"
    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) & "/100"
        Case ePercentDouble: strMsg = CStr(dblMyPercent * 100) & "/100"
    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
'msg style
Public Property Let MsgStyle(ByVal MsgStyle As FigureStyle)
    intMsgStyle = MsgStyle
    Select Case intMsgStyle
        Case eOnlyValueInt: strMsg = Int(dblMyPercent * 100)
        Case eOnlyValueDouble: strMsg = CStr(dblMyPercent * 100)
        Case ePercentInt: strMsg = Int(dblMyPercent * 100) & "/100"
        Case ePercentDouble: strMsg = CStr(dblMyPercent * 100) & "/100"
    End Select
    lblValue.Caption = strMsg
End Property
Public Property Get MsgStyle() As FigureStyle
    MsgStyle = intMsgStyle
End Property

以下为运行状态:

image.png

image.png

整个工程下载:GitHub - sysdzw/vbprocessbar: vb进度条控件

目录
相关文章
|
9月前
|
算法 API C++
【Qt UI】QT 窗口/控件置顶方法详解
【Qt UI】QT 窗口/控件置顶方法详解
656 0
|
9月前
Qt6自定义QML控件的方式
Qt6自定义QML控件的方式
212 1
|
9月前
|
数据安全/隐私保护 容器
[Qt5&控件] 控件stackedWidget、lineEdit等的用法
[Qt5&控件] 控件stackedWidget、lineEdit等的用法
145 0
[Qt5&控件] 控件stackedWidget、lineEdit等的用法
零基础VB教程063期:如何用代码直接创建控件?从此不必拖控件了
零基础VB教程063期:如何用代码直接创建控件?从此不必拖控件了
345 0
VB编程:代码实现窗体居中显示-59
VB编程:代码实现窗体居中显示-59
226 0
VB编程:利用控件数组设置控件状态-38
VB编程:利用控件数组设置控件状态-38
113 0
VB编程:代码实现窗体居中显示
VB编程:代码实现窗体居中显示
296 0
VB编程:代码实现窗体居中显示
VB编程:利用控件数组设置控件状态
VB编程:利用控件数组设置控件状态
124 0
VB编程:利用控件数组设置控件状态
|
API 数据安全/隐私保护
VB编程:无标题栏窗体移动和自定义鼠标样式
VB编程:无标题栏窗体移动和自定义鼠标样式
267 0
|
Shell 程序员
Qt编写自定义控件65-光晕日历
一、前言 操作系统的更新迭代速度非常快,基本上三五年就有个新版本出来,WIN10操作系统还是一个比较成功的系统,据说现在市场份额越来越大,XP的份额已经很小,WIN7的份额也在逐步减少,在最新的WIN10系统中,右下角有个日历控件,还是自带农历的,这个本地化做的蛮好的,鼠标移上去还有光晕背景效果,体验非常赏心悦目,于是打算用Qt也高仿一个。
1534 0