Move a graphic along a path in ArcMap
MapGraphicKeyframe.vb
' Copyright 2012 ESRI
' 
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See the use restrictions.
' 

Imports Microsoft.VisualBasic
Imports System
Imports System.Windows.Forms
Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Imports ESRI.ArcGIS.Animation
Imports ESRI.ArcGIS.ADF
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Controls
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.SystemUI
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.Display

<Guid("A9250243-7A16-4F8D-AA06-29F559ADA0C5"), ClassInterface(ClassInterfaceType.None), ProgId("AnimationDeveloperSamples.MapGraphicKeyframe")> _
Public Class MapGraphicKeyframe : Implements IAGKeyframe, IAGKeyframeUI
    Private activeProps As ILongArray
    Private animType As IAGAnimationType
    Private name_Renamed As String
    Private bObjectsNeedRefresh As Boolean
    Private Position As IPoint
    Private Rotation As Double
    Private timeStamp_Renamed As Double

#Region "constructor"
    Public Sub New()
        activeProps = New LongArrayClass()
        activeProps.Add(0)
        activeProps.Add(1)
        animType = New AnimationTypeMapGraphic()
        name_Renamed = ""
        bObjectsNeedRefresh = False
        Position = New PointClass()
        Rotation = 0.0
        timeStamp_Renamed = 0.0
    End Sub
#End Region

#Region "IAGKeyframe members"
    Public Property ActiveProperties() As ILongArray Implements IAGKeyframe.ActiveProperties
        Get
            Return activeProps
        End Get
        Set(ByVal value As ILongArray)
            activeProps = value
        End Set
    End Property

    Public ReadOnly Property AnimationType() As IAGAnimationType Implements IAGKeyframe.AnimationType
        Get
            Return animType
        End Get
    End Property

    Public Sub Apply(ByVal pTrack As IAGAnimationTrack, ByVal pContainer As IAGAnimationContainer, ByVal pObject As Object) Implements IAGKeyframe.Apply
        Dim elem As IElement = CType(pObject, IElement)

        UpdateGraphicObject(elem, pContainer, pTrack, Position, Rotation)

        Return
    End Sub

    Public Sub CaptureProperties(ByVal pContainer As IAGAnimationContainer, ByVal pObject As Object) Implements IAGKeyframe.CaptureProperties
        Dim elem As IElement = TryCast(pObject, IElement)
        Dim view As IActiveView = TryCast(pContainer.CurrentView, IActiveView)
        Dim graphicsConSel As IGraphicsContainerSelect = TryCast(view, IGraphicsContainerSelect)
        Dim disp As IDisplay = TryCast(view.ScreenDisplay, IDisplay)
        Dim elemEnv As IEnvelope = GetElementBound(elem, pContainer)

        If elem.Geometry.GeometryType = esriGeometryType.esriGeometryPoint Then
            Position = TryCast(elem.Geometry, IPoint)
        Else
            Dim elementEnvelope As IEnvelope = elem.Geometry.Envelope
            Dim elementArea As IArea = TryCast(elementEnvelope, IArea)
            Position = elementArea.Centroid
        End If

        Dim elemProps As IElementProperties = CType(elem, IElementProperties)
        If Not elemProps.CustomProperty Is Nothing Then
            Rotation = CDbl(elemProps.CustomProperty)
        End If
    End Sub

    Public Sub Interpolate(ByVal pTrack As IAGAnimationTrack, ByVal pContainer As IAGAnimationContainer, ByVal pObject As Object, ByVal propertyIndex As Integer, ByVal time As Double, ByVal pNextKeyframe As IAGKeyframe, ByVal pPrevKeyframe As IAGKeyframe, ByVal pAfterNextKeyframe As IAGKeyframe) Implements IAGKeyframe.Interpolate
        If time < TimeStamp OrElse time > pNextKeyframe.TimeStamp Then
            Return
        End If

        Dim elem As IElement = CType(pObject, IElement)
        Dim new_pos As IPoint = New PointClass()

        If propertyIndex = 0 Then
            Dim x1 As Double
            Dim y1 As Double
            Dim nextPosition As IPoint = CType(pNextKeyframe.PropertyValue(0), IPoint)

            Dim timeFactor As Double
            timeFactor = (time - TimeStamp) / (pNextKeyframe.TimeStamp - TimeStamp) 'ignoring pPrevKeyframe and pAfterNextKeyframe

            x1 = Position.X * (1 - timeFactor) + nextPosition.X * timeFactor
            y1 = Position.Y * (1 - timeFactor) + nextPosition.Y * timeFactor

            new_pos.PutCoords(x1, y1)

            If Not (TypeOf elem Is ILineElement) Then
                MoveElement(elem, new_pos, pContainer)
                TracePath(elem, new_pos, pContainer, pTrack, Me)
                bObjectsNeedRefresh = True
            End If
        End If
        If propertyIndex = 1 Then
            'this property only applies to the point graphic 
            If Not (TypeOf elem Is ILineElement) Then
                RotateElement(elem, Rotation, pContainer)
                bObjectsNeedRefresh = True
            End If
        End If

        Return
    End Sub

    Public Property IsActiveProperty(ByVal propIndex As Integer) As Boolean Implements IAGKeyframe.IsActiveProperty
        Get
            Dim bIsActive As Boolean = False
            Dim count As Integer = activeProps.Count

            Dim i As Integer = 0
            Do While i < count
                Dim temp As Long = activeProps.Element(i)
                If temp = propIndex Then
                    bIsActive = True
                End If
                i += 1
            Loop
            Return bIsActive
        End Get
        Set(ByVal value As Boolean)
            If value Then
                If IsActiveProperty(propIndex) = False Then
                    activeProps.Add(propIndex)
                End If
            Else
                If IsActiveProperty(propIndex) = True Then
                    Dim i As Integer = 0
                    Dim count As Integer = activeProps.Count
                    i = 0
                    Do While i < count
                        Dim temp As Long = activeProps.Element(i)
                        If temp = propIndex Then
                            Exit Do
                        End If
                        i += 1
                    Loop

                    activeProps.Remove(i)
                End If
            End If
        End Set
    End Property

    Public Property Name() As String Implements IAGKeyframe.Name
        Get
            Return name_Renamed
        End Get

        Set(ByVal value As String)
            name_Renamed = value
        End Set
    End Property
    Public ReadOnly Property ObjectNeedsRefresh() As Boolean Implements IAGKeyframe.ObjectNeedsRefresh
        Get
            Return bObjectsNeedRefresh
        End Get
    End Property

    Public Property PropertyValue(ByVal propIndex As Integer) As Object Implements IAGKeyframe.PropertyValue
        Get
            If propIndex = 0 Then
                Return CObj(Position)
            ElseIf propIndex = 1 Then
                Return CObj(Rotation)
            Else
                Return Nothing
            End If
        End Get
        Set(ByVal value As Object)
            If propIndex = 0 Then
                Position = CType(value, IPoint)
            ElseIf propIndex = 1 Then
                Rotation = CType(value, Double)
            Else
                Return
            End If
        End Set
    End Property

    Public Sub RefreshObject(ByVal pTrack As IAGAnimationTrack, ByVal pContainer As IAGAnimationContainer, ByVal pObject As Object) Implements IAGKeyframe.RefreshObject
        RefreshGraphicObject(CType(pObject, IElement), pContainer)
    End Sub
    Public Property TimeStamp() As Double Implements IAGKeyframe.TimeStamp
        Get
            Return timeStamp_Renamed
        End Get

        Set(ByVal value As Double)
            timeStamp_Renamed = value
        End Set
    End Property
#End Region

#Region "IAGKeyframeUI members"
    Public Function GetText(ByVal propIndex As Integer, ByVal columnIndex As Integer) As String Implements IAGKeyframeUI.GetText
        Dim text As String
        text = Nothing
        Select Case propIndex
            Case 0
                If columnIndex = 0 Then
                    text = System.Convert.ToString(Position.X)
                End If
                If columnIndex = 1 Then
                    text = System.Convert.ToString(Position.Y)
                End If
            Case 1
                text = System.Convert.ToString(Rotation)
        End Select
        Return text
    End Function

    Public Sub SetText(ByVal propIndex As Integer, ByVal columnIndex As Integer, ByVal text As String) Implements IAGKeyframeUI.SetText
        Select Case propIndex
            Case 0
                If columnIndex = 0 Then
                    Position.X = System.Convert.ToDouble(text)
                End If
                If columnIndex = 1 Then
                    Position.Y = System.Convert.ToDouble(text)
                End If
            Case 1
                Rotation = System.Convert.ToDouble(text)
        End Select

        Return
    End Sub
#End Region

#Region "private methods"
    Private Sub RotateElement(ByVal elem As IElement, ByVal new_angle As Double, ByVal pContainer As IAGAnimationContainer)
        Dim transform2D As ITransform2D = TryCast(elem, ITransform2D)
        Dim rotateOrigin As IPoint

        If elem.Geometry.GeometryType = esriGeometryType.esriGeometryPoint Then
            rotateOrigin = TryCast(elem.Geometry, IPoint)
        Else
            Dim elementEnvelope As IEnvelope = elem.Geometry.Envelope
            Dim elementArea As IArea = TryCast(elementEnvelope, IArea)
            rotateOrigin = elementArea.Centroid
        End If

        AddPropertySet(elem)

        Dim prop As IElementProperties = CType(elem, IElementProperties) 'record the old properties
        Dim propSet As IPropertySet
        propSet = CType(prop.CustomProperty, IPropertySet)
        Dim old_angle As Double
        old_angle = CDbl(propSet.GetProperty("Angle"))

        propSet.SetProperty("Angle", new_angle) 'update old angle

        transform2D.Rotate(rotateOrigin, new_angle - old_angle)
    End Sub

    Private Sub TracePath(ByVal elem As IElement, ByVal new_pos As IPoint, ByVal pContainer As IAGAnimationContainer, ByVal pTrack As IAGAnimationTrack, ByVal pKeyframe As IAGKeyframe)
        Dim trackExtensions As IAGAnimationTrackExtensions = CType(pTrack, IAGAnimationTrackExtensions)
        Dim graphicTrackExtension As IMapGraphicTrackExtension
        If trackExtensions.ExtensionCount = 0 Then 'if there is no extension, add one
            graphicTrackExtension = New MapGraphicTrackExtension()
            trackExtensions.AddExtension(graphicTrackExtension)
        Else
            graphicTrackExtension = CType(trackExtensions.Extension(0), IMapGraphicTrackExtension)
        End If

        Dim path As ILineElement = graphicTrackExtension.TraceElement

        Dim showTrace As Boolean = graphicTrackExtension.ShowTrace
        If (Not showTrace) Then
            If CheckGraphicExistance(CType(path, IElement), pContainer) Then
                RemoveGraphicFromDisplay(CType(path, IElement), pContainer)
            End If
            Return
        End If

        'Add the path to the graphic container
        If (Not CheckGraphicExistance(CType(path, IElement), pContainer)) Then
            AddGraphicToDisplay(CType(path, IElement), pContainer)
        End If

        RecreateLineGeometry(CType(path, IElement), pTrack, pKeyframe, new_pos)
    End Sub

    Private Sub AddGraphicToDisplay(ByVal elem As IElement, ByVal animContainer As IAGAnimationContainer)
        Dim view As IActiveView = TryCast(animContainer.CurrentView, IActiveView)
        Dim graphicsContainer As IGraphicsContainer = TryCast(view, IGraphicsContainer)
        graphicsContainer.AddElement(elem, 0)
        elem.Activate(view.ScreenDisplay)
    End Sub

    Private Sub RemoveGraphicFromDisplay(ByVal elem As IElement, ByVal animContainer As IAGAnimationContainer)
        Dim view As IActiveView = TryCast(animContainer.CurrentView, IActiveView)
        Dim graphicsContainer As IGraphicsContainer = TryCast(view, IGraphicsContainer)
        graphicsContainer.DeleteElement(elem)
    End Sub

    Private Function CheckGraphicExistance(ByVal elem As IElement, ByVal animContainer As IAGAnimationContainer) As Boolean
        Dim view As IActiveView = TryCast(animContainer.CurrentView, IActiveView)
        Dim graphicsContainer As IGraphicsContainer = TryCast(view, IGraphicsContainer)
        graphicsContainer.Reset()

        Dim exists As Boolean = False
        Dim temp As IElement = graphicsContainer.Next()
        Do While Not temp Is Nothing
            If temp Is elem Then
                exists = True
                Exit Do
            End If
            temp = graphicsContainer.Next()
        Loop
        Return exists
    End Function

    Private Sub MoveElement(ByVal elem As IElement, ByVal new_pos As IPoint, ByVal pContainer As IAGAnimationContainer)
        Dim transform2D As ITransform2D = TryCast(elem, ITransform2D)
        Dim origin As IPoint

        If elem.Geometry.GeometryType = esriGeometryType.esriGeometryPoint Then
            origin = TryCast(elem.Geometry, IPoint)
        Else
            Dim elementEnvelope As IEnvelope = elem.Geometry.Envelope
            Dim elementArea As IArea = TryCast(elementEnvelope, IArea)
            origin = elementArea.Centroid
        End If

        AddPropertySet(elem)

        Dim prop As IElementProperties = CType(elem, IElementProperties) 'record the old properties
        Dim propSet As IPropertySet
        propSet = CType(prop.CustomProperty, IPropertySet)
        Dim oldEnv As IEnvelope = GetElementBound(elem, pContainer)
        propSet.SetProperty("Envelope", oldEnv)

        transform2D.Move(new_pos.X - origin.X, new_pos.Y - origin.Y)
    End Sub

    Private Sub RecreateLineGeometry(ByVal elem As IElement, ByVal pTrack As IAGAnimationTrack, ByVal pKeyframe As IAGKeyframe, ByVal new_pos As IPoint)
        Dim newGeometry As IGeometry = New PolylineClass()
        Dim newPointCol As IPointCollection = CType(newGeometry, IPointCollection)

        Dim trackKeyframes As IAGAnimationTrackKeyframes = CType(pTrack, IAGAnimationTrackKeyframes)
        Dim tCount As Integer = trackKeyframes.KeyframeCount
        Dim missing As Object = Type.Missing
        Dim i As Integer = 0
        Do While i < tCount
            Dim tempKeyframe As IAGKeyframe = trackKeyframes.Keyframe(i)
            newPointCol.AddPoint(CType(tempKeyframe.PropertyValue(0), IPoint), missing, missing)
            If CType(tempKeyframe.PropertyValue(0), IPoint) Is CType(pKeyframe.PropertyValue(0), IPoint) Then
                Exit Do
            End If
            i += 1
        Loop
        If Not new_pos Is Nothing Then
            newPointCol.AddPoint(new_pos, missing, missing)
        End If

        elem.Geometry = newGeometry
    End Sub

    Private Function GetElementBound(ByVal elem As IElement, ByVal pContainer As IAGAnimationContainer) As IEnvelope
        Dim view As IActiveView = TryCast(pContainer.CurrentView, IActiveView)
        Dim graphicsContainerSelect As IGraphicsContainerSelect = TryCast(view, IGraphicsContainerSelect)
        Dim disp As IDisplay = TryCast(view.ScreenDisplay, IDisplay)

        Dim elementEnvelope As IEnvelope = New EnvelopeClass()
        elem.QueryBounds(disp, elementEnvelope)

        If graphicsContainerSelect.ElementSelected(elem) Then
            elementEnvelope = elem.SelectionTracker.Bounds(disp)
        End If

        Return elementEnvelope
    End Function

    Private Sub UpdateGraphicObject(ByVal elem As IElement, ByVal pContainer As IAGAnimationContainer, ByVal pTrack As IAGAnimationTrack, ByVal new_pos As IPoint, ByVal new_angle As Double)
        If elem Is Nothing OrElse new_pos Is Nothing Then
            Return 'invalidate parameter
        End If

        MoveElement(elem, new_pos, pContainer)
        RotateElement(elem, new_angle, pContainer)

        Return
    End Sub

    Private Sub AddPropertySet(ByVal elem As IElement)
        If elem Is Nothing Then
            Return 'invalidate parameter
        End If

        Dim prop As IElementProperties = CType(elem, IElementProperties) 'record the old properties
        Dim propSet As IPropertySet
        If prop.CustomProperty Is Nothing Then
            propSet = New PropertySetClass()
            propSet.SetProperty("Envelope", Nothing)
            propSet.SetProperty("Angle", 0.0)
            prop.CustomProperty = propSet
        End If
    End Sub

    Private Sub RefreshGraphicObject(ByVal elem As IElement, ByVal pContainer As IAGAnimationContainer)
        Dim view As IActiveView = TryCast(pContainer.CurrentView, IActiveView)
        Dim elemEnv As IEnvelope = GetElementBound(elem, pContainer)

        Dim oldEnv As IEnvelope = New EnvelopeClass()
        Dim elemProps2 As IElementProperties2 = CType(elem, IElementProperties2)
        oldEnv = CType(elemProps2.CustomProperty, IEnvelope)

        Dim animRefresh As IViewRefresh = CType(view, IViewRefresh)

        If Not oldEnv Is Nothing Then
            elemEnv.Union(oldEnv)
        End If

        animRefresh.AnimationRefresh(esriViewDrawPhase.esriViewGraphics, elem, elemEnv)
    End Sub
#End Region
End Class