frmmerestone.vb

界桩信息管理系统代码,VB写的。。。。。。。

        End If
    End Sub

    '--------------------------------------------------
    '   BrowseInfoFromMap:
    '       通过地图信息工具，查看界桩信息
    '   Paramters:
    '       [in]    X,Y     图元坐标
    '--------------------------------------------------
    Private Sub BrowseInfoFromMap(ByVal X As Double, ByVal Y As Double)
        Dim f As MapXLib.Feature
        Dim p As New MapXLib.Point
        Dim fs As MapXLib.Features
        Dim ftCount As Integer

        p.Set(X, Y)
        fs = AxMaps.Layers.Item(MapsConstants.LAYERNAME_MereStone).SearchAtPoint(p)

        If fs.Count > 0 Then
            f = fs.Item(1)
            QueryInfoFromMap(f)
            Exit Sub
        Else
            With UcMereStone1
                .MereStoneData.Clear()
                .ButtonEnable("init")
                .DataControlEnable(False)
            End With
        End If
    End Sub

    '--------------------------------------------------
    '   QueryInfoFromMap:
    '       通过地图图元，查询界桩信息窗口
    '   Paramters:
    '       [in]    f   图元
    '--------------------------------------------------
    Private Sub QueryInfoFromMap(ByVal f As MapXLib.Feature)
        Dim rvs As MapXLib.RowValues

        rvs = f.Layer.Datasets.Item(f.Layer.Name).RowValues(f)
        With UcMereStone1
            .QueryDataByMereStone_MapID(f.FeatureID)
            .DataControlEnable(True)
        End With
    End Sub

#End Region

    '---------------------------------------------------
    '   处理窗体 Load 事件。
    '   初始化功能相关的数据及默认操作等
    '---------------------------------------------------
    Private Sub FrmMereStone_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        AxMaps.Geoset = MAP_GEOSET
        AxMaps.Title.Visible = False
        BindingLayer()

        '向地图中插入图层
        AxMaps.Layers.Item(MapsConstants.LAYERNAME_MereStone).Editable = True
        AxMaps.Layers.InsertionLayer = AxMaps.Layers.Item(MapsConstants.LAYERNAME_MereStone)

        MereStoneTV.Init(ImgListTreeView)

        ArrowMapTool()
        CreateCustomTool()
    End Sub

    '---------------------------------------------------
    '   点击工具栏按钮时，处理点击按钮事件。
    '---------------------------------------------------
    Private Sub ToolBarMaps_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles ToolBarMaps.ButtonClick

        If e.Button Is TlBarBtnArrow Then ArrowMapTool() : Exit Sub

        If e.Button Is TlBarBtnZoomIn Then ZoomInMapTool() : Exit Sub

        If e.Button Is TlBarBtnZoomOut Then ZoomOutMapTool() : Exit Sub

        If e.Button Is TlBarBtnPan Then PanMapTool() : Exit Sub

        If e.Button Is TlBarBtnCstmlbl Then LabelMapTool() : Exit Sub

        If e.Button Is TlBarBtnSelect Then SeletMapTool() : Exit Sub

        If e.Button Is TlBarBtnRuler Then RulerMapTool() : Exit Sub

        If e.Button Is TlBarBtnInfo Then InfoMapTool() : Exit Sub

        If e.Button Is TlBarBtnCtrlLyrs Then AxMaps.Layers.LayersDlg() : Exit Sub

        '增加节点
        If e.Button Is ToolBarADDPoint Then
            AddMereStoneMapTool()
            'ToolBarADDPoint.Pushed = True
            AxMaps.FeatureEditMode = ADDNODE_MODE

            Exit Sub
        End If
    End Sub

    Private Sub AxMaps_ToolUsed(ByVal sender As System.Object, ByVal e As AxMapXLib.CMapXEvents_ToolUsedEvent) Handles AxMaps.ToolUsed

        '增加具体界桩
        If e.toolNum = CUSTOM_ADDMereStoneTOOL Then
            AddMereStone(e.x1, e.y1)
        End If

        '查看具体界桩信息
        If e.toolNum = CUSTOM_INFOTOOL Then
            BrowseInfoFromMap(e.x1, e.y1)
        End If

        If e.toolNum = 1007 Then
            BrowseInfoFromMap(e.x1, e.y1)
        End If
    End Sub

    '界桩树视图鼠标右键点击前事件
    Private Sub ContextMenu_TreeView_Popup(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ContextMenu_TreeView.Popup
        Try
            If MereStoneTV.SelectedNode Is Nothing Then
                'miMereStoneAdd.Enabled = False
                miMereStoneGPS.Enabled = False
            Else
                miMereStoneGPS.Enabled = True
            End If
        Catch ex As Exception

        End Try
    End Sub

    '界桩树视图鼠标右键事件－－增加具体界桩
    Private Sub miMereStoneAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles miMereStoneAdd.Click
        AddMereStoneMapTool()
    End Sub

    '界桩树视图鼠标右键事件－－具体界桩地图定位事件
    Private Sub miMereStoneGPS_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles miMereStoneGPS.Click
        MapsFeatureGPS()
    End Sub

    '地图鼠标移动事件，兼测距工具
    Private Sub AxMaps_MouseMoveEvent(ByVal sender As System.Object, ByVal e As AxMapXLib.CMapXEvents_MouseMoveEvent) Handles AxMaps.MouseMoveEvent
        Dim MapCoordX As Double, MapCoordY As Double

        AxMaps.ConvertCoord(e.x, e.y, MapCoordX, MapCoordY, MapXLib.ConversionConstants.miScreenToMap)

        '测距
        If AxMaps.CurrentTool = CUSTOM_RULERTOOL And (RulerToolState = MapXLib.PolyToolFlagConstants.miPolyToolBegin _
                      Or RulerToolState = MapXLib.PolyToolFlagConstants.miPolyToolInProgress) Then
            '显示距离
            CurrDistance = Decimal.Round(AxMaps.Distance(XDown, YDown, MapCoordX, MapCoordY), 2)
            stBarPlDistance.Text = CurrDistance & " 米." & " 总长度 " & TotalDistance & " 米."
        End If

        ' 显示坐标
        stBarPlCursorPosition.Text = Decimal.Round(MapCoordX, 6) & " , " & Decimal.Round(MapCoordY, 6)
    End Sub

    '地图右键删除图元信息
    Private Sub miDeleteMereStone_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles miDeleteMereStone.Click
        DeleteMapFeature()
    End Sub

    '----------------------------------------------
    '   处理在地图控件上鼠标按下时事件
    '----------------------------------------------
    Private Sub AxMaps_MouseDownEvent(ByVal sender As System.Object, ByVal e As AxMapXLib.CMapXEvents_MouseDownEvent) Handles AxMaps.MouseDownEvent
        AxMaps.ConvertCoord(e.x, e.y, XDown, YDown, MapXLib.ConversionConstants.miScreenToMap)
    End Sub

    '----------------------------------------------
    '   处理在地图控件上鼠标抬起时事件
    '----------------------------------------------
    Private Sub AxMaps_MouseUpEvent(ByVal sender As Object, ByVal e As AxMapXLib.CMapXEvents_MouseUpEvent) Handles AxMaps.MouseUpEvent
        If AxMaps.CurrentTool = CUSTOM_ADDMereStoneTOOL Then
            ArrowMapTool()
            AxMaps.Enabled = False
            With UcMereStone1
                .DataControlEnable(True)
                .txtBox_mc.Focus()
            End With
        End If
    End Sub

    '----------------------------------------------
    '   处理在地图控件上键按下时事件
    '----------------------------------------------
    Private Sub frmMaps_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
        If Me.ActiveControl Is AxMaps Then
            '测距操作时，不能使用删除键.
            If (AxMaps.CurrentTool = CUSTOM_RULERTOOL) Then
                e.Handled = (e.KeyCode = Keys.Back Or e.KeyCode = Keys.Delete)
            End If

            '删除feature时，提示用户确认是否要删除对象.
            If AxMaps.Layers.Item(MapsConstants.LAYERNAME_MereStone).Selection.Count > 0 And (e.KeyCode = Keys.Back Or e.KeyCode = Keys.Delete) Then
                e.Handled = True
                e.Handled = Not DeleteMapFeature()
                MereStoneTV.CollapseAll()
                UcMereStone1.MereStoneData.Clear()
            End If
        End If
    End Sub

    '----------------------------------------------
    '   打开查看版本信息
    '----------------------------------------------
    Private Sub mnItemAbout_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnItemAbout.Click
        AppModule.frmAb.ShowDialog()
    End Sub

    '----------------------------------------------
    '   打开帮助
    '----------------------------------------------
    Private Sub mnItemHelp_Doc_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnItemHelp.Click, mnItemHelp_Doc.Click
        Try
            Dim wordapp As Object = CreateObject("word.application")
            Dim help_doc As String = System.Configuration.ConfigurationSettings.AppSettings("help_doc")
            wordapp.visible = True
            wordapp.documents.open(Application.StartupPath & help_doc)
        Catch ex As System.Runtime.InteropServices.COMException
            MessageBox.Show("未找到系统的使用帮助文档！", "系统提醒！", MessageBoxButtons.OK, MessageBoxIcon.Warning)
        Catch ex As Exception
            MessageBox.Show("系统错误请重新启动！", "系统提醒！", MessageBoxButtons.OK, MessageBoxIcon.Warning)
        End Try
    End Sub

    '----------------------------------------------
    '   关闭系统
    '----------------------------------------------
    Private Sub mnItemClose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnItemClose.Click
        If MessageBox.Show("是否退出本系统？", "系统提醒！", MessageBoxButtons.OKCancel, MessageBoxIcon.Question) = DialogResult.OK Then
            Application.Exit()
        Else
            Exit Sub
        End If
    End Sub

    Private Sub FrmMereStone_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
        Application.Exit()
    End Sub

#Region "用户自定义事件"
    Private node_type As String
    Private curr As MereStoneTreeNode

    '部件树视图节点点击事件－－具体部件节点
    Private Sub MereStoneTV_AfterSelectNode(ByVal ev As MereStoneTreeNode) Handles MereStoneTV.AfterSelectNode
        node_type = ev.Tag
        curr = MereStoneTV.SelectedNode
        With UcMereStone1
            .QueryDataByMereStone_BH(curr.MereStone_BH)
            .DataControlEnable(.RowsCount)
        End With
        MapsFeatureGPS()
        'MereStoneTV.Enabled = False
    End Sub

    '保存信息
    Private Sub UcMereStone1_AfterSave(ByVal e As MereStone_Event) Handles UcMereStone1.AfterSave
        MereStoneTV.RefreshNode()
        Dim lyr As MapXLib.Layer = AxMaps.Layers.Item(MapsConstants.LAYERNAME_MereStone)
        'lyr.LabelProperties.Dataset.Refresh()
        lyr.LabelProperties.Dataset.Refresh()
        lyr.Refresh()
    End Sub

    '删除信息
    Private Sub UcMereStone1_AfterDeleteRow(ByVal e As MereStone_Event) Handles UcMereStone1.AfterDeleteRow
        DeleteMapFeature()
    End Sub

    '取消按钮事件
    Private Sub UcMereStone1_AfterCancel() Handles UcMereStone1.AfterCancel
        UcMereStone1.QueryDataByMereStone_BH(UcMereStone1.txtBox_bh.Text)
    End Sub

#End Region

End Class