Attribute VB_Name = "modGraphicsFunctions"
'-------------------------------------------------
' modGraphicsFunctions
'-------------------------------------------------
' Public Subs:
'  (1)ClearLayout: Delete all graphics that have been created (and
'       are related to the Plan and Profile) from the layout.
'  (2)GroupGraphicsWithPrefix: For the selected layout elements, go
'       through and unselect those that don't have the given prefix
'       in their Name property.  Then Group the remaining ones.
'
' Public Functions:
'  (1)GenerateLineElement: Generate a graphic line on the Layout,
'       using the supplied start/end locations and symbology.
'       - Returns: ILineElement
'  (2)GeneratePointElement: Generate a graphic point on the Layout,
'       using the supplied location and symbology
'       - Returns: IMarkerElement
'  (3)GetMapAndPageEnvelopes: Get the map frame display envelopes
'       (in Map units and Page units) and populate global vars to
'       hold the information.
'       - Returns: Boolean (True, if values populated)
'-------------------------------------------------

Option Explicit

' Shared/Global Variables
Public m_pPrintablePageUnits As IEnvelope
Public m_pPageUnitsEnvelope As IEnvelope
Public Const c_ElementPrefix = "PlanProfile_"
Public Const c_ProfilePrefix = "PRF_"
Public Const c_TextBoxPrefix = "TXT_"

' Local Constants
Private Const c_ModuleFileName = "modGraphicsFunctions"

Public Sub ClearLayout(pMxDoc As IMxDocument, Optional sPrefix As String)
' Delete all graphics related to the Plan and Profile from the layout
    Dim pActiveView As IActiveView
    Dim pGraphicsContainer As IGraphicsContainer
    Dim pElement As IElement
    Dim pElementProp As IElementProperties
    Dim pMap As IMap
    Dim sLocalPrefix As String
    
    On Error GoTo ErrorHandler
    
    ' Init and switch OFF the updating of the TOC
    Set pMap = pMxDoc.FocusMap
    pMxDoc.DelayUpdateContents = True
    If IsMissing(sPrefix) Or Len(sPrefix) = 0 Then
        sLocalPrefix = c_ElementPrefix
    Else
        sLocalPrefix = sPrefix
    End If
    
    ' Delete all the graphic elements that we created (identify by the name prefix)
    Set pGraphicsContainer = pMxDoc.PageLayout
    pGraphicsContainer.Reset
    Set pElement = pGraphicsContainer.Next
    While (Not pElement Is Nothing)
        Set pElementProp = pElement
        If (Left(pElementProp.Name, Len(c_ElementPrefix)) = sLocalPrefix) Then
            pGraphicsContainer.DeleteElement pElement
            pGraphicsContainer.Reset
        End If
        Set pElement = pGraphicsContainer.Next
    Wend
    
    ' Switch ON the updating of the TOC, redraw
    pMxDoc.DelayUpdateContents = False
    Set pActiveView = pGraphicsContainer
    pActiveView.Refresh

    Exit Sub
ErrorHandler:
    HandleError False, "ClearLayout " & c_ModuleFileName & " " _
        & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 2
End Sub

Public Sub GenerateLineElement( _
            x1 As Double, y1 As Double, x2 As Double, y2 As Double, lineStyle As tagesriSimpleLineStyle, _
            lineWidth As Double, pRGBColor As IRgbColor, sElementName As String, pGraphicsContainer As IGraphicsContainer)
' Generate a graphic line on the Layout, using the supplied start/end locations and symbology
    Dim pPolyline As IPolyline
    Dim pPCollection As IPointCollection
    Dim pLineSymbol As ISimpleLineSymbol
    Dim pPoint As IPoint
    Dim pElement As IElement
    Dim pElementProp As IElementProperties
    Dim pTempLineElement As ILineElement
    
    ' Create a new line element
    Set pTempLineElement = New LineElement
    Set pElement = pTempLineElement
    ' Construct the geometry for the line
    Set pPolyline = New Polyline
    Set pPCollection = pPolyline
    Set pPoint = New Point
    pPoint.PutCoords x1, y1
    pPCollection.AddPoint pPoint
    pPoint.PutCoords x2, y2
    pPCollection.AddPoint pPoint
    pElement.Geometry = pPolyline
    ' Construct the symbology for the line
    Set pLineSymbol = New SimpleLineSymbol
    pLineSymbol.Style = lineStyle
    pLineSymbol.Width = lineWidth
    pLineSymbol.Color = pRGBColor
    pTempLineElement.Symbol = pLineSymbol
    ' Maintain the prefix name
    Set pElementProp = pTempLineElement
    pElementProp.Name = c_ElementPrefix & sElementName
    ' Add to map
    pGraphicsContainer.AddElement pElement, -1
End Sub

Public Sub GeneratePointElement( _
            x1 As Double, y1 As Double, pointStyle As tagesriSimpleMarkerStyle, pointSize As Double, _
            pRGBColor As IRgbColor, sElementName As String, pGraphicsContainer As IGraphicsContainer, _
            Optional pInSymbol As ISymbol)
' Generate a graphic point on the Layout, using the supplied location and symbology
    Dim pPntSymbol As ISimpleMarkerSymbol
    Dim pPoint As IPoint
    Dim pElement As IElement
    Dim pElementProp As IElementProperties
    Dim pTempPointElement As IMarkerElement
    
    ' Create a new point element
    Set pTempPointElement = New MarkerElement
    Set pElement = pTempPointElement
    ' Construct the geometry for the point
    Set pPoint = New Point
    pPoint.PutCoords x1, y1
    pElement.Geometry = pPoint
    ' Construct the symbology for the point
    If IsMissing(pInSymbol) Or (pInSymbol Is Nothing) Then
        Set pPntSymbol = New SimpleMarkerSymbol
        pPntSymbol.Style = pointStyle
        pPntSymbol.Size = pointSize
        pPntSymbol.Color = pRGBColor
        pTempPointElement.Symbol = pPntSymbol
    Else
        pTempPointElement.Symbol = pInSymbol
    End If
    ' Maintain the prefix name
    Set pElementProp = pTempPointElement
    pElementProp.Name = c_ElementPrefix & sElementName
    ' Add to map
    pGraphicsContainer.AddElement pElement, -1
End Sub

Public Function GetMapAndPageEnvelopes(pMxDoc As IMxDocument, pApp As IApplication) As Boolean
' Get the map frame display envelopes in Map units and Page units
    Dim pMapElement As IElement
    Dim pGraphicsContainer As IGraphicsContainer
    Dim pMap As IMap
    Dim pPage As IPage
    
    On Error GoTo ErrorHandler
    
    ' Get the Map Frame graphic element
    Set pMap = pMxDoc.FocusMap
    Set pGraphicsContainer = pMxDoc.PageLayout
    Set pMapElement = pGraphicsContainer.FindFrame(pMap)
    ' Populate the envelope info for the Page/Paper units (eg: (0.182,0.266))
    Set m_pPageUnitsEnvelope = New Envelope
    m_pPageUnitsEnvelope.PutCoords pMapElement.Geometry.Envelope.XMin, _
                                   pMapElement.Geometry.Envelope.YMin, _
                                   pMapElement.Geometry.Envelope.XMax, _
                                   pMapElement.Geometry.Envelope.YMax
    ' Populate the envelope info for the printable envelope
    Set pPage = pMxDoc.PageLayout.Page
    Set m_pPrintablePageUnits = New Envelope
    m_pPrintablePageUnits.PutCoords pPage.PrintableBounds.XMin, _
                                    pPage.PrintableBounds.YMin, _
                                    pPage.PrintableBounds.XMax, _
                                    pPage.PrintableBounds.YMax
    GetMapAndPageEnvelopes = True
    
    Exit Function
ErrorHandler:
    HandleError False, "GetMapAndPageEnvelopes " & c_ModuleFileName & " " _
        & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 2
End Function

Public Sub GenerateTextElement( _
            X As Double, Y As Double, textstring As String, textPlaceHz As esriTextHorizontalAlignment, _
            textPlaceVa As esriTextVerticalAlignment, textHeight As Double, textAngle As Double, _
            textFont As String, pRGBColor As IRgbColor, Name As String, _
            pGraphicsContainer As IGraphicsContainer, Optional XMax As Double, Optional YMax As Double)
     Dim pSymbol As ITextSymbol
     Dim pPoint As IPoint
     Dim pPolygon As IPolygon
     Dim pPntColl As IPointCollection
     Dim pFont As IFontDisp
     Dim pElementProperties As IElementProperties
     Dim pElement As IElement
     Dim pTextElement As ITextElement
     Dim bByPoint As Boolean
     
     bByPoint = (IsMissing(XMax) Or XMax <= 0) _
             Or (IsMissing(YMax) Or YMax <= 0)
     If bByPoint Then
        ' Create Point Geometry
        Set pPoint = New Point
        pPoint.PutCoords X, Y
     Else
        ' Create Polygon Geometry
        Set pPolygon = New Polygon
        Set pPntColl = pPolygon
        Set pPoint = New Point
        pPoint.PutCoords X, Y
        pPntColl.AddPoint pPoint
        pPoint.PutCoords XMax, Y
        pPntColl.AddPoint pPoint
        pPoint.PutCoords XMax, YMax
        pPntColl.AddPoint pPoint
        pPoint.PutCoords X, YMax
        pPntColl.AddPoint pPoint
     End If
    
     ' Create the text element
     Set pTextElement = New TextElement
     Set pElement = pTextElement
     Set pElementProperties = pElement
     
     ' Apply geometry
     pTextElement.Text = textstring
     If bByPoint Then
        pElement.Geometry = pPoint
     Else
        pElement.Geometry = pPolygon
     End If
     
     ' Font things like size and alignment
     Set pSymbol = New TextSymbol
     pSymbol.HorizontalAlignment = textPlaceHz
     pSymbol.VerticalAlignment = textPlaceVa
     pSymbol.Size = textHeight
     pSymbol.Angle = textAngle
     pSymbol.Color = pRGBColor
    
     Set pFont = pSymbol.Font
     pFont.Name = textFont
     pFont.Size = textHeight
     
     pSymbol.Font = pFont
     
     ' set new font on text element
     pTextElement.Symbol = pSymbol
     
     pElementProperties.Name = c_ElementPrefix & Name
     pGraphicsContainer.AddElement pElement, 0
     
End Sub

Public Function BuildRGB(red As Byte, green As Byte, blue As Byte) As IRgbColor
' Create and return an RGBColor object
    Set BuildRGB = New RgbColor
    With BuildRGB
        .red = red
        .green = green
        .blue = blue
    End With
End Function

Public Sub GroupGraphicsWithPrefix(pMxDoc As IMxDocument, Optional sPrefix As String)
    Dim pGraphicSelect As IGraphicsContainerSelect
    Dim pElement As IElement, pMapElement As IElement
    Dim pEnumElem As IEnumElement
    Dim pElementProps As IElementProperties
    ' If no prefix given, use the global one
    If IsMissing(sPrefix) Or Len(sPrefix) = 0 Then
        sPrefix = c_ElementPrefix
    End If
    ' Need to unselect all elements that don't have our prefix
    Set pGraphicSelect = pMxDoc.PageLayout
    pGraphicSelect.SelectAllElements
    Set pEnumElem = pGraphicSelect.SelectedElements
    Set pElement = pEnumElem.Next
    While Not pElement Is Nothing
        Set pElementProps = pElement
        If Left(pElementProps.Name, Len(sPrefix)) <> sPrefix _
         Or TypeOf pElement Is IMapFrame Then
            If TypeOf pElement Is IMapFrame Then
                Set pMapElement = pElement
            End If
            pGraphicSelect.UnselectElement pElement
        End If
        Set pElement = pEnumElem.Next
    Wend
    ' Group the remaining selected graphics
    If CallArcMapButton(pMxDoc, "{4B96A443-FA41-11D0-83AF-080009B996CC}") Then
        Set pEnumElem = pGraphicSelect.SelectedElements
        Set pElement = pEnumElem.Next
        If Not pElement Is Nothing Then
            Set pElementProps = pElement
            pElementProps.Name = sPrefix & "GroupedElements"
        End If
        ' Need to reselect the mapframe
        If Not pMapElement Is Nothing Then
            pGraphicSelect.UnselectAllElements
            pGraphicSelect.SelectElement pMapElement
        End If
    Else
        MsgBox "Warning: Could not group the Plan Profile graphics.", vbExclamation, "Plan Profile"
    End If
End Sub

Private Function CallArcMapButton(pMxDoc As IMxDocument, sKey As String) As Boolean
    Dim pUID As New UID
    Dim pDocument As IDocument
    Dim pCommandBars As ICommandBars
    Dim pCommandItem As ICommandItem
    ' Init
    On Error GoTo ErrorHandler
    CallArcMapButton = False
    ' Invoke the ArcMap button
    pUID = sKey
    Set pDocument = pMxDoc
    Set pCommandBars = pDocument.CommandBars
    Set pCommandItem = pCommandBars.Find(pUID, True, False)
    pCommandItem.Execute
    Set pCommandBars = Nothing
    Set pCommandItem = Nothing
    CallArcMapButton = True
ErrorHandler:
End Function