A simple ascii progress bar

Question

I've been wanting to experiment with a bit of error handling and robustness to make my code more user friendly. I was inspired by this answer on UX to try and add a progress bar to a button - but was unable to find any simple text based progress bars out there, so I decided to write my own in that style. It boils down to a single class (which references a helper method in an addin: printf):

Class: AsciiProgressBar

Option Explicit
Private Type tProgressBar
 percentComplete As Double
 size As Long
 base As String
 bar As String
 character As String
 whitespace As String
 mask As String
End Type
Private Enum progressError
 percentOutOfBoundsError = vbObjectError + 513 'to get into custom error raising territory
 barSizeOutOfRangeError
 singleCharacterRequiredError
 baseIsNotAStringError
 maskMissingPositionalArgumentError
End Enum
Private Const DEFAULT_CHAR As String = "|"
Private Const DEFAULT_SIZE As Long = 10
Private Const DEFAULT_BASE As String = vbNullString
Private Const DEFAULT_WHITESPACE As String = " "
Private Const DEFAULT_MASK As String = "{0}{1}{2}%"
Private this As tProgressBar
Public Function Update(ByVal fractionComplete As Double) As String
 'check if valid input (0-100%)
 If fractionComplete < 0# Or fractionComplete > 1# Then raiseError percentOutOfBoundsError
 'set number of characters in progress bar
 this.percentComplete = fractionComplete
 Dim numberOfChars As Long
 numberOfChars = Round(this.size * this.percentComplete, 0)
 this.bar = String(numberOfChars, this.character) & String(this.size - numberOfChars, this.whitespace)
 Update = repr
End Function
Public Property Get repr() As String
 repr = printf(this.mask, this.base, this.bar, Round(this.percentComplete * 100, 0))
End Property
Private Sub raiseError(ByVal errNum As progressError, ParamArray args() As Variant)
 Select Case errNum
 Case percentOutOfBoundsError
 Err.Description = "Percent must lie between 0.0 and 1.0"
 Case barSizeOutOfRangeError
 Err.Description = printf("Bar size must be at least {0} characters", args(0))
 Case singleCharacterRequiredError
 Err.Description = printf("Only a single character should be used as {0}, not '{1}'", args(0), args(1))
 Case baseIsNotAStringError
 Err.Description = printf("Base must be of type string or left blank, not '{0}'", TypeName(args(0)))
 Case maskMissingPositionalArgumentError
 Err.Description = printf("formatMask must contain all three positional tokens ({0,1,2}){0}'{1}' does not", _
 vbCrLf, args(0))
 Case Else 'some errNum we don't know what to do with
 On Error Resume Next 'fake raise to grab description text
 Err.Raise errNum
 Dim errDescription As String
 errDescription = Err.Description
 On Error GoTo 0
Debug.Print printf("Warning: Unexpected error '{0}' with description '{1}'", errNum, errDescription)
 End Select
 Err.Raise errNum
End Sub
Public Sub Init(Optional ByVal size As Long = 0, Optional ByVal base As Variant, _
 Optional ByVal character As String = vbNullString, Optional ByVal whitespace As String = vbNullString, _
 Optional ByVal formatMask As String = vbNullString)
 'Method to set appearence and other properties of the progress bar
 'check if inputs were missing - if so leave as they were
 'Base can be any string so can't be checked in this way, needs special handling
 size = IIf(size = 0, this.size, size)
 character = IIf(character = vbNullString, this.character, character)
 whitespace = IIf(whitespace = vbNullString, this.whitespace, whitespace)
 formatMask = IIf(formatMask = vbNullString, this.mask, formatMask)
 'check for valid inputs
 Const minBarSize As Long = 2
 If size < minBarSize Then
 raiseError barSizeOutOfRangeError, minBarSize
 ElseIf Len(character) <> 1 Then
 raiseError singleCharacterRequiredError, "'character'", character
 ElseIf Len(whitespace) <> 1 Then
 raiseError singleCharacterRequiredError, "'whitespace'", whitespace
 ElseIf MaskIsInvalid(formatMask) Then
 raiseError maskMissingPositionalArgumentError, formatMask
 ElseIf Not IsMissing(base) Then
 'base is variant so requires type checking
 On Error Resume Next
 this.base = base 'may be type error if base can't be converted; e.g an object was passed
 Dim errNum As Long
 errNum = Err.Number
 On Error GoTo 0
 If errNum <> 0 Then
 raiseError baseIsNotAStringError, base
 End If
 End If
 'If we've got here then inputs are valid, so we can commit them
 this.size = size
 this.whitespace = whitespace
 this.character = character
 this.mask = formatMask
End Sub
Private Function MaskIsInvalid(ByVal mask As String) As Boolean
 'check whether any of the positional tokens don't appear in the mask
 Const matchPattern As String = "{0} {1} {2}"
 Dim tokens() As String
 tokens = Split(matchPattern)
 MaskIsInvalid = False
 Dim token As Variant
 For Each token In tokens
 MaskIsInvalid = Not CBool(InStr(mask, token))
 If MaskIsInvalid Then Exit Function
 Next
End Function
Private Sub Class_Initialize()
 ResetDefaults
 Update this.percentComplete
End Sub
Public Sub ResetDefaults()
 this.character = DEFAULT_CHAR
 this.base = DEFAULT_BASE
 this.whitespace = DEFAULT_WHITESPACE
 this.size = DEFAULT_SIZE
 this.mask = DEFAULT_MASK
End Sub
Public Function Create(Optional ByVal size As Long = 0, Optional ByVal base As Variant, _
 Optional ByVal character As String = vbNullString, Optional ByVal whitespace As String = vbNullString, _
 Optional ByVal formatMask As String = vbNullString) As AsciiProgressBar
 Dim result As New AsciiProgressBar
 result.Init size, base, character, whitespace, formatMask
 Set Create = result
End Function

Which references my addin

Public Function printf(ByVal mask As String, ParamArray tokens()) As String
'Format string with by substituting into mask - stackoverflow.com/a/17233834/6609896
 Dim i As Long
 For i = 0 To UBound(tokens)
 mask = Replace$(mask, "{" & i & "}", tokens(i))
 Next
 printf = mask
End Function

The class has a Create method as it is intended to be used in an addin (and pre-declared), i.e. the header looks like this:

VERSION 1.0 CLASS
BEGIN
 MultiUse = -1 'True
END
Attribute VB_Name = "AsciiProgressBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True

Feedback

I'd particularly like feedback on:

• Robustness of code (to user input)
• Ease of use
• Error raising
• Use of Init vs individual get/letters
• Code writing and formatting style
• Everything else :)

Rubberduck advises against overwriting variables passed ByVal - e.g in the Init method - why? Is it safe here?

Examples

The class can be used to supply content to userform text boxes, button captions, the Application.StatusBar, basically anywhere that displays strings; here are a couple of examples:

Using a worksheet button (ActiveX)

Best to use a monospaced font like Consolas

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private stillHeld As Boolean
Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 'start loading progress bar
 Const numberOfSteps As Long = 50
 Dim progress As AsciiProgressBar
 Set progress = AsciiProgressBar.Create(size:=20, base:="Loading: ")
 stillHeld = True
 Dim i As Long
 For i = 1 To numberOfSteps
 CommandButton1.Caption = progress.Update(i / numberOfSteps)
 If Not stillHeld Then Exit For
 DoEvents
 Sleep 20
 Next i
 If i > numberOfSteps Then
 CommandButton1.Caption = "Held on long enough"
 DoEvents
 Sleep 1000
 Else
 CommandButton1.Caption = "Let go too early"
 DoEvents
 Sleep 1000
 End If
 CommandButton1.Caption = "Hold down"
End Sub
Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 stillHeld = False
End Sub

Command button

Using Application.StatusBar

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub StatusBarProgress()
 Const runningTime As Single = 5000 'in milliseconds
 Const numberOfSteps As Long = 100
 With AsciiProgressBar.Create(base:="Loading: ", formatMask:="{0}{2}%{1}|")
 Dim i As Long
 For i = 1 To numberOfSteps
 .Update i / numberOfSteps
 Application.StatusBar = .repr
 'Or equivalently:
 'Application.StatusBar = .Update(i / numberOfSteps)
 Sleep runningTime / numberOfSteps
 DoEvents
 Next i
 End With
 Application.StatusBar = False
End Sub

StatusBar

NB actual operation is much smoother, the gif is just low quality

Answer 1

Rubberduck advises against overwriting variables passed ByVal - e.g in the Init method - why?

It's

• a) coding style; keeping the original value in the parameter is supposed to be cleaner code because you can spot all the places where the exact passed in value is used and know where it is not used (but instead a modified/derived/sanitized version of it) and
• b) assigning to a by-value parameter may be an error because the programmer intended the value to be seen by the caller, mistakenly thinking it was a ByRef. Your code is "safe" in this respect because you clearly do not assume the parameter is ByRef.

For best maintainability you should introduce new local variables for your input parameters' sanitized values, and make sure you only use those variables in the function and not accidentally use the original parameter at one place or another.

For my taste, a few more comments would be helpful. Those which are there are ok, though very brief. A rule of thumb: If it's not really obvious, why something is done in a program, explain the reason in a comment. Good example of a comment: 'fake raise to grab description text explains why we do a raise here.

In MaskIsInvalid, you don't need to use a pattern and Split to create the array of tokens. Just use tokens = Array("{0}","{1}","{2}").