frmmain.vb

用VB.NET开发的GeoMedia一个实例

        Me.ContextMenu2.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.contmnuLocate, Me.contmnuProperty2})
        '
        'contmnuLocate
        '
        Me.contmnuLocate.Index = 0
        Me.contmnuLocate.Text = "图上定位"
        '
        'contmnuProperty2
        '
        Me.contmnuProperty2.Index = 1
        Me.contmnuProperty2.Text = "属性"
        '
        'FrmMain
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
        Me.ClientSize = New System.Drawing.Size(728, 465)
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.Panel1, Me.tbNewText, Me.cbNewFeature, Me.Splitter1, Me.TreeView1, Me.ToolBar1, Me.StatusBar1})
        Me.Menu = Me.MainMenu1
        Me.Name = "FrmMain"
        Me.Text = "Gis-VB.Net"
        Me.Panel1.ResumeLayout(False)
        CType(Me.GMMapView1, System.ComponentModel.ISupportInitialize).EndInit()
        CType(Me.EventControl1, System.ComponentModel.ISupportInitialize).EndInit()
        CType(Me.StatusBarPanelMessage, System.ComponentModel.ISupportInitialize).EndInit()
        CType(Me.StatusBarPanelPointLocation, System.ComponentModel.ISupportInitialize).EndInit()
        Me.ResumeLayout(False)

    End Sub

#End Region

    Private Sub FormMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub

    Private Sub mnuFileOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuFileOpen.Click
        On Error GoTo ErrorHandler
        Me.StatusBarPanelMessage.Text = "连接数据库"
        OpenConnection()
        '是否显示树形图
        InitTreeView()

        Me.ResetEnvironment()
        '修改菜单状态
        Me.mnuNewFeature.Enabled = True
        Me.mnuCenter.Enabled = True
        Me.mnuDisplayFeature.Enabled = True
        Me.mnuToolMeasure.Enabled = True
        Me.mnuToolMeasureArea.Enabled = True
        Me.mnuToolMeasureDistance.Enabled = True
        Me.mnuToolQuery.Enabled = True
        Me.mnuViewFit.Enabled = True
        Me.mnuViewLegend.Enabled = True
        Me.mnuViewPan.Enabled = True
        Me.mnuViewProperty.Enabled = True
        Me.mnuViewZoomIn.Enabled = True
        Me.mnuViewZoomOut.Enabled = True
        Me.MenuItem3.Enabled = True
        Me.MenuItem4.Enabled = True
        '修改工具栏上按钮状态
        Dim bt As ToolBarButton
        For Each bt In Me.ToolBar1.Buttons
            bt.Enabled = True
        Next
        Me.ToolBar1.Buttons(0).Pushed = True
        Exit Sub

ErrorHandler:
        MsgBox(Err.Description, MSGBOX_ERROR, "FileOpen_Click Error")
    End Sub

    Private Sub mnuFileExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuFileExit.Click
        Me.Close()
    End Sub

    Private Sub mnuViewZoomIn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuViewZoomIn.Click
        Me.ResetEnvironment()
        Me.StatusBarPanelMessage.Text = "放大"
        MouseAction = "ZoomIn"
        GMMapView1.MousePointer = 187 'gmmvctZoomIn
        ResetAllButton()
        Me.ToolBar1.Buttons(1).Pushed = True
    End Sub

    Private Sub mnuViewZoomOut_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuViewZoomOut.Click
        Me.ResetEnvironment()
        Me.StatusBarPanelMessage.Text = "缩小"
        MouseAction = "ZoomOut"
        GMMapView1.MousePointer = 188 'gmmvctZoomOut
        ResetAllButton()
        Me.ToolBar1.Buttons(2).Pushed = True
    End Sub

    Private Sub mnuViewPan_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuViewPan.Click
        Me.ResetEnvironment()
        Me.StatusBarPanelMessage.Text = "平移"
        MouseAction = "Pan"
        GMMapView1.MousePointer = 171 'gmmvctPan
        ResetAllButton()
        Me.ToolBar1.Buttons(4).Pushed = True
        '刷新LOGO
        ReStartLogo()

    End Sub

    Private Sub mnuViewFit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuViewFit.Click
        On Error Resume Next
        Me.ResetEnvironment()
        Me.StatusBarPanelMessage.Text = "全图"
        GMMapView1.Fit()
        GMMapView1.CtlRefresh(False)

        '刷新LOGO
        ReStartLogo()
    End Sub

    Private Sub mnuViewLegend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuViewLegend.Click
        On Error GoTo ErrorHandler
        Me.ResetEnvironment()

        If GMMapView1.Legend.Visible Then
            GMMapView1.Legend.Visible = False
            mnuViewLegend.Checked = False
            ResetAllButton()
            Me.ToolBar1.Buttons(0).Pushed = True
        Else
            GMMapView1.Legend.Visible = True
            mnuViewLegend.Checked = True
            ResetAllButton()
            Me.ToolBar1.Buttons(7).Pushed = True
        End If
        Exit Sub
ErrorHandler:
        MsgBox(Err.Description, MSGBOX_ERROR, "图例显示出错！")
    End Sub

    Private Sub mnuDisplayFeature_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuDisplayFeature.Click
        ' select a feature class and create a legend entry for display
        On Error GoTo ErrorHandler

        Dim objRS As PClient.GRecordset
        Dim frmSelectFeatrue1 As FrmSelectFeature
        Dim strCol As New ArrayList()

        Dim i As Integer

        '重置环境
        ResetEnvironment()

        Me.StatusBarPanelMessage.Text = "添加显示图层"
        frmSelectFeatrue1 = New FrmSelectFeature()
        strCol = frmSelectFeatrue1.GetSelectFeatureInfo()

        If strCol Is Nothing Then
            Exit Sub
        End If

        For i = 0 To strCol.Count - 1
            CreateRecordset(objRS, strCol.Item(i), "")
            Dim objLE As PView.RecordLegendEntry

            If Not (objRS Is Nothing) Then
                Cursor = System.Windows.Forms.Cursors.WaitCursor
                objLE = GetLegendEntry(objRS, Me.GMMapView1)
                DisplayTheLegendEntry(objLE, Me.GMMapView1)
                Cursor = System.Windows.Forms.Cursors.Default
            End If
        Next
        Me.StatusBarPanelMessage.Text = "显示图层添加完毕"
        Exit Sub

ErrorHandler:
        MsgBox(Err.Description, MSGBOX_ERROR, "添加显示图层出错！")
        Me.StatusBarPanelMessage.Text = "添加显示图层出错"
    End Sub


    Private Sub mnuViewProperty_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuViewProperty.Click
        '重置环境
        ResetEnvironment()
        Me.StatusBarPanelMessage.Text = "查看选择集里图素的属性"

        If Me.GMMapView1.MapViewSelectedObjects.Count = 1 Then
            Dim frmProperty1 As FrmProperty
            frmProperty1 = New FrmProperty()
            frmProperty1.FillFlexGrid(Me.GMMapView1.MapViewSelectedObjects.Item(1), Me.GMMapView1)
        End If

    End Sub

    Private Sub mnuCenter_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuCenter.Click
        On Error Resume Next
        '重置环境
        ResetEnvironment()


        If Me.mnuCenter.Checked Then
            Me.mnuCenter.Checked = False
            MouseAction = "Select"
            Me.ToolBar1.Buttons(0).Pushed = True
            Me.StatusBarPanelMessage.Text = ""
        Else
            Me.mnuCenter.Checked = True
            MouseAction = "Center"
            Me.StatusBarPanelMessage.Text = "居中;点击图形"
        End If
    End Sub

    Private Sub mnuEditMoveFeature_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuEditMoveFeature.Click
        On Error GoTo errhandle
        Dim gobjLineSelectStyle As New PView.LinearStyle()
        Dim objRS As GDO.GRecordset
        Dim sFieldName As String
        Dim objGeometry As Object
        Dim objGss As New PClient.GeometryStorageService()

        '重置环境
        ResetEnvironment()

        Me.StatusBarPanelMessage.Text = "移动;按下鼠标左键拖动图形"
        '定义图形进入编辑状态后的显示风格
        With gobjHandleStyle
            .Color = RGB(0, 0, 0)               '''黑色
            .HandleMode = 0                     'gmsHandleModeSolid --solid
            .HandleShape = 0                    'gmsHandleShapeSquare--Square 
            .Size = 2
            .StyleUnits = 2                     'gmsStyleUnitsView-- View Units (Pixels) 
        End With
        With gobjLineSelectStyle
            .Width = 1
            .Color = RGB(200, 200, 50)
            .LineStyle = 0                      'gmsLinearSolid--Solid 
            .StyleUnits = 2                     'gmsStyleUnitsView-- View Units (Pixels) 
        End With
        objLocatedObjects.Clear()
        '定位选中的图形
        objLocatedObjects.Add(GMMapView1.MapViewSelectedObjects.Item(1))
        gobjGeomEdit.RemoveAllGeometries()
        '获取选中的图形
        objRS = objLocatedObjects.Item(1).Recordset
        sFieldName = GetGeometryFieldName(objRS)
        objRS.Bookmark = objLocatedObjects.Item(1).Bookmark
        rsGrecordset = objRS
        rsGrecordset.Bookmark = objRS.Bookmark
        objGss.GetGeometry(objRS.GFields(sFieldName), objGeometry)
        '将选中的图形加入编辑对象中
        gobjGeomEdit.AppendGeometry(objGeometry, gobjLineSelectStyle)
        gobjGeomEdit.SelectAllKeypoints(objGeometry, gobjHandleStyle)
        MouseAction = "MoveFeature"

        GMMapView1.MousePointer = MapviewLib.CursorTypeConstants.gmmvctCrossHair
        Exit Sub
errhandle:
        MsgBox(Err.Description, MSGBOX_ERROR, "移动图形出错！")
        Me.StatusBarPanelMessage.Text = "移动图形出错"
        Exit Sub
    End Sub

    Private Sub mnuEditDeleteFeature_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuEditDeleteFeature.Click
        On Error GoTo ErrorHandle
        Dim objRS As GDO.GRecordset
        Dim sFieldName As String
        Dim objGeometry As Object
        Dim objGss As New PClient.GeometryStorageService()

        '重置环境
        ResetEnvironment()

        Me.StatusBarPanelMessage.Text = "删除"
        '获取要删除的图形记录
        objLocatedObjects.Clear()
        objLocatedObjects.Add(GMMapView1.MapViewSelectedObjects.Item(1))
        gobjGeomEdit.RemoveAllGeometries()
        objRS = objLocatedObjects.Item(1).Recordset
        sFieldName = GetGeometryFieldName(objRS)
        objRS.Bookmark = objLocatedObjects.Item(1).Bookmark
        rsGrecordset = objRS
        If MsgBox("确定要删除该图形？", MSGBOX_QUESTION, "删除") = MsgBoxResult.OK Then
            '删除
            rsGrecordset.Delete()
            ReLoadLegendEntry(rsGrecordset, GMMapView1)
        End If

        '重置环境
        ResetEnvironment()

        Me.StatusBarPanelMessage.Text = "删除完成"
        Exit Sub
ErrorHandle:
        MsgBox(Err.Description, MSGBOX_ERROR, "删除图形出错！")
        Me.StatusBarPanelMessage.Text = "删除图形出错"
    End Sub