Animation Tricks

This is the code from the Animation Tricks section of the seminar (modAnimationTricks)

Option Explicit

' This tells VBA how to call on the Windows API Sleep function
' This function puts our VBA code to sleep for X milliseconds
' (thousandths of a second) then lets it wake up after that
' Unlike other ways of killing time, this doesn't hog computer cycles
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub xYouClicked(oSh As Shape)
    Dim oShThought As Shape
    Set oShThought = oSh.Parent.Shapes("Thought")

    ' Make the thought balloon visible
    oShThought.Visible = True
    ' Move it to just to the right of the clicked shape
    oShThought.Left = oSh.Left + oSh.Width
    ' Position it vertically just above the clicked shape
    oShThought.Top = oSh.Top - oShThought.Height

    Select Case UCase(oSh.Name)
        Case Is = "EENIE"
            oShThought.TextFrame.TextRange.Text = "Pest!"
        Case Is = "MEENIE"
            oShThought.TextFrame.TextRange.Text = "This is annoying!"
        Case Is = "MINIE"
            oShThought.TextFrame.TextRange.Text = "This is REALLY annoying!!"
        Case Is = "MOE"
            oShThought.Visible = False
            oSh.Parent.Shapes("STOP").Visible = True
    End Select

End Sub

Sub yYouClicked(oSh As Shape)
    ' This time we'll use tags to make it easier to maintain

    Dim oShThought As Shape
    Set oShThought = oSh.Parent.Shapes("Thought")

    ' Make the thought balloon visible and move it next to the
    ' shape the user just clicked
    oShThought.Visible = True
    oShThought.Left = oSh.Left + oSh.Width
    oShThought.Top = oSh.Top - oShThought.Height

    ' Use tags to pick up the text
    oShThought.TextFrame.TextRange.Text = oSh.Tags("Thought")

End Sub

Sub AddATag()
    ' A little macro to add a tag to the selected shape
    Dim strTag As String

    ' Our old buddy InputBox gets the tag text ...
    strTag = InputBox("Type the text for the thought balloon", "What is the shape thinking?")

    ' Instead of forcing user to enter something, we'll just quit
    ' if not
    If strTag = "" Then
        Exit Sub
    End If

    ' Must have entered something, so tag the shape with it
    With ActiveWindow.Selection.ShapeRange(1)
        .Tags.Add "Thought", strTag
    End With
End Sub

Sub YouClicked(oSh As Shape)
    ' And now we'll add a WinAPI Sleep call to make it even smoother

    Dim oShThought As Shape
    Set oShThought = oSh.Parent.Shapes("Thought")

    ' Use tags to pick up the text
    oShThought.TextFrame.TextRange.Text = oSh.Tags("Thought")

    ' Make the thought balloon visible and move it next to the
    ' shape the user just clicked
    oShThought.Left = oSh.Left + oSh.Width
    oShThought.Top = oSh.Top - oShThought.Height
    oShThought.Visible = True

    ' give the system a little time to redraw
    DoEvents

    ' Now wait a second (1000 milliseconds to be precise) ...
    Sleep 1000
    ' and make it invisible again
    oShThought.Visible = False

End Sub


Sub Reset()
    ' Re-bait our little trap so it's ready for the next
    ' unwary user
    ActivePresentation.Slides("AnimationTricks").Shapes("STOP").Visible = False
    ActivePresentation.Slides("AnimationTricks").Shapes("Thought").Visible = False
End Sub

Click Next to continue