Reusable Progress Indicator

Question

As many have done on this site, I decided to create a progress indicator using a modeless Userform. However, my goal was to make said progress indicator as generic/reusable as possible.

While doing some research, I stumbled upon @MathieuGuindon's post titled The Reusable Progress Indicator. I quite liked his ideas, so I definitely borrowed a few of them, but instead of writing a predeclared class to interact with the form, I choose to create an interface to expose the Progress Indicator's methods to the client code.

The issue I have currently, is the default instance, (albeit useless without being written against the interface), troubles me, but I fear there is no way around it. Also I am looking for general feedback on my code structure, quality, efficiency, and other improvements that could be made.

Note: I have only been developing in VBA for just over a year. That being said I am on Stack Overflow quite a bit and I am always seeing and learning from, @MathieuGuindon's code, so naturally my coding style has begun to mirror his.

IProgressIndicator (Interface):

Option Explicit

Public Sub UpdateOrphanProgress(ByRef ProgStatusText As Variant, _
                                ByRef CurrProgCnt As Long, _
                                ByRef TotalProgCnt As Long): End Sub

Public Sub UpdateParentChildProgress(ByRef ParentProgStatusText As Variant, _
                                     ByRef ParentCurrCnt As Long, _
                                     ByRef ParentTotalCnt As Long, _
                                     ByRef ChildProgStatusText As Variant, _
                                     ByRef ChildCurrProgCnt As Long, _
                                     ByRef ChildProgCnt As Long, _
                                     ByRef TotalProgCnt As Long): End Sub


Public Sub LoadProgIndicator(Optional ByVal HasParentProccess As Boolean, _
                             Optional ByVal CanCancel As Boolean, _
                             Optional ByVal CalculateExecutionTime As Boolean): End Sub

Public Property Get ShouldCancel() As Boolean: End Property

ProgressIndicator Class (Userfrm):

Option Explicit

Implements IProgressIndicator

#If VBA7 Then
    Private Declare PtrSafe Function GetWindowLong _
                           Lib "user32" Alias "GetWindowLongA" ( _
                           ByVal hwnd As LongPtr, _
                           ByVal nIndex As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetWindowLong _
                           Lib "user32" Alias "SetWindowLongA" ( _
                           ByVal hwnd As LongPtr, _
                           ByVal nIndex As LongPtr, _
                           ByVal dwNewLong As LongPtr) As LongPtr

    Private Declare PtrSafe Function DrawMenuBar _
                           Lib "user32" ( _
                           ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function FindWindowA _
                           Lib "user32" (ByVal lpClassName As String, _
                           ByVal lpWindowName As String) As LongPtr

    Private Declare PtrSafe Function GetTickCount _
                            Lib "kernel32.dll" () As LongPtr

#Else
    Private Declare Function GetWindowLong _
                           Lib "user32" Alias "GetWindowLongA" ( _
                           ByVal hwnd As Long, _
                           ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong _
                           Lib "user32" Alias "SetWindowLongA" ( _
                           ByVal hwnd As Long, _
                           ByVal nIndex As Long, _
                           ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar _
                           Lib "user32" ( _
                           ByVal hwnd As Long) As Long
    Private Declare Function FindWindowA _
                           Lib "user32" (ByVal lpClassName As String, _
                           ByVal lpWindowName As String) As Long

    Private Declare Function GetTickCount _
                    Lib "kernel32.dll" () As Long
#End If

Private Const GWL_STYLE = -16
Private Const WS_CAPTION = &HC00000

Private Const PROGINDICATOR_MAXHEIGHT As Integer = 142.75
Private Const PARENTPROCSTATUS_MAXHEIGHT As Integer = 10
Private Const PROCSTATUS_MAXTOP As Integer = 16
Private Const PROGRESSBAR_MAXTOP As Integer = 41
Private Const PROGRESSBAR_MAXWIDTH As Integer = 270
Private Const ELAPSEDTIME_MAXTOP As Integer = 83
Private Const TIMEREMAINING_MAXTOP As Integer = 94

Private Const STARTPOS_LEFT_OFFSET As Single = 0.5
Private Const STARTPOS_RIGHT_OFFSET As Single = 0.5

Private Const ERR_ORPHANPROC_NOPARENT As String = "You specified that this proccess has a parent, " & _
                                                  "but you are using the 'UpdateOrphanProgress' method"
Private Const ERR_HASPARENT_NOTSPECIFIED As String = "You specified that this proccess does not have a parent, " & _
                                                     "but you are using the 'UpdateParentChildProgress' method."
Private Const ERR_INVALIDPROGPERCENT As String = "Either the CurrProgCnt equals 0, is greater than 0, or it " & _
                                                  "is greater than TotalProgCnt."
Private Const ERR_INVALIDPARENTCOUNT As String = "Either the ParentCurrCnt equals 0, is greater than 0, or it " & _
                                                  "is greater than ParentTotalCnt."

Public Enum ProgressIndicatorError    
    Error_OrphanProcHasParent = vbObjectError + 1001
    Error_HasParentProcNotSpecified
    Error_InvalidProgressPercentage
    Error_InvalidParentCount
End Enum

Private Type TProgressIndicator
    StartTime As Double
    TimeElapsed As Double
    SecondsElapsed As Double
    MinutesElapsed As Double
    HoursElapsed As Double
    SecondsRemaining As Double
    MinutesRemaining As Double
    HoursRemaining As Double
    ItemsRemaining As Double
    ParentChildIterationCount As Long
    HasParentProccess As Boolean
    CanCancel As Boolean
    Cancelling As Boolean
    CalculateExecutionTime As Boolean
    PercentComplete As Double
End Type

Private this As TProgressIndicator

'*****************************************************************************
'Properties
'*****************************************************************************
Private Property Get HasParentProccess() As Boolean
    HasParentProccess = this.HasParentProccess
End Property

Private Property Get Cancellable() As Boolean
    Cancellable = this.CanCancel
End Property

Private Property Get IsCancelRequested() As Boolean
    IsCancelRequested = this.Cancelling
End Property

Private Property Get CalculateExecutionTime() As Boolean
    CalculateExecutionTime = this.CalculateExecutionTime
End Property

'*****************************************************************************
'Methods
    '*****************************************************************************    
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
        Cancel = True
        If Cancellable Then this.Cancelling = True
    End If
End Sub

Private Property Get IProgressIndicator_ShouldCancel() As Boolean
    If IsCancelRequested Then
        If MsgBox("Would you like to Cancel this operation?", _
                  vbQuestion + vbYesNo, "Process Dialog") = vbYes Then
            IProgressIndicator_ShouldCancel = True
            Me.Hide
        Else
            this.Cancelling = False
        End If
    End If
End Property

Private Sub IProgressIndicator_LoadProgIndicator(Optional ByVal HasParentProccess As Boolean, _
                                                 Optional ByVal CanCancel As Boolean, _
                                                 Optional ByVal CalculateExecutionTime As Boolean)

    this.CalculateExecutionTime = CalculateExecutionTime

    If CalculateExecutionTime Then this.StartTime = GetTickCount()

    HideTitleBar

    this.HasParentProccess = HasParentProccess: this.CanCancel = CanCancel

    With Me
        If this.HasParentProccess Then
            .Height = PROGINDICATOR_MAXHEIGHT
            .ParentProcedureStatus.Height = PARENTPROCSTATUS_MAXHEIGHT
            .ProcedureStatus.Top = PROCSTATUS_MAXTOP
            .frameProgressBar.Top = PROGRESSBAR_MAXTOP

            .lblElapsedTime.Top = ELAPSEDTIME_MAXTOP
            .ElapsedTime.Top = ELAPSEDTIME_MAXTOP

            .lblTimeRemaining.Top = TIMEREMAINING_MAXTOP
            .TimeRemaining.Top = TIMEREMAINING_MAXTOP
        End If
        .ProgressBar.Width = 0
        .StartUpPosition = 0
        .Left = Application.Left + (STARTPOS_LEFT_OFFSET * Application.Width) - (STARTPOS_LEFT_OFFSET * .Width)
        .Top = Application.Top + (STARTPOS_RIGHT_OFFSET * Application.Height) - (STARTPOS_RIGHT_OFFSET * .Height)
        .Show
    End With

End Sub

Private Sub HideTitleBar()

 Dim lngWindow As Long, lngFrmHdl As Long

    lngFrmHdl = FindWindowA(vbNullString, Me.Caption)
    lngWindow = GetWindowLong(lngFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lngFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lngFrmHdl)

End Sub

Private Sub IProgressIndicator_UpdateOrphanProgress(ByRef ProgStatusText As Variant, _
                                                    ByRef CurrProgCnt As Long, _
                                                    ByRef TotalProgCnt As Long)

        ThrowIfOrphanProcHasParent

        ThrowIfInvalidProgPercent CurrProgCnt, TotalProgCnt

        this.PercentComplete = CurrProgCnt / TotalProgCnt

            With Me
                .ProcedureStatus.Caption = ProgStatusText & " " & _
                                      CurrProgCnt & " of " & TotalProgCnt

                .ProgressBar.Width = this.PercentComplete * PROGRESSBAR_MAXWIDTH
            End With

        If CalculateExecutionTime Then CalculateTime CurrProgCnt, TotalProgCnt

        DoEvents

        If CurrProgCnt = TotalProgCnt Then Me.Hide 'Unload Me ??

End Sub


Private Sub IProgressIndicator_UpdateParentChildProgress(ByRef ParentProgStatusText As Variant, _
                                                         ByRef ParentCurrCnt As Long, _
                                                         ByRef ParentTotalCnt As Long, _
                                                         ByRef ChildProgStatusText As Variant, _
                                                         ByRef ChildCurrProgCnt As Long, _
                                                         ByRef ChildProgCnt As Long, _
                                                         ByRef TotalProgCnt As Long)

        ThrowIfHasParentNotSpecified

        ThrowIfInvalidParentCount ParentCurrCnt, ParentTotalCnt

        ThrowIfInvalidProgPercent ChildCurrProgCnt, ChildProgCnt

        this.ParentChildIterationCount = this.ParentChildIterationCount + 1

        this.PercentComplete = ChildCurrProgCnt / ChildProgCnt

            With Me
                .ParentProcedureStatus.Caption = ParentProgStatusText & " " & _
                                                 ParentCurrCnt & " of " & ParentTotalCnt

                .ProcedureStatus.Caption = ChildProgStatusText & " " & _
                                           ChildCurrProgCnt & " of " & ChildProgCnt

                .ProgressBar.Width = this.PercentComplete * PROGRESSBAR_MAXWIDTH
            End With

        If CalculateExecutionTime Then CalculateTime this.ParentChildIterationCount, TotalProgCnt

        DoEvents

        If ParentCurrCnt = ParentTotalCnt Then
           If ChildCurrProgCnt = ChildProgCnt Then Me.Hide 'Unload Me ??
        End If

End Sub

'*****************************************************************************
'Time Calulations
'*****************************************************************************
Private Sub CalculateTime(ByRef CurrProgCntIn As Long, ByRef TotalProgCntIn As Long)

    With this
        If CurrProgCntIn = TotalProgCntIn Then

            Me.ElapsedTime.Caption = "" & .HoursElapsed & " hours, " & _
                                     .MinutesElapsed & " minutes, " & .SecondsElapsed & " seconds"

            Me.TimeRemaining.Caption = "" & 0 & " hours, " & 0 & _
                                       " minutes, " & 0 & " seconds"
        Else
            .TimeElapsed = (GetTickCount() - this.StartTime)

            .SecondsElapsed = .TimeElapsed / 1000
            .MinutesElapsed = RoundTime(.TimeElapsed, 60000)
            .HoursElapsed = RoundTime(.TimeElapsed, 3600000)

            .ItemsRemaining = TotalProgCntIn - CurrProgCntIn

            .SecondsRemaining = (.SecondsElapsed * (TotalProgCntIn / CurrProgCntIn)) - .SecondsElapsed
            .MinutesElapsed = RoundTime(.SecondsRemaining, 60)
            .HoursElapsed = RoundTime(.SecondsRemaining, 60)

            Me.ElapsedTime.Caption = "" & .HoursElapsed & " hours, " & _
                                     .MinutesElapsed & " minutes, " & .SecondsElapsed & " seconds"

            Me.TimeRemaining.Caption = "" & .HoursRemaining & " hours, " & .MinutesRemaining & _
                                       " minutes, " & .SecondsRemaining & " seconds"
        End If
    End With

End Sub

Private Function RoundTime(ByRef TimeElapsedIn As Double, ByVal IntervalIn As Long) As Double
    RoundTime = Int(TimeElapsedIn / IntervalIn)
End Function

'*****************************************************************************
'Error Checking Procedures
'*****************************************************************************
Private Sub ThrowIfOrphanProcHasParent()
    If HasParentProccess Then
        Beep
        Err.Raise ProgressIndicatorError.Error_OrphanProcHasParent, _
                  TypeName(Me), ERR_ORPHANPROC_NOPARENT
    End If
End Sub

Private Sub ThrowIfHasParentNotSpecified()
    If Not HasParentProccess Then
        Beep
        Err.Raise ProgressIndicatorError.Error_HasParentProcNotSpecified, _
                  TypeName(Me), ERR_HASPARENT_NOTSPECIFIED
    End If
End Sub

Private Sub ThrowIfInvalidProgPercent(ByRef CurrProgCntIn As Long, ByRef TotalProgCntIn As Long)
    If Not (CurrProgCntIn > 0 And CurrProgCntIn <= TotalProgCntIn) Then
        Beep
        Err.Raise ProgressIndicatorError.Error_InvalidProgressPercentage, _
                  TypeName(Me), ERR_INVALIDPROGPERCENT
    End If
End Sub

Private Sub ThrowIfInvalidParentCount(ByRef ParentCurrCntIn As Long, ByRef ParentTotalCntIn As Long)
    If Not (ParentCurrCntIn > 0 And ParentCurrCntIn <= ParentTotalCntIn) Then
        Beep
        Err.Raise ProgressIndicatorError.Error_InvalidParentCount, _
                  TypeName(Me), ERR_INVALIDPARENTCOUNT
    End If
End Sub

Tests:

Public Sub TestingOrphanProccess()

 Dim i As Long
 Dim ProgressBar As IProgressIndicator

    On Error GoTo ErrHandle
    Set ProgressBar = New ProgressIndicator

    ProgressBar.LoadProgIndicator CanCancel:=True, CalculateExecutionTime:=True

        For i = 1 To 10000
            'only have to specify this property if boolCanCancel:=True
            If ProgressBar.ShouldCancel Then Exit Sub
            Sheet1.Cells(1, 1) = i

            ProgressBar.UpdateOrphanProgress "Proccessing", i, 10000
        Next

    Exit Sub

ErrHandle:
    Debug.Print Err.Number
End Sub

Sub TestingParentChildProccess()

 Dim ProgressBar As IProgressIndicator
 Dim dict As Object
 Dim arryTotalItemCnt() As Variant, arryTemp As Variant
 Dim lngMaxItems As Long
 Dim varKey As Variant
 Dim lngParentCntr As Long, i As Long

    Set ProgressBar = New ProgressIndicator
        ProgressBar.LoadProgIndicator HasParentProccess:=True, CanCancel:=True, CalculateExecutionTime:=True

    Set dict = CreateObject("Scripting.Dictionary")


        dict("Key1") = Array(1, 2, 3)
        ReDim Preserve arryTotalItemCnt(UBound(dict("Key1")) + 1)

        dict("Key2") = Array(1, 2, 3, 4)
        ReDim Preserve arryTotalItemCnt(UBound(arryTotalItemCnt) + UBound(dict("Key2")) + 1)

        dict("Key3") = Array(1, 2, 3, 4, 5)
        ReDim Preserve arryTotalItemCnt(UBound(arryTotalItemCnt) + UBound(dict("Key3")) + 1)

        lngMaxItems = UBound(arryTotalItemCnt)

        For Each varKey In dict
            lngParentCntr = lngParentCntr + 1

            arryTemp = dict.Item(varKey)

            For i = 0 To UBound(arryTemp)

                ProgressBar.UpdateParentChildProgress "Proccessing Parent", lngParentCntr, dict.Count, _
                                                      "Processing Child", i + 1, UBound(arryTemp) + 1, lngMaxItems

                    Application.Wait (Now() + TimeValue("00:00:01"))
            Next i
        Next

End Sub