VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsRotateMap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Implements ICommand
Implements ITool

' Local Constants
Const c_ModuleFileName = "clsRotateMap.cls"
Private Const cPI = 3.14159265358979

Private m_pApp As IApplication
Private m_pPoint1 As IPoint
 
Private Sub Class_Terminate()
    Set m_pPoint1 = Nothing
    Set m_pApp = Nothing
End Sub

Private Property Get ICommand_Enabled() As Boolean
    ICommand_Enabled = True
End Property
 
Private Property Get ICommand_Checked() As Boolean

End Property
 
Private Property Get ICommand_Name() As String
    ICommand_Name = "PlanProfile_RotateMap"
End Property
 
Private Property Get ICommand_Caption() As String
    ICommand_Caption = "Rotate Map"
End Property
 
Private Property Get ICommand_Tooltip() As String
    ICommand_Tooltip = "Set Map Rotation By 2 Points"
End Property
 
Private Property Get ICommand_Message() As String
    ICommand_Message = "Rotate the Map using 2 points"
End Property
 
Private Property Get ICommand_HelpFile() As String

End Property
 
Private Property Get ICommand_HelpContextID() As Long

End Property
 
Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE
    ICommand_Bitmap = frmIcons.picRotateMap
End Property
 
Private Property Get ICommand_Category() As String
    ICommand_Category = "Samples"
End Property
 
Private Sub ICommand_OnCreate(ByVal hook As Object)
    On Error GoTo ErrorHandler
    
    Set m_pApp = hook
    
    Exit Sub
ErrorHandler:
    HandleError True, "ICommand_OnCreate " & c_ModuleFileName & " " & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 2
End Sub
 
Private Sub ICommand_OnClick()
    If m_pPoint1 Is Nothing Then
        m_pApp.StatusBar.Message(0) = "Click to set the first (left) point ..."
    Else
        m_pApp.StatusBar.Message(0) = "Click to set the second (right) point ..."
    End If
    Exit Sub
ErrorHandler:
    HandleError True, "ICommand_OnClick " & c_ModuleFileName & " " & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 2
End Sub


Private Property Get ITool_Cursor() As esriCore.OLE_HANDLE

End Property

Private Function ITool_Deactivate() As Boolean
    ITool_Deactivate = True
End Function

Private Function ITool_OnContextMenu(ByVal X As Long, ByVal Y As Long) As Boolean

End Function

Private Sub ITool_OnDblClick()

End Sub

Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long)
    
End Sub

Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long)

End Sub

Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
    Dim pPoint As IPoint
    Dim pPagePoint As IPoint
    Dim pLine As ILine
    Dim pMxDoc As IMxDocument
    Dim pMxApp As IMxApplication
    Dim pActiveView As IActiveView
    
    ' Convert the user entered point (into map units for angle, page units for display)
    Set pMxDoc = m_pApp.Document
    Set pMxApp = m_pApp
    Set pActiveView = pMxDoc.FocusMap
    Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)
    Set pPagePoint = pMxApp.Display.DisplayTransformation.ToMapPoint(X, Y)
    
    ' Draw the point, if first one then keep it and begone from here
    DrawPoint pPagePoint
    If m_pPoint1 Is Nothing Then
        Set m_pPoint1 = pPoint
        m_pApp.StatusBar.Message(0) = "Click to set the second (right) point ..."
        Exit Sub
    End If
    
    ' Create the Line, reset the first point, rotate the map
    Set pLine = New esriCore.Line
    pLine.PutCoords m_pPoint1, pPoint
    Set m_pPoint1 = Nothing
    RotateMap pLine, pMxDoc.FocusMap
End Sub

Public Sub RotateMap(pLine As ILine, pMap As IMap)
    ' Apply to map
    Dim pActiveView As IActiveView
    Dim pDisplayTransform As IDisplayTransformation
    Dim dAngle As Double
    
    On Error GoTo ErrorHandler
    
    ' Get the display transformation
    Set pActiveView = pMap
    Set pDisplayTransform = pActiveView.ScreenDisplay.DisplayTransformation
    
    ' Calc and apply the angle (keep within 0-360 range)
    dAngle = 360 - (pLine.Angle * 360 / (2 * cPI))
    While dAngle < 0
        dAngle = dAngle + 360
    Wend
    While dAngle > 360
        dAngle = dAngle - 360
    Wend
    pDisplayTransform.Rotation = dAngle
    pActiveView.Refresh
    
    Exit Sub
ErrorHandler:
    HandleError True, "RotateMap " & c_ModuleFileName & " " & GetErrorLineNumberString(Erl), Err.Number, Err.Source, Err.Description, 2
End Sub

Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)

End Sub

Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)

End Sub

Private Sub ITool_Refresh(ByVal hDC As esriCore.OLE_HANDLE)

End Sub

Public Sub DrawPoint(pPoint As IPoint)
' Draw a graphic dot on the display at the given point location
'  Point colour is red (if a From point) or blue (if a To point)
    Dim pColor As IRgbColor
    Dim pMarker As ISimpleMarkerSymbol
    ' Set the symbol
    Set pColor = New RgbColor
    With pColor
        .red = 255
        .green = 0
        .blue = 0
    End With
    Set pMarker = New SimpleMarkerSymbol
    With pMarker
        .Color = pColor
        .Size = 6
    End With
    ' Draw the point
    Dim pMxApp As IMxApplication
    Dim pSDisplay As IAppDisplay
    Set pMxApp = m_pApp
    Set pSDisplay = pMxApp.Display
    With pSDisplay
       .StartDrawing pMxApp.Display.hDC, esriNoScreenCache
       .SetSymbol pMarker
       .DrawPoint pPoint
       .FinishDrawing
    End With
End Sub