Thread: Completion Bar Question
04-25-14, 14:26 #1Registered User
- Join Date
- Apr 2012
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.
04-25-14, 14:39 #2Jaded Developer
Provided Answers: 59
- Join Date
- Nov 2004
- out on a limb
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-8I'd rather be riding on the Tiger 800 or the Norton
04-25-14, 15:34 #3Registered User
- Join Date
- Apr 2012
Awesome that worked perfectly I appreciate the help healdem!
04-25-14, 17:00 #4Moderator
Provided Answers: 14
- Join Date
- Mar 2009
1. Create a new Class Module and paste this code into it:
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
3. Open the module of the form and paste the following code into it:
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
- You can change the color of the progress bar using (here for vbRed):
m_clsProgressBar.Color = vbRed ' or 255.
.TextControl = Me.Text_Control
m_clsProgressBar.Completion = value ' value must be between 0 and 100.
.DisplayValue = True
value = m_clsProgressBar.Completion ' value will be between 0 and 100.Have a nice day!