frmmdimap.frm

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

VERSION 5.00
Object = "{C552EA90-6FBB-11D5-A9C1-00104BB6FC1C}#1.0#0"; "MapControl.ocx"
Begin VB.Form frmMDIMap 
   Caption         =   "地图窗口"
   ClientHeight    =   4050
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5490
   ControlBox      =   0   'False
   Icon            =   "frmMdiMap.frx":0000
   MDIChild        =   -1  'True
   ScaleHeight     =   4050
   ScaleWidth      =   5490
   WindowState     =   2  'Maximized
   Begin VB.Timer Timer1 
      Interval        =   1
      Left            =   2040
      Top             =   3480
   End
   Begin esriMapControl.MapControl MapControl 
      Height          =   3975
      Left            =   360
      OleObjectBlob   =   "frmMdiMap.frx":000C
      TabIndex        =   0
      Top             =   -720
      Width           =   5415
   End
End
Attribute VB_Name = "frmMDIMap"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private m_pFeedbackEnv As INewEnvelopeFeedback
Private m_pPoint As IPoint
Private m_bIsMouseDown As Boolean


Private m_bInUse As Boolean
Private m_pLineSymbol As ILineSymbol
Private m_pLinePolyline As IPolyline
Private m_pTextSymbol As ITextSymbol
Private m_pStartPoint As IPoint
Private m_pTextPoint As IPoint

Private tjh  As Integer



Private Sub Form_Resize()
  If Me.WindowState <> vbMinimized Then
        MapControl.Left = 0
        MapControl.Height = Me.Height
        MapControl.Top = 0
        MapControl.Width = Me.Width
        MapControl.refresh
        'refresh
    End If
    frmMDIMap.MapControl.refresh
End Sub

Private Sub MapControl_OnDoubleClick(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_bSketching Then EndSketch
End Sub

Private Sub MapControl_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
   Dim objEnvelope As IEnvelope
   Dim pPoint As IPoint
   Dim pActiveView As IActiveView
   Set pActiveView = MapControl.ActiveView.FocusMap
   Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y) ''''
   Dim i As Long, j As Long
   Select Case m_CheckOperate
       Case isZoomOut
           Set objEnvelope = MapControl.TrackRectangle
           MapControl.Extent = objEnvelope
       Case isZoomIn
            Set objEnvelope = MapControl.Extent
            objEnvelope.Expand 2, 2, True
            MapControl.Extent = objEnvelope
       Case isZoomPan
           MapControl.Pan
       Case isZoomFull
           MapControl.Extent = MapControl.FullExtent
       Case isQuery
'         Set objEnvelope = New Envelope
'         objEnvelope.XMax = pPoint.X + 0.0001
'         objEnvelope.XMin = pPoint.X - 0.0001
'         objEnvelope.YMin = pPoint.Y - 0.0001
'         objEnvelope.YMax = pPoint.Y + 0.0001
'         objEnvelope.CenterAt pPoint
'         Dim objSelEnv As ISelectionEnvironment
'         Set objSelEnv = New SelectionEnvironment ' SelectionEnvironmentClass
'
'         objSelEnv.PointSelectionMethod = 2 'esriSpatialRelEnum.esriSpatialRelIntersects
'         objSelEnv.PointSearchDistance = 0
'
'         objSelEnv.LinearSelectionMethod = esriSpatialRelEnum.esriSpatialRelIndexIntersects
'         objSelEnv.LinearSearchDistance = 2
'
'         objSelEnv.AreaSelectionMethod = esriSpatialRelEnum.esriSpatialRelIntersects
'         objSelEnv.AreaSearchDistance = 2
'
'         objSelEnv.SearchTolerance = 0
'         Dim pMap As IMap
'         Set pMap = frmMDIMap.MapControl.ActiveView.FocusMap
'         pMap.SelectByShape objEnvelope, objSelEnv, False
'
'         'If pMap.SelectionCount > 0 Then
'            MsgBox pMap.SelectionCount
'         'End If
'         'm_HookHelper.FocusMap.SelectByShape((IGeometry)pPoint,objSelEnv,false)
'         frmMDIMap.mapcontrol.refresh esriViewGeoSelection
'         Set objEnvelope = Nothing
'         Set objSelEnv = Nothing

            '''''''''''''''''''''''''''''''''''''''''''''''''''
            Dim pIdentify As IIdentify
            Dim pIDArray As IArray
            Dim pFeatIdObj As IFeatureIdentifyObj
            Dim pIdObj As IIdentifyObj
             Dim pDT As IDisplayTransformation
            Set pDT = pActiveView.ScreenDisplay.DisplayTransformation
            
            Set pPoint = pDT.ToMapPoint(x, y)
            Dim pEnv As IEnvelope
            Set pEnv = pPoint.Envelope
            ' expand the envelope 1/50th of the visible screen width
            pEnv.Expand (pDT.VisibleBounds.Width / (4 * Screen.TwipsPerPixelX)), _
                        (pDT.VisibleBounds.Height / (4 * Screen.TwipsPerPixelY)), False
            ReDim M_pFeatureArray(0)
            For i = 0 To frmMDIMap.MapControl.LayerCount - 1
                    Set pIdentify = frmMDIMap.MapControl.Layer(i)
                    Set pIDArray = pIdentify.Identify(pEnv)
        
                    '''''''''''''''''''''''''''''''''''''''''''
                    'Get the FeatureIdentifyObject
                    If Not pIDArray Is Nothing Then
                    
                            For j = 0 To pIDArray.count - 1
                                    ReDim Preserve M_pFeatureArray(UBound(M_pFeatureArray) + 1)
                                    Set pFeatIdObj = pIDArray.Element(j)
                                    Set pIdObj = pFeatIdObj
                                    Dim pRowObj As IRowIdentifyObject
                                    Dim pFeature As iFeature
                                    Set pRowObj = pFeatIdObj
                                    Set pFeature = pRowObj.Row
                                    Set M_pFeatureArray(UBound(M_pFeatureArray) - 1).iFeature = pFeature
                                    M_pFeatureArray(UBound(M_pFeatureArray) - 1).iLayerName = CStr(pIdObj.Layer.name)
                            Next j
                      ''''''''''''''''''''''''''''
                     ' pIdObj.Flash pActiveView.ScreenDisplay
                     'Report info from FeatureIdentifyObject
                     'MsgBox "Layer:" & pIdObj.Layer.name & vbNewLine & "Feature:" & pIdObj.name
                    Else
                             'MsgBox "No feature identified."
                    End If
              Next i
             '''''''''''''''''''''''''''''''''''''''''''''''''
             If frmIdentify.Visible = False Then
                frmIdentify.Show 0
             Else
                frmIdentify.SetFocus
             End If
             Call frmIdentify.InitTreeView
    Case isEditTask
    
       '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        m_pMap.ClearSelection
  
        If m_bSketching Then
          SketchMouseDown x, y
        ElseIf m_bSelecting Then
          SelectMouseDown x, y
        ElseIf m_bEditingFtr Then
          EditFeature x, y
        Else
          ' Zoom in/out depending on which button was pressed
         ' Dim pActiveView As IActiveView
          Set pActiveView = m_pMap
          Dim pEnvelope As IEnvelope
          Set pEnvelope = pActiveView.Extent
          Dim p As New Point
          Dim ip As IPoint
          Set ip = p
          ip.x = mapX
          ip.y = mapY
          pEnvelope.CenterAt ip
          If button = vbRightButton Then
            pEnvelope.Expand 2, 2, True
          Else
            pEnvelope.Expand 0.5, 0.5, True
          End If
          pActiveView.Extent = pEnvelope
          pActiveView.refresh
        End If
      Case isSelect
            Set pActiveView = frmMDIMap.MapControl.ActiveView.FocusMap
            'Store current point, set mousedown flag
            Set m_pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
            m_bIsMouseDown = True
      Case isMeasure
            m_bInUse = True
            'Get point to measure distance from
            Set m_pStartPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
     End Select
    
       frmMDIMain.ActiveBar.Bands("ToolsBarFile").Tools("BarFileCheckView").Text = "1:" + CStr(Int(MapControl.MapScale))
       frmMDIMain.ActiveBar.refresh
       
End Sub

Private Sub MapControl_OnMouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
        
        Dim pPoint As IPoint
        Dim pActiveView As IActiveView
        Set pActiveView = MapControl.ActiveView.FocusMap
        Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y) ''''
   
        frmMDIMain.ActiveBar.Bands("StatusBar").Tools("StatusBarCoor").Caption = CStr(Format(pPoint.x, "#.00")) + " " + CStr(Format(pPoint.y, "#.00")) + " " + CStr(MapControl.MapUnits)
        frmMDIMain.ActiveBar.refresh
        
        Select Case m_CheckOperate
           Case isEditTask
                If m_bSketching Then
                  SketchMouseMove x, y
                ElseIf m_bEditingFtr Then
                  FtrEditMouseMove x, y
                End If