main.frm

MapX示例程序：编辑特征示例

        Exit Sub
    End If
    
    Dim lyr As MapXLib.Layer
    Dim bSeen As Boolean
    Dim fs As MapXLib.Features
    Dim f As MapXLib.Feature
    If ToolNum = CUSTOM_SELECT_BY_REGION_TOOL Then
        Dim iSearchType As Integer
        '搜索方式
        Select Case Combo1.ListIndex
            Case 0
                iSearchType = miSearchTypePartiallyWithin
            Case 1
                iSearchType = miSearchTypeEntirelyWithin
            Case 2
                iSearchType = miSearchTypeCentroidWithin
        End Select
        
        '建立多边形
        Set f = Map1.FeatureFactory.CreateRegion(Points)
        
        bRefresh = False
        '遍历Layers图层,搜索其中的地理特征
        For Each lyr In Map1.Layers
            '确定在此视野下,当前图层是否可见
            If lyr.Visible Then
                If Not lyr.ZoomLayer Then
                    bSeen = True
                Else
                    '图层设置了放大显示因子,判断图层是否可见
                    If Map1.Zoom >= lyrZoomMin And _
                        Map1.Zoom <= lyr.ZoomMax Then
                        bSeen = True
                    Else
                        bSeen = False
                    End If
                End If
            Else
                bSeen = False
            End If
                
            '若图层可见,则开始搜索
            If bSeen Then
                '调用SearchWithinFeature方法获取Features集合
                Set fs = lyr.SearchWithinFeature(f, iSearchType)
                '根据Shift按键和Ctrl按键的情况,确定如何生成Selection集合
                If Shift And Not Ctrl Then
                    'Shift键按下,向已有选择集中添加当前选择
                    Call lyr.Selection.Add(fs)
                ElseIf Not Shift And Ctrl Then
                    'Ctrl键按下,从已有选择集中排除当前选择
                    Call lyr.Selection.Remove(fs)
                Else
                    '新Selection集合
                    lyr.Selection.ClearSelection
                    Call lyr.Selection.Add(fs)
                End If
            End If
        Next
        bRefresh = True
        Call ShowSelectionInfo
    End If
        
End Sub

Private Sub Map1_SelectionChanged()
    '选择集合被改变,刷新TreeView中的数据
    If bRefresh = True Then Call ShowSelectionInfo
End Sub
Private Sub ShowSelectionInfo()
    '在TreeView中显示各个图层的当前选择集
    Dim lyr As MapXLib.Layer
    Dim f As MapXLib.Feature
    Dim nodex As Node
    
    itemBox.Nodes.Clear
    '遍历Layers集合,将每层被选择的地理特征填入TreeView
    For Each lyr In Map1.Layers
        If lyr.Selection.Count > 0 Then
            Set nodex = itemBox.Nodes.Add(Key:=lyr.Name, Text:=lyr.Name)
            For Each f In lyr.Selection
                itemBox.Nodes.Add nodex, tvwChild, nodex.Key & f.Name, f.Name
            Next
            nodex.Expanded = True
        End If
    Next
End Sub

Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, _
                          ByVal Y1 As Double, ByVal X2 As Double, _
                          ByVal Y2 As Double, ByVal Distance As Double, _
                          ByVal Shift As Boolean, ByVal Ctrl As Boolean, _
                          EnableDefault As Boolean)

    Dim lyr As MapXLib.Layer
    Dim bSeen As Boolean
    Dim fs As MapXLib.Features
    Dim pt As New MapXLib.Point
    
    '点选择和圆形选择
    If ToolNum = CUSTOM_SEARCH_BY_POINT_TOOL Or _
        ToolNum = CUSTOM_SEARCH_WITHIN_DISTANCE_TOOL Then
        Dim iSearchType As Integer
        Dim dDistance As Double
        '确定搜索方式
        Select Case Combo1.ListIndex
            Case 0
                iSearchType = miSearchTypePartiallyWithin
            Case 1
                iSearchType = miSearchTypeEntirelyWithin
            Case 2
                iSearchType = miSearchTypeCentroidWithin
        End Select
        
        '若是圆形选择,计算半径
        dDistance = Map1.Distance(X1, Y1, X2, Y2)
        '生成搜索中心点
        pt.Set X1, Y1
        bRefresh = False
        '遍历Layers图层,搜索其中的地理特征
        For Each lyr In Map1.Layers
            '确定在此视野下,当前图层是否可见
            If lyr.Visible Then
                If Not lyr.ZoomLayer Then
                    bSeen = True
                Else
                    '图层设置了放大显示因子,判断图层是否可见
                    If Map1.Zoom >= lyrZoomMin And Map1.Zoom <= lyr.ZoomMax Then
                        bSeen = True
                    Else
                        bSeen = False
                    End If
                End If
            Else
                bSeen = False
            End If
                
            '若图层可见,则开始搜索
            If bSeen Then
                If ToolNum = CUSTOM_SEARCH_BY_POINT_TOOL Then
                    '点搜索
                    Set fs = lyr.SearchAtPoint(pt)
                Else
                    '圆形搜索
                    Set fs = lyr.SearchWithinDistance(pt, dDistance, _
                                                    miUnitMile, iSearchType)
                End If
                '根据Shift按键和Ctrl按键的情况,确定如何生成Selection集合
                If Shift And Not Ctrl Then
                    'Shift键按下,向已有选择集中添加当前选择
                    Call lyr.Selection.Add(fs)
                ElseIf Not Shift And Ctrl Then
                    'Ctrl键按下,从已有选择集中排除当前选择
                    Call lyr.Selection.Remove(fs)
                Else
                    '新Selection集合
                    lyr.Selection.ClearSelection
                    Call lyr.Selection.Add(fs)
                End If
            End If
        Next
        bRefresh = True
        Call ShowSelectionInfo
    ElseIf ToolNum = CUSTOM_SELECT_BY_RECT_TOOL Then
        '矩形选择
        Dim iSelectType As Integer
        
        If Shift And Not Ctrl Then
            'Shift键按下,向已有选择集中添加当前选择
            iSelectType = miSelectionAppend
        ElseIf Ctrl And Not Shift Then
            'Ctrl键按下，从已有选择集中排除当前选择
            iSelectType = miSelectionRemove
        Else
            '新Selection集合
            iSelectType = miSelectionNew
        End If
        
        bRefresh = False
        '遍历Layers图层,搜索其中的地里特征
        For Each lyr In Map1.Layers
            '确定在此视野下,当前图层是否可见
            If lyr.Visible Then
                If Not lyr.ZoomLayer Then
                    bSeen = True
                Else
                    '图层设置了放大显示因子,判断图层是否可见
                    If Map1.Zoom >= lyr.ZoomMin And Map1.Zoom <= lyr.ZoomMax Then
                        bSeen = True
                    Else
                        bSeen = False
                    End If
                End If
            Else
                bSeen = False
            End If
            
            '若图层可见,则开始搜索
            If bSeen Then
                '注意，这里和上面点选、多边形选择不同
                '这里使用Selection的SelectByRectangle方法直接生成选择集
                lyr.Selection.SelectByRectangle X1, Y1, X2, Y2, iSelectType
            End If
        Next
        bRefresh = True
        Call ShowSelectionInfo
    End If

End Sub

Private Sub mnuClear_Click()
    Dim lyr As MapXLib.Layer
    '清除选择
    For Each lyr In Map1.Layers
        lyr.Selection.ClearSelection
    Next
End Sub

Private Sub mnuCusPoint_Click()
    '点选功能
    Map1.CurrentTool = CUSTOM_SEARCH_BY_POINT_TOOL
End Sub

Private Sub mnuCusPolygon_Click()
    '多边形选择
    Map1.CurrentTool = CUSTOM_SELECT_BY_REGION_TOOL
End Sub

Private Sub mnuCusRadius_Click()
    '圆形选择
    Map1.CurrentTool = CUSTOM_SEARCH_WITHIN_DISTANCE_TOOL
End Sub

Private Sub mnuCusRectangle_Click()
    '矩形选择
    Map1.CurrentTool = CUSTOM_SELECT_BY_RECT_TOOL
End Sub

Private Sub mnuGlobe_Click()
    '全图显示功能
    Set Map1.Bounds = Map1.Layers.Bounds
End Sub

Private Sub mnuPan_Click()
    '平移功能
    Map1.CurrentTool = miPanTool
End Sub

Private Sub mnuPoint_Click()
    '点选功能
    Map1.CurrentTool = miSelectTool
End Sub

Private Sub mnuPolygon_Click()
    '多边形选择
    Map1.CurrentTool = miPolygonSelectTool
End Sub

Private Sub mnuRadius_Click()
    '圆形选择
    Map1.CurrentTool = miRadiusSelectTool
End Sub

Private Sub mnuRectangle_Click()
    '矩形选择
    Map1.CurrentTool = miRectSelectTool
End Sub

Private Sub mnuZoomIn_Click()
    '放大功能
    Map1.CurrentTool = miZoomInTool
End Sub

Private Sub mnuZoomOut_Click()
    '缩小功能
    Map1.CurrentTool = miZoomOutTool
End Sub