frmmdimap.frm

ArcEngine 这是基于AE组件的源代码

           Case isSelect
                  
                  If m_bIsMouseDown = True Then
                      ' Create a rubber banding box, if it hasn't been created already
                      If (m_pFeedbackEnv Is Nothing) Then
                        Set m_pFeedbackEnv = New NewEnvelopeFeedback
                        Set m_pFeedbackEnv.Display = pActiveView.ScreenDisplay
                        m_pFeedbackEnv.Start m_pPoint
                      End If
                      
                      'Store current point, and use to move rubberband
                      Set m_pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
                      m_pFeedbackEnv.MoveTo m_pPoint
                   End If
            Case isMeasure
                  
                  If (Not m_bInUse) Then Exit Sub
                  
                  Dim bfirstTime As Boolean
                  If (m_pLineSymbol Is Nothing) Then bfirstTime = True
                    
                  'Get current point
                  'Dim pPoint As IPoint
                  Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
                  
                  pActiveView.ScreenDisplay.StartDrawing pActiveView.ScreenDisplay.hDC, -1
                    
                  If bfirstTime Then
                    Dim pRgbColor As IRgbColor
                    Dim pSymbol As ISymbol
                    Dim pFont As IFontDisp
                    
                    'Line Symbol
                    Set m_pLineSymbol = New SimpleLineSymbol
                    m_pLineSymbol.Width = 2
                    Set pRgbColor = New RgbColor
                    With pRgbColor
                      .Red = 223
                      .Green = 223
                      .Blue = 223
                    End With
                    m_pLineSymbol.color = pRgbColor
                    Set pSymbol = m_pLineSymbol
                    pSymbol.ROP2 = esriROPXOrPen
                    
                    'Text Symbol
                    Set m_pTextSymbol = New TextSymbol
                    m_pTextSymbol.HorizontalAlignment = esriTHACenter
                    m_pTextSymbol.VerticalAlignment = esriTVACenter
                    m_pTextSymbol.SIZE = 16
                    Set pSymbol = m_pTextSymbol
                    Set pFont = m_pTextSymbol.Font
                    pFont.name = "Arial"
                    pSymbol.ROP2 = esriROPXOrPen
                    
                    'Create point to draw text in
                    Set m_pTextPoint = New Point
                    
                  Else
                    'Use existing symbols and draw existing text and polyline
                    pActiveView.ScreenDisplay.SetSymbol m_pTextSymbol
                    pActiveView.ScreenDisplay.DrawText m_pTextPoint, m_pTextSymbol.Text
                    pActiveView.ScreenDisplay.SetSymbol m_pLineSymbol
                    If (m_pLinePolyline.length > 0) Then _
                      pActiveView.ScreenDisplay.DrawPolyline m_pLinePolyline
                  End If
                
                  'Get line between from and to points, and angle for text
                  Dim pLine As ILine
                  Set pLine = New esriGeometry.Line
                  pLine.PutCoords m_pStartPoint, pPoint
                  Dim angle As Double
                  angle = pLine.angle
                  angle = angle * (180# / 3.14159)
                  If ((angle > 90#) And (angle < 180#)) Then
                    angle = angle + 180#
                  ElseIf ((angle < 0#) And (angle < -90#)) Then
                    angle = angle - 180#
                  ElseIf ((angle < -90#) And (angle > -180)) Then
                    angle = angle - 180#
                  ElseIf (angle > 180) Then
                    angle = angle - 180#
                  End If
                
                
                  'For drawing text, get text(distance), angle, and point
                  Dim deltaX As Double
                  Dim deltaY As Double
                  Dim distance As Double
                  deltaX = pPoint.x - m_pStartPoint.x
                  deltaY = pPoint.y - m_pStartPoint.y
                  m_pTextPoint.x = m_pStartPoint.x + deltaX / 2#
                  m_pTextPoint.y = m_pStartPoint.y + deltaY / 2#
                  m_pTextSymbol.angle = angle
                  distance = Round(Sqr((deltaX * deltaX) + (deltaY * deltaY)), 3)
                  m_pTextSymbol.Text = "[" & distance & "]"
                  
                  'Draw text
                  pActiveView.ScreenDisplay.SetSymbol m_pTextSymbol
                  pActiveView.ScreenDisplay.DrawText m_pTextPoint, m_pTextSymbol.Text
                  
                  
                  'Get polyline with blank space for text
                  Dim pPolyline As IPolyline
                  Set pPolyline = New Polyline
                  Dim pSegColl As ISegmentCollection
                  Set pSegColl = pPolyline
                  pSegColl.AddSegment pLine
                  Set m_pLinePolyline = GetSmashedLine(pActiveView.ScreenDisplay, m_pTextSymbol, m_pTextPoint, pPolyline)
                  
                  'Draw polyline
                  pActiveView.ScreenDisplay.SetSymbol m_pLineSymbol
                  If (m_pLinePolyline.length > 0) Then _
                    pActiveView.ScreenDisplay.DrawPolyline m_pLinePolyline
                  
                  pActiveView.ScreenDisplay.FinishDrawing

            Case isTip
                      If isCheckTip = 0 Then Exit Sub
                      If Not TypeOf frmMDIMap.MapControl.Layer(isCheckTipListIndex) Is IFeatureLayer Then Exit Sub
                    
                      'Get ILayer interface
                      Dim player As ILayer
                      Set player = frmMDIMap.MapControl.Layer(isCheckTipListIndex)
                      'Set the MapControl tooltiptext to that of the layers
                      frmMDIMap.MapControl.ToolTipText = player.TipText(mapX, mapY, frmMDIMap.MapControl.Extent.Width / 100)
        End Select
        
        
End Sub

Private Sub MapControl_OnMouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
        If m_CheckOperate = isEditTask Then
              If m_bEditingFtr Then EndFtrEdit x, y
              Exit Sub
        End If
        If m_CheckOperate = isSelect Then
              Dim pEnv As IEnvelope
              Dim pActiveView As IActiveView
              Set pActiveView = MapControl.ActiveView.FocusMap
             ' Refresh the selections
              pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
              ' If user dragged an envelope...
              If (Not m_pFeedbackEnv Is Nothing) Then
                'Use it to calculate new extent
                Set pEnv = m_pFeedbackEnv.Stop
                ' Select all feature that intersect with that shape
                MapControl.ActiveView.FocusMap.SelectByShape pEnv, Nothing, False
              ' Else...
              Else
                ' Select by point
                MapControl.ActiveView.FocusMap.SelectByShape m_pPoint, Nothing, False
              End If
              ' Refresh the selections
              pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
              'Reset rubberband and mousedown state
              Set m_pFeedbackEnv = Nothing
              m_bIsMouseDown = False
              Exit Sub
        End If
        If m_CheckOperate = isMeasure Then
                If (Not m_bInUse) Then Exit Sub
                m_bInUse = False
                
                If (m_pLineSymbol Is Nothing) Then Exit Sub
            
                'Dim pActiveView As IActiveView
                Set pActiveView = MapControl.ActiveView.FocusMap
              
                'Draw measure line and text
                pActiveView.ScreenDisplay.StartDrawing pActiveView.ScreenDisplay.hDC, -1
                pActiveView.ScreenDisplay.SetSymbol m_pTextSymbol
                pActiveView.ScreenDisplay.DrawText m_pTextPoint, m_pTextSymbol.Text
                pActiveView.ScreenDisplay.SetSymbol m_pLineSymbol
                If (m_pLinePolyline.length > 0) Then pActiveView.ScreenDisplay.DrawPolyline m_pLinePolyline
                pActiveView.ScreenDisplay.FinishDrawing
                
                Set m_pTextSymbol = Nothing
                Set m_pTextPoint = Nothing
                Set m_pLinePolyline = Nothing
                Set m_pLineSymbol = Nothing
        End If
End Sub

Private Function GetSmashedLine(pDisplay As IScreenDisplay, pTextSymbol As ISymbol, pPoint As IPoint, pPolyline As IPolyline) As IPolyline
  'Returns a Polyline with a blank space for the text to go in
  Dim pSmashed As IPolyline
  Dim pBoundary As IPolygon
  Set pBoundary = New Polygon
  pTextSymbol.QueryBoundary pDisplay.hDC, pDisplay.DisplayTransformation, pPoint, pBoundary
  Dim pTopo As ITopologicalOperator
  Set pTopo = pBoundary
  
  Dim pIntersect As IPolyline
  Set pIntersect = pTopo.Intersect(pPolyline, esriGeometry1Dimension)
  Set pTopo = pPolyline
  Set GetSmashedLine = pTopo.Difference(pIntersect)
End Function

'Private Sub Timer1_Timer()
'
'  Dim pGraphicsContainer As IGraphicsContainer
'  Dim pElement As IElement
'   Dim pPoint As IPoint
'   Set pPoint = New Point
'  Dim pActiveView As IActiveView
'  Dim pMap As iMap
'  Set pMap = frmMDIMap.MapControl.ActiveView.FocusMap
'  Set pActiveView = pMap
'  Set pGraphicsContainer = pMap.BasicGraphicsLayer
'  'Set pArea = pActiveView.Extent
'  'Call the MakeATextElement function passing in the centroid of the Map Extent and a string for the text    'A TextElement will be passed back
'pPoint.x = pActiveView.Extent.xmin + pActiveView.Extent.Width / 2 + tjh
'pPoint.y = pActiveView.Extent.ymin + pActiveView.Extent.Height / 2
'pPoint.PutCoords pActiveView.Extent.xmin + pActiveView.Extent.Width / 2 + tjh, pActiveView.Extent.ymin + pActiveView.Extent.Height / 2
''
''  tjh = tjh + 10
''  pElement.Geometry = pPoint
''  'Set pElement = MakeATextElement(pArea.Centroid, "Sample Text")        'Add the newly created element to the map
''  pGraphicsContainer.AddElement pElement, 0
''  pActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing   'refresh
'
'  frmMDIMap.MapControl.Extent = frmMDIMap.MapControl.FullExtent
'  frmMDIMap.MapControl.CenterAt pPoint
'
'  frmMDIMap.MapControl.refresh esriViewGraphics
'End Sub