Results 1 to 4 of 4
  1. #1
    Join Date
    Apr 2012
    Posts
    22

    Unanswered: Completion Bar Question

    I am trying to make something like the Thermometer Goal that most companies make. So we have $500 so far and we have a goal of $1000. Is there a way to show this progress through a Text Box and have the Text Box be 50% full? And then when we get $600 it shows as 60% full? I have been looking at Progress Bars, but I don't want this based off a Timer Interval like I have seen. I just want something that could display in something like a Text Box and fill it with color to how far along we are to our goal.

    Any help would be greatly appreciated.

    Thank you!

  2. #2
    Join Date
    Nov 2004
    Location
    out on a limb
    Posts
    13,692
    Provided Answers: 59
    yup
    as ever in life you can fake it.

    have two simple box controls, one (the background say in white) and fills the entire linear length. the other has a different background/fill colour, the same location (top and left), then adjust the the width of the fore ground box as a proportion of whats required

    so lets assume we have two controls b1 and b2, b1 is the background control and remains the same size
    the range is maxRange
    the value is Currentvalue
    b2.width = b1.width *(currentvalue/maxrange)

    if you want to be fancier you can add a text box that is centred
    Calculate Width of text - Microsoft Access / VBA

    if you want to have two colours then tinker about with the colour of the foreground control (b2 in the above suggestion)

    or write a control (not for the faint hearted)
    https://www.google.co.uk/search?q=vb...m=122&ie=UTF-8
    I'd rather be riding on the Tiger 800 or the Norton

  3. #3
    Join Date
    Apr 2012
    Posts
    22
    Awesome that worked perfectly I appreciate the help healdem!

  4. #4
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    1. Create a new Class Module and paste this code into it:
    Code:
    Option Explicit
    
    Private WithEvents m_txtControl As TextBox
    Private m_TxtProgress As TextBox
    Private m_Color As Long
    Private m_Completion As Integer
    Private m_lngUnit As Long
    Private m_lngMaxWidth As Long
    Private booDisplayValue As Boolean
    
    Public Sub Initialize(ByVal TextProgress As TextBox, ByVal FrameProgress As Rectangle)
    
        Set m_TxtProgress = TextProgress
        FrameProgress.BackStyle = 0
        With m_TxtProgress
            .Top = FrameProgress.Top + 10
            .Height = FrameProgress.Height - 20
            .Left = FrameProgress.Left + 10
            .Width = 0
            .BackColor = m_Color
            .BackStyle = 1
            .BorderStyle = 0
            .Visible = True
            .SpecialEffect = 0
            m_lngMaxWidth = FrameProgress.Width - 20
            m_lngUnit = m_lngMaxWidth / 100
        End With
        
    End Sub
    
    Public Property Let Color(ByVal Value As Long)
    
        m_Color = Value
        
    End Property
    
    Public Property Get Completion() As Integer
    
        m_Completion = Completion
        
    End Property
    
    Public Property Let Completion(ByVal Value As Integer)
    
        If Completion >= 0 And Completion <= 100 Then
            m_Completion = Value
            If Value = 100 Then
                m_TxtProgress.Width = m_lngMaxWidth
            Else
                m_TxtProgress.Width = Value * m_lngUnit
            End If
            If booDisplayValue = True Then m_TxtProgress.Value = Value & "%"
            If Not m_txtControl Is Nothing Then m_txtControl.Value = Value
        Else
            MsgBox "Value must be beween 0 and 100", vbInformation
        End If
        
    End Property
    
    Public Property Let DisplayValue(Value As Boolean)
    
        booDisplayValue = Value
        If Value = True Then m_TxtProgress.TextAlign = IIf(Value = True, 2, 0)
        
    End Property
    
    Public Property Let TextControl(ByVal ctl As TextBox)
    
        Set m_txtControl = ctl
        With ctl
            .AfterUpdate = "[Event Procedure]"
            .ValidationRule = ">=0 And <=100"
            .ValidationText = "Value must be beween 0 and 100"
        End With
        
    End Property
    
    Private Sub m_txtControl_AfterUpdate()
    
        Me.Completion = m_txtControl.Value
        
    End Sub
    
    Private Sub Class_Initialize()
    
        m_Color = 5220351  ' light orange
        
    End Sub
    2. Create a form. In this form create 1 Textbox: Text_Progress, 1 Textbox: Text_Control and 1 rectangle box Box_Progress.

    3. Open the module of the form and paste the following code into it:
    Code:
    Option Explicit
    
    Private m_clsProgressBar As Cls_ProgressBar
    
    Private Sub Form_Open(Cancel As Integer)
    
        Set m_clsProgressBar = New Cls_ProgressBar
        With m_clsProgressBar
            .Initialize Me.Text_Progress, Me.Box_Progress
            .TextControl = Me.Text_Control
            .DisplayValue = True
        End With
        
    End Sub
    4. Open the form in form view. When you type a number beteen 0 and 100 in the textbox Text_Control, a progress bar inside the rectangle box Box_Progress adapts itself to the typed number.

    Notes:
    - You can change the color of the progress bar using (here for vbRed):
    Code:
    m_clsProgressBar.Color = vbRed ' or 255.
    - If you want to control the progress bar from code instead of controling it through a textbox, remove (or comment) the line:
    Code:
            .TextControl = Me.Text_Control
    You can control the progress bar from anywhere in the form module using:
    Code:
    m_clsProgressBar.Completion = value ' value must be between 0 and 100.
    - If you do not want the progress bar to display the value of the progress, remove (or comment) the line:
    Code:
            .DisplayValue = True
    - You can retrieve the value of the progress bar using:
    Code:
    value = m_clsProgressBar.Completion  ' value will be between 0 and 100.
    Have a nice day!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •