Timer.bas

Attribute VB_Name = "Timer"
Option Explicit

Private started As Boolean

Private Const timerShapeName = "PPVOTING_SPECIAL_TIMER_SHAPE_NAME"

Private timerID As Variant

' Time is in seconds
Private endTime As Long
Private transitionEndTime As Long


Public Sub Start()
    On Error GoTo HandleError

    endTime = GetEndTime()

    timerID = System.SetTimer(0, 0, 1000, AddressOf Run) ' Every 1000 ms

    started = True

    LogInfoAt "Timer.Start", "Timer set"

    Exit Sub

HandleError:

    LogLastErrorAt "Timer.Start"

End Sub


Public Sub Finish()
    On Error GoTo HandleError

    If started Then

        System.KillTimer 0, timerID

        LogInfoAt "Timer.Finish", "Timer killed"

        started = False

    End If

    ClearShapes

    Exit Sub

HandleError:

    LogLastErrorAt "Timer.Finish"

End Sub


Private Sub Run()
    On Error GoTo HandleError

    ' Prevents flickering
    If Not CanDraw() Then Exit Sub

    UpdateShape

    Exit Sub

HandleError:

    LogLastErrorAt "Timer.Run"

End Sub


Private Sub ClearShapes()
    Dim slideIndex As Integer
    For slideIndex = 1 To ActivePresentation.Slides.Count
        Dim mShape As Shape
        Set mShape = GetShapeByName(timerShapeName, slideIndex)
        If Not mShape Is Nothing Then mShape.Delete
    Next
End Sub


Private Function GetCurrentTime() As Long
    Dim nowTime
    nowTime = Now()
    GetCurrentTime = Hour(nowTime) * 3600 + Minute(nowTime) * 60 + Second(nowTime)
End Function


Private Function GetEndTime() As Long
    GetEndTime = GetCurrentTime() + settings("timer.total_time") * 60
End Function


Private Function GetRemainingTime() As Long
    Dim remainingTime As Long
    remainingTime = endTime - GetCurrentTime()
    If remainingTime < 0 Then remainingTime = 0

    GetRemainingTime = remainingTime
End Function


Private Function GetBlushTime() As Long
    GetBlushTime = endTime - settings("timer.blush_time") * 60
End Function


Private Function GetShouldBlush() As Long
    GetShouldBlush = GetCurrentTime() > GetBlushTime()
End Function


Private Function GetTransitionKeyPressed() As Boolean
    Dim key As Variant
    For Each key In Utils.GetForwardKeys()
        If System.GetAsyncKeyState(key) Then
            GetTransitionKeyPressed = True
            Exit Function
        End If
    Next
    For Each key In Utils.GetBackwardKeys()
        If System.GetAsyncKeyState(key) Then
            GetTransitionKeyPressed = True
            Exit Function
        End If
    Next

    GetTransitionKeyPressed = False
End Function


Private Function CanDraw() As Boolean
    If IsNotInsideSlideShow() Then
        CanDraw = False
        Exit Function
    End If

    If Diagram.Visible Or IsOnFinalBlankSlide() Or IsInsideTransition() Then
        CanDraw = False
        Exit Function
    End If

    CanDraw = True
End Function


Private Function IsNotInsideSlideShow() As Boolean
    IsNotInsideSlideShow = GetCurrentSlide() Is Nothing
End Function


' There is a final black slide in end end of every slide show, on which any drawing fails
Private Function IsOnFinalBlankSlide() As Boolean
    IsOnFinalBlankSlide = SlideShowWindows(1).View.CurrentShowPosition > ActivePresentation.Slides.Count
End Function


Private Function IsInsideTransition() As Boolean
    If GetTransitionKeyPressed() Then
        transitionEndTime = GetTransitionEndTime()
    End If

    If GetCurrentTime() <= transitionEndTime Then
        IsInsideTransition = True
        Exit Function
    End If

    IsInsideTransition = False
End Function


Private Function GetCurrentSlide() As Slide
    Set GetCurrentSlide = ActivePresentation.SlideShowWindow.View.slide
End Function


Private Function GetTransitionEndTime() As Long
    GetTransitionEndTime = GetCurrentTime() + GetCurrentSlide().SlideShowTransition.Duration
End Function


Private Sub UpdateShape()
    Dim mShape As Shape
    Set mShape = GetShapeByName(timerShapeName, GetCurrentSlide().slideIndex)

    If mShape Is Nothing Then
        Set mShape = GetCurrentSlide().Shapes.AddShape(msoShapeRectangle, 0, 0, 110, 20)

        With mShape
            .name = timerShapeName
            .TextFrame.TextRange.Font.name = "Arial"
            .TextFrame.TextRange.Font.Bold = True
            .TextFrame.TextRange.Font.Size = 12
            .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
        End With
    End If

    With mShape
        If GetShouldBlush() Then
            .Fill.ForeColor.RGB = RGB(255, 109, 109)
            .Fill.BackColor.RGB = RGB(255, 109, 109)
        Else
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
            .Fill.BackColor.RGB = RGB(255, 255, 255)
        End If

        .TextFrame.TextRange.text = FormatTime()
    End With
End Sub


Private Function GetShapeByName(name As String, slideIndex As Integer) As Shape
    On Error GoTo HandleError

    Dim mShape As Variant
    For Each mShape In ActivePresentation.Slides(slideIndex).Shapes
        If mShape.name = name Then
            Set GetShapeByName = mShape
            Exit Function
        End If
    Next

    Set GetShapeByName = Nothing

    Exit Function

HandleError:

    LogLastErrorAt "Timer.GetShapeByName"

End Function


' Returns "HH:MM:SS | MM:SS" - current time | remaining time
Private Function FormatTime() As String
    FormatTime = Format(Now(), "hh:mm:ss") & " | " & Format(GetRemainingTime() \ 60, "00") & ":" & Format(GetRemainingTime() Mod 60, "00")
End Function