Custom Timing Functions (Gettickcount)

[bluehairman]

I made some timer functions that basically just count seconds..
One function (TimerCount) will keep adding up and update quickly. But must be called in a timer to do so (Interval set to 1 works great).

The other functions TimerStart and TimerEnd will be for seeing how long it takes certain code to be executed... (Helpful to find the fastest way to execute chunks of code)
Module:

Option Explicit
 
Dim i As Single
Dim Start As Long
Dim EndT As Long
Dim Total As Double
Dim TotalLng As Long
 
Dim tmrStart As Long
Dim tmrEnd As Long
Dim tmrTtl As Double
    
Declare Function GetTickCount Lib "kernel32" () As Long
 
'following function with milliseconds
Public Function TimerCount(Optional Tmr As Timer, _
Optional Obj As Object, Optional StopT As Double, _
Optional AllObjwCap As Boolean, Optional LongT As Boolean) As Double
    
    Dim vCtrl As Control
    
    If Not IsMissing(LongT) Then 'for no milliseconds
        If LongT = True Then
            i = i + 1 ' for starting
        
            If i = 1 Then 'if its the first time running
                Start = GetTickCount 'get starting time
            ElseIf i > 1 Then 'to keep the number low
                i = 2
            End If
        
            EndT = GetTickCount 'get next time
            TotalLng = (EndT - Start) / 1000 'translate into seconds
            TimerCount = TotalLng 'function = time
    
            If Not IsMissing(Tmr) Then
                If StopT > 0 Then
                    If StopT = TimerCount Then
                        Tmr.Enabled = False
                    End If
                End If
            End If
    
            On Error Resume Next
            If Obj <> vbNullString Then
        
                If AllObjwCap = True Then
                    For Each vCtrl In Obj
                        vCtrl.Caption = TotalLng
                        vCtrl.Text = TotalLng
                    Next
                End If
        
            Obj.Text = TotalLng
            Obj.Caption = TotalLng
            If Err Then Err.Clear
            End If
            
            Else
            
            i = i + 1 ' for starting
        
            If i = 1 Then 'if its the first time running
                Start = GetTickCount 'get starting time
            ElseIf i > 1 Then 'to keep the number low
                i = 2
            End If
        
            EndT = GetTickCount 'get next time
            Total = (EndT - Start) / 1000 'translate into seconds
            TimerCount = Total 'function = time
    
            If Not IsMissing(Tmr) Then 'if tmr has value
                If StopT > 0 Then ' if stoptime is greater than 0
                    If StopT = TimerCount Then 'if stopt value = timerup value
                        Tmr.Enabled = False 'disable timer user entered
                    End If
                End If
            End If
    
            On Error Resume Next
            If Obj <> vbNullString Then 'if obj has value..
        
                If AllObjwCap = True Then
                    For Each vCtrl In Obj 'set all objects in objects caption
                        vCtrl.Caption = Total
                        vCtrl.Text = Total
                    Next
                End If
            
            Obj.Text = Total
            Obj.Caption = Total 'set obj's caption
            If Err Then Err.Clear
            End If
    
        End If
    End If
 
'Following function for without Milliseconds
 
    
End Function
 
'start the time todo function (amount of time to execute code)
Public Function TimerStart()
    tmrStart = GetTickCount
End Function
 
'end the time todo function (amount of time to execute code)
Public Function TimerEnd(Optional Obj As Object, Optional LongTF As Boolean) As Double
    tmrEnd = GetTickCount
    
    If tmrStart = 0 Then
        Exit Function
    End If
    
    If Not IsMissing(LongTF) Then
        If LongTF = True Then
            tmrTtl = (tmrEnd - tmrStart) \ 1000 'backslash division = rounding
            tmrEnd = tmrTtl
        Else
            tmrTtl = (tmrEnd - tmrStart) / 1000
            TimerEnd = tmrTtl
        End If
    End If
    
    On Error Resume Next
    If Not IsMissing(Obj) Then
        Obj.Caption = tmrTtl
        Obj.Text = tmrTtl
    End If
End Function
 
Public Function TimerReset()
    i = 0 'set so startt will set itself
End Function

Examples:

Option Explicit
 
Private Sub Command1_Click()
    Call TimerReset 'resets the live timer
    Timer1.Enabled = True 'not needed
    'timer.enabled is optional, it starts the counting again
End Sub
 
Private Sub Command2_Click()
    '**** not Live counting
    Call TimerStart 'start counting
    'code to execute:
    MsgBox "Sup home skillet"
    
    '...
    '...
    
    Label1.Caption = TimerEnd(Nothing, False)  'end counting and show how long it took
    'for the code to be executed
    
    'Another Example to use TimerEnd function:
    
    Call TimerEnd(Label1, False)
    'label1 is any object supporting .caption or .text
    
    'false is milliseconds or not
End Sub
 
Private Sub Timer1_Timer()
    '**** Live counting (must be in a timer)
    
    Call TimerCount(Timer1, Text1, 0, False, False)
    
    'timer1 is the timer to be disabled
    'text1 is the textbox to show the number of seconds
    'text1 can be anything that supports .caption and .text
    
    '0 is number of seconds to disable timer at
    
    'false is to add every control in form
    'to the number of seconds, supports .caption and .text
    
    'second false is if you want milliseconds or not
    
    'other example to use:
    
    Text1.Text = TimerCount(Timer1, Nothing, 0, False, False)
    
End Sub