IRotateTracker 的用法

This example implements a simple tool for rotating graphics.

Dim m_pRotateTracker As IRotateTracker
Dim m_pSelElem As IElement

Private Sub UIToolControl1_Select()
  Set m_pRotateTracker = New RotateTracker
End Sub

Private Function UIToolControl1_Deactivate() As Boolean
  If Not m_pRotateTracker Is Nothing Then
    Set m_pRotateTracker = Nothing
  End If
  Set m_pSelElem = Nothing
 
  UIToolControl1_Deactivate = True
End Function
Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
 
  Dim pMxDoc As IMxDocument
  Dim pGraContSel As IGraphicsContainerSelect
  Dim pElemVert As IElementEditVertices
  Dim iSelCount As Integer
 
  'Get the document's active Graphics Container
  Set pMxDoc = ThisDocument
  Set pGraContSel = pMxDoc.ActiveView.GraphicsContainer
  ' Check that there is at least one selected element
  iSelCount = pGraContSel.ElementSelectionCount
  If iSelCount = 1 Then
    Set m_pSelElem = pGraContSel.SelectedElement(0)
  Else
    Set m_pSelElem = pGraContSel.DominantElement
  End If
 
  If m_pSelElem Is Nothing Then
    Exit Sub
  End If
 
  '****** Set screen display of the tracker
  Dim pScreenDisplay As IScreenDisplay
  Set pScreenDisplay = pMxDoc.ActiveView.ScreenDisplay
  Set m_pRotateTracker.Display = pScreenDisplay
 
  '****** Set origin of the rotation, add geometry
  m_pRotateTracker.ClearGeometry
  Dim pGeom As IGeometry
  Set pGeom = GetElementGeometry(m_pSelElem, pScreenDisplay)
  m_pRotateTracker.Origin = pGeom.Envelope.LowerLeft
  m_pRotateTracker.AddGeometry pGeom
 
  If Not m_pRotateTracker Is Nothing Then
    m_pRotateTracker.OnMouseDown
  End If
End Sub

Private Sub UIToolControl1_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
 
  If Not m_pRotateTracker Is Nothing Then
 
    Dim pPoint As IPoint
    Dim pMxDoc As IMxDocument
    Dim pScreenDisplay As IScreenDisplay
    Set pMxDoc = ThisDocument
    Set pScreenDisplay = pMxDoc.ActiveView.ScreenDisplay
    Set pPoint = pScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
    m_pRotateTracker.OnMouseMove pPoint
  End If
End Sub
Private Sub UIToolControl1_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
 
  If Not m_pRotateTracker Is Nothing Then
    Dim bChanged As Boolean
    bChanged = m_pRotateTracker.OnMouseUp
    If Not bChanged Then
      Exit Sub
    End If
 
    If Not TypeOf m_pSelElem Is ITransform2D Then
      MsgBox "cant transform element"
      Exit Sub
    End If
    Dim pTransform2D As ITransform2D
    Set pTransform2D = m_pSelElem
    pTransform2D.Rotate m_pRotateTracker.Origin, m_pRotateTracker.Angle
   
    Dim pMxDoc As IMxDocument
    Dim pGeom As IGeometry
    Dim pGraphicsContainer As IGraphicsContainer
    Set pMxDoc = ThisDocument
    Set pGraphicsContainer = pMxDoc.ActiveView
    pGraphicsContainer.UpdateElement m_pSelElem
    pMxDoc.ActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing
  End If
End Sub
Public Function GetElementGeometry(pElement As IElement, _
                                   pScreenDisplay As IScreenDisplay)
  Set GetElementGeometry = pElement.Geometry
  If TypeOf pElement Is IBoundsProperties Then
    Dim pBoundsProps As IBoundsProperties
    Set pBoundsProps = pElement
    If pBoundsProps.FixedSize Then
      Dim pPolygon As IPolygon
      Set pPolygon = New Polygon
      pElement.QueryOutline pScreenDisplay, pPolygon
      Set GetElementGeometry = pPolygon
    End If
  End If
End Function