?? emme2 plugin.frm

?? 一個交通專用的gis-T系統
?? FRM
?? 第 1 頁 / 共 4 頁
字號:
上一頁 1 2 34
            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
上一頁 1 2 34
?? 文件大小 1590 K
?? 上傳用戶 QQ
?? 所屬分類交通/航空行業
??? 相關標簽

#gis-T
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? emme2 plugin.frm

?? 快捷鍵說明
