emme2 plugin.frm

一个交通专用的gis-T系统

            mnuToolsPan.Checked = False
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = False
            mnuToolsSelectRectangle.Checked = False
            mnuToolsSelectRadius.Checked = False
            mnuToolsSelectPolygon.Checked = False
            mnuToolsLabel.Checked = False
            mnuToolsAddSymbolAnnotation.Checked = True
            mnuToolsAddTextAnnotation.Checked = False
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(16).Value = tbrPressed
                Toolbar1.Refresh
    
End Sub

Private Sub mnuToolsAddTextAnnotation_Click()

    Mapshow.CurrentTool = miTextTool
    
            mnuToolsArrow.Checked = False
            mnuToolsZoomIn.Checked = False
            mnuToolsZoomOut.Checked = False
            mnuToolsPan.Checked = False
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = False
            mnuToolsSelectRectangle.Checked = False
            mnuToolsSelectRadius.Checked = False
            mnuToolsSelectPolygon.Checked = False
            mnuToolsLabel.Checked = False
            mnuToolsAddSymbolAnnotation.Checked = False
            mnuToolsAddTextAnnotation.Checked = True
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(17).Value = tbrPressed
                Toolbar1.Refresh
    
End Sub

Private Sub mnuToolsAnnotationsRemoveAll_Click()
    Mapshow.Annotations.RemoveAll
End Sub

Private Sub mnuToolsArrow_Click()

    Toolbar1.Refresh
    Mapshow.CurrentTool = miArrowTool
    
    
    
            mnuToolsArrow.Checked = True
            mnuToolsZoomIn.Checked = False
            mnuToolsZoomOut.Checked = False
            mnuToolsPan.Checked = False
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = False
            mnuToolsSelectRectangle.Checked = False
            mnuToolsSelectRadius.Checked = False
            mnuToolsSelectPolygon.Checked = False
            mnuToolsLabel.Checked = False
            mnuToolsAddSymbolAnnotation.Checked = False
            mnuToolsAddTextAnnotation.Checked = False
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(6).Value = tbrPressed
                Toolbar1.Refresh
                
            
            
End Sub

Private Sub mnuToolsLabel_Click()

    Mapshow.CurrentTool = miLabelTool
    
            mnuToolsArrow.Checked = False
            mnuToolsZoomIn.Checked = False
            mnuToolsZoomOut.Checked = False
            mnuToolsPan.Checked = False
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = False
            mnuToolsSelectRectangle.Checked = False
            mnuToolsSelectRadius.Checked = False
            mnuToolsSelectPolygon.Checked = False
            mnuToolsLabel.Checked = True
            mnuToolsAddSymbolAnnotation.Checked = False
            mnuToolsAddTextAnnotation.Checked = False
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(15).Value = tbrPressed
                Toolbar1.Refresh
    
End Sub

Private Sub mnuToolsPan_Click()

    Mapshow.CurrentTool = miPanTool
    
            mnuToolsArrow.Checked = False
            mnuToolsZoomIn.Checked = False
            mnuToolsZoomOut.Checked = False
            mnuToolsPan.Checked = True
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = False
            mnuToolsSelectRectangle.Checked = False
            mnuToolsSelectRadius.Checked = False
            mnuToolsSelectPolygon.Checked = False
            mnuToolsLabel.Checked = False
            mnuToolsAddSymbolAnnotation.Checked = False
            mnuToolsAddTextAnnotation.Checked = False
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(9).Value = tbrPressed
                Toolbar1.Refresh
    
End Sub


Private Sub mnuToolsSelect_Click()

    Mapshow.CurrentTool = miSelectTool
    frmSelectionWindow.Show   '显示选择窗口
    
            mnuToolsArrow.Checked = False
            mnuToolsZoomIn.Checked = False
            mnuToolsZoomOut.Checked = False
            mnuToolsPan.Checked = False
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = True
            mnuToolsSelectRectangle.Checked = False
            mnuToolsSelectRadius.Checked = False
            mnuToolsSelectPolygon.Checked = False
            mnuToolsLabel.Checked = False
            mnuToolsAddSymbolAnnotation.Checked = False
            mnuToolsAddTextAnnotation.Checked = False
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(11).Value = tbrPressed
                Toolbar1.Refresh
 
End Sub

Private Sub mnuToolsSelectPolygon_Click()

    Mapshow.CurrentTool = miPolygonSelectTool

            mnuToolsArrow.Checked = False
            mnuToolsZoomIn.Checked = False
            mnuToolsZoomOut.Checked = False
            mnuToolsPan.Checked = False
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = False
            mnuToolsSelectRectangle.Checked = False
            mnuToolsSelectRadius.Checked = False
            mnuToolsSelectPolygon.Checked = True
            mnuToolsLabel.Checked = False
            mnuToolsAddSymbolAnnotation.Checked = False
            mnuToolsAddTextAnnotation.Checked = False
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(14).Value = tbrPressed
                Toolbar1.Refresh
    
End Sub

Private Sub mnuToolsSelectRadius_Click()

    Mapshow.CurrentTool = miRadiusSelectTool
            mnuToolsArrow.Checked = False
            mnuToolsZoomIn.Checked = False
            mnuToolsZoomOut.Checked = False
            mnuToolsPan.Checked = False
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = False
            mnuToolsSelectRectangle.Checked = False
            mnuToolsSelectRadius.Checked = True
            mnuToolsSelectPolygon.Checked = False
            mnuToolsLabel.Checked = False
            mnuToolsAddSymbolAnnotation.Checked = False
            mnuToolsAddTextAnnotation.Checked = False
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(13).Value = tbrPressed
                Toolbar1.Refresh
    
End Sub

Private Sub mnuToolsSelectRectangle_Click()

    Mapshow.CurrentTool = miRectSelectTool
    
            mnuToolsArrow.Checked = False
            mnuToolsZoomIn.Checked = False
            mnuToolsZoomOut.Checked = False
            mnuToolsPan.Checked = False
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = False
            mnuToolsSelectRectangle.Checked = True
            mnuToolsSelectRadius.Checked = False
            mnuToolsSelectPolygon.Checked = False
            mnuToolsLabel.Checked = False
            mnuToolsAddSymbolAnnotation.Checked = False
            mnuToolsAddTextAnnotation.Checked = False
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(12).Value = tbrPressed
                Toolbar1.Refresh
    
End Sub

Private Sub mnuToolsZoomIn_Click()

    Toolbar1.Refresh
    Mapshow.CurrentTool = miZoomInTool
    
            mnuToolsArrow.Checked = False
            mnuToolsZoomIn.Checked = True
            mnuToolsZoomOut.Checked = False
            mnuToolsPan.Checked = False
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = False
            mnuToolsSelectRectangle.Checked = False
            mnuToolsSelectRadius.Checked = False
            mnuToolsSelectPolygon.Checked = False
            mnuToolsLabel.Checked = False
            mnuToolsAddSymbolAnnotation.Checked = False
            mnuToolsAddTextAnnotation.Checked = False
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(7).Value = tbrPressed
                Toolbar1.Refresh
    
End Sub

Private Sub mnuToolsZoomOut_Click()


    Mapshow.CurrentTool = miZoomOutTool
    
            mnuToolsArrow.Checked = False
            mnuToolsZoomIn.Checked = False
            mnuToolsZoomOut.Checked = True
            mnuToolsPan.Checked = False
            mnuToolsRuler.Checked = False
            mnuToolsSelect.Checked = False
            mnuToolsSelectRectangle.Checked = False
            mnuToolsSelectRadius.Checked = False
            mnuToolsSelectPolygon.Checked = False
            mnuToolsLabel.Checked = False
            mnuToolsAddSymbolAnnotation.Checked = False
            mnuToolsAddTextAnnotation.Checked = False
            
            Dim i
            For i = 1 To 25
                Toolbar1.Buttons(i).Value = tbrUnpressed
            Next i
                Toolbar1.Buttons(8).Value = tbrPressed
                Toolbar1.Refresh
    
End Sub

Private Sub Mapshow_PolyToolUsed(ByVal ToolNum As Integer, ByVal Flags As Long, ByVal Points As Object, ByVal bShift As Boolean, ByVal bCtrl As Boolean, EnableDefault As Boolean)
'if CTRL is pressed, then smooth the polyline
Dim i, j
Dim lyrLine As Layer
Dim LyrNode As Layer
Dim frmRoute As Form
Dim iRtn As Integer
Dim sLXID As String   '新建路线编号
Dim iID As Integer    '新建路段编号
Dim iFlag As Integer


Dim Ftrs1 As Features
Dim ftrs2 As Features
Dim dLen As Double
Dim pnt1 As Point
Dim pnt2 As Point
Dim ftrNode1 As Feature
Dim ftrNode2 As Feature
Dim iNodeID1 As Integer
Dim iNodeID2 As Integer
Dim lyrTemp As Layer
Dim FtrTemp As Feature

Set lyrLine = Mapshow.Layers("Link")
Set LyrNode = Mapshow.Layers("Node")

If ToolNum = myNewRouteToolID Then    '添加工具

    If Flags = miPolyToolBegin Then

    ElseIf Flags = miPolyToolEnd And Points.Count >= 2 Then  'Debug.Print "end"
        
        f.Attach Mapshow
        f.Type = miFeatureTypeLine
        f.Style.LineStyle = 9
        f.Style.LineColor = LinkColor
        f.Style.LineWidth = LinkWidth
        f.Parts.Add Points

        If bCtrl And Points.Count > 2 Then     '如果按下CTRL键,且所画为折线则平滑处理
            f.Smooth = True
        End If
        
        '查找路线的起终点是否有节点存在
        Set pnt1 = Points(1)
        Set pnt2 = Points(Points.Count)
        iNodeID1 = 0  '初始值，若这样的节点不存在则为0，需要新建节点
        iNodeID2 = 0
        LyrNode.KeyField = "NodeID"

        Set Ftrs1 = LyrNode.SearchAtPoint(pnt1)
        
        If Ftrs1.Count = 1 Then   '存在，则选择此节点
            Set ftrNode1 = Ftrs1.Item(1)
            iNodeID1 = ftrNode1.KeyValue
         
        ElseIf Ftrs1.Count > 1 Then '两个节点重叠
            MsgBox "地图中存在两个重叠的节点，请检查NODE图层相关节点！"
            Exit Sub
        ElseIf Ftrs1.Count = 0 Then
                MsgBox ("路段起点不在有效的路网节点内，按确定重新绘制路段！")
                Exit Sub
        End If

        Set ftrs2 = LyrNode.SearchAtPoint(pnt2)
        If ftrs2.Count = 1 Then   '存在，则选择此节点

       
            
            Set ftrNode2 = ftrs2.Item(1)
            iNodeID2 = ftrNode2.KeyValue
            
            LinkStart = iNodeID1
            LinkEnd = iNodeID2
            
            Dim RS_addlink As Recordset
            Dim IMaxId
            Set RS_addlink = mDbBiblio.OpenRecordset("Links")
                    
            If RS_addlink.RecordCount > 0 Then
              RS_addlink.MoveLast
              IMaxId = RS_addlink!LinkId
            End If
            
            LinkIdNum = IMaxId + 1
            AddNewLinkFeature LinkIdNum, f, iFlag
            
            Load LinkFrm
            LinkFrm.Show
            
        ElseIf ftrs2.Count > 1 Then '两个节点重叠
            MsgBox "地图中存在两个重叠的节点，请检查NODE图层相关节点！"
            Exit Sub
        ElseIf ftrs2.Count = 0 Then
                MsgBox ("路段终点不在有效的路网节点内，按确定重新绘制路段！")
                Exit Sub
        End If

        
    ElseIf Flags = miPolyToolInProgress Then  'Debug.Print "In progress"
    ElseIf Flags = miPolyToolEndEscaped Then 'Debug.Print "escape"
    
    End If
 
ElseIf ToolNum = 101 Then    '标尺工具
    Static RulerWholeLongth As Single
    If Flags = miPolyToolBegin Then
       RulerWholeLongth = 0
    ElseIf Flags = miPolyToolEnd Then
        RulerWholeLongth = 0
    ElseIf Flags = miPolyToolInProgress Then

     Dim PointsNum As Integer
     'Dim RulerWholeLongth As Single

     Dim RulerLongth As Single


       PointsNum = Points.Count
    Mapshow.MapUnit = miUnitMeter

       RulerLongth = Mapshow.Distance(Points.Item(PointsNum - 1).x, Points.Item(PointsNum - 1).y, Points.Item(PointsNum).x, Points.Item(PointsNum).y)

       frmRuler.Label3.Caption = RulerLongth & "米"
       RulerWholeLongth = RulerWholeLongth + Val(frmRuler.Label3.Caption)
       frmRuler.Label4.Caption = Str(RulerWholeLongth) & "米"


    ElseIf Flags = miPolyToolEndEscaped Then

    End If


End If
    
    Set lyrLine = Nothing
    Set LyrNode = Nothing
    Set f = Nothing
    Set Ftrs1 = Nothing
    Set ftrs2 = Nothing
    Set pnt1 = Nothing
    Set pnt2 = Nothing
    Set ftrNode1 = Nothing
    Set ftrNode2 = Nothing
    Set lyrTemp = Nothing
    Set FtrTemp = Nothing

Exit Sub

NoSuccess:
    

    lyrTemp.DeleteFeature FtrTemp
    
    Set lyrLine = Nothing
    Set LyrNode = Nothing
    Set f = Nothing
    Set Ftrs1 = Nothing
    Set ftrs2 = Nothing
    Set pnt1 = Nothing
    Set pnt2 = Nothing
    Set ftrNode1 = Nothing
    Set ftrNode2 = Nothing
    Set lyrTemp = Nothing
    Set FtrTemp = Nothing
End Sub