IRotateTracker の利用

Option Explicit

Private pRTracker As IRotateTracker

'
'Cancel any tracking:
'
Private Function UIToolControl1_Deactivate() As Boolean

    If Not pRTracker Is Nothing Then
        Set pRTracker = Nothing
    End If
    UIToolControl1_Deactivate = True
    
End Function

Private Sub UIToolControl1_Refresh(ByVal hDC As Long)
If Not pRTracker Is Nothing Then
    pRTracker.Refresh
End If
End Sub

'
'Create a new rotate tracker when selected:
'
Private Sub UIToolControl1_Select()
    'Create new Rotate Tracker:
    Set pRTracker = New RotateTracker
End Sub

'
'
'Define the angle:
'
Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    
    'Rotate angle graphic with right mouse click:
    If (button = 1) Then
    
        Dim pMxDoc As IMxDocument
        Dim pDisplay As IScreenDisplay
        Set pMxDoc = Application.Document
        Set pDisplay = pMxDoc.ActiveView.ScreenDisplay
        
        Dim pGraphicsContainer As IGraphicsContainer
        Set pGraphicsContainer = pMxDoc.ActiveView.GraphicsContainer
        pGraphicsContainer.Reset
        
        Dim pGraphicContainerSelect As IGraphicsContainerSelect
        Set pGraphicContainerSelect = pMxDoc.ActiveView.GraphicsContainer
        
        'Find the existing angle graphic:
        Dim pElement As IElement
        Set pElement = pGraphicsContainer.Next ' pGraphicContainerSelect.SelectedElement(0) '
        Dim pElement2 As IElement
        Set pElement2 = pGraphicsContainer.Next
        
        If (Not pElement Is Nothing) Then
        
            'Create rotate tracker:
            Set pRTracker.Display = pDisplay
        
            'Assign origin of rotation:
            Dim pGeo As IGeometry
            Dim pGeo2 As IGeometry
            
            Dim pStartPt As IPoint
            
            Set pGeo = pElement.Geometry
            Set pGeo2 = pElement2.Geometry
            Set pStartPt = pMxDoc.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y) 'pGeo.FromPoint '
            
            pRTracker.Origin = pMxDoc.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y) 'pStartPt '
            
'            Dim pGeometryCollection As IGeometryCollection
'            Set pGeometryCollection = New Polygon
'            pGeometryCollection.AddGeometry pGeo
            
            'Assign geometry to be rotated:
            pRTracker.ClearGeometry
            pRTracker.AddGeometry pGeo
            pRTracker.AddGeometry pGeo2
            pRTracker.AddPoint pStartPt, New SimpleMarkerSymbol
            
            'Start rotation process:
            If Not pRTracker Is Nothing Then
                pRTracker.OnMouseDown
            End If
        
        End If

    End If
    
End Sub
'
'Move the rotation tracker:
'
Private Sub UIToolControl1_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)

    If (button = 1) Then
    
        If Not pRTracker Is Nothing Then
        
            Dim pMxDoc As IMxDocument
            Dim pDisplay As IScreenDisplay
            
            Set pMxDoc = Application.Document
            Set pDisplay = pMxDoc.ActiveView.ScreenDisplay
            
            Dim pPoint As IPoint
            Set pPoint = pDisplay.DisplayTransformation.ToMapPoint(x, y)
            pRTracker.OnMouseMove pPoint
            
        End If
    
    End If
    
End Sub

'
'Update the angle graphic:
'
Private Sub UIToolControl1_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)

    'Re-display graphic if being rotated:
    If (button = 1) Then
    
        If (Not pRTracker Is Nothing) Then
        
            If pRTracker.OnMouseUp = True Then
                 
                'This just uses the ITransform2d to rotate the graphic (see earlier code):
'                Call mod_Angles.Update_Angle_Graphic(pRTracker.Angle)
                
            End If
        
        End If
  
    End If

End Sub