frmmain.frm

实现了基本地图的查询 漫游 放大 缩小等等功能

                    RefreshcbLayers cbLayers, Map, m_sEditLayerName
                End If
            End If
        End If
    End If
End Sub

Private Sub mnuFileExit_Click()
    Unload Me
End Sub

Private Sub mnuFileNewTAB_Click()
On Error Resume Next

Dim sFilePath As String
Dim sLayerName As String
Dim oLayer As MapXLib.Layer
Dim oLayerInfo As MapXLib.LayerInfo

    frmNewLayer.Show vbModal, Me

    If m_sLayerName = "" Then Exit Sub
    
    Set oLayerInfo = New MapXLib.LayerInfo
    
    sLayerName = clsPublic.GetUniqueLayerNamebyStr(Map, m_sLayerName)
    
    If m_sFilePath <> "" And m_iAddTempLayer = 0 Then
        sFilePath = Trim(m_sFilePath & "\" & Trim(m_sLayerName) & ".tab")
'        oLayerInfo.Type = miLayerInfoTypeNewTable
'        oLayerInfo.AddParameter "FileSpec", sFilePath
'        oLayerInfo.AddParameter "Name", sLayerName
'        oLayerInfo.AddParameter "OverwriteFile", "1"
'        Set oLayer = Map.Layers.Add(oLayerInfo, 1)
        Set oLayer = Map.Layers.CreateLayer(sLayerName, sFilePath, 1)
    Else
        Set oLayer = Map.Layers.CreateLayer(sLayerName, , 1)
    End If
    
    m_sEditLayerName = sLayerName
    RefreshcbLayers cbLayers, Map, m_sEditLayerName
    
    Set oLayerInfo = Nothing

End Sub

Private Sub mnuFileOpenGST_Click()
On Error GoTo ErrorReturn

Dim sFilePath As String

    CommonDialog.CancelError = True
    CommonDialog.Filter = "*.gst|*.gst"
    CommonDialog.ShowOpen
    sFilePath = CommonDialog.FileName
    If Trim(sFilePath) <> "" Then
        Map.Layers.RemoveAll
        Map.Layers.AddGeoSetLayers sFilePath
        StatusBar.Panels(1).Text = sFilePath
        RefreshcbLayers cbLayers, Map, ""
        m_sEditLayerName = Map.Layers(1).Name
        StatusBar.Panels(1).Text = sFilePath
        StatusBar.Refresh
    End If
    
ErrorReturn:

End Sub

Private Sub mnuFileSaveas_Click()
On Error Resume Next
    
    If Map.Layers.Count <> 0 Then
        frmSaveLayer.Show vbModal, Me
    Else
        MsgBox "没有加载任何图层！"
    End If

End Sub

Private Sub mnuFileSaveGST_Click()
On Error Resume Next

Dim sFilePath As String
Dim sFileName As String
    
    If Map.Layers.Count = 0 Then
        MsgBox "当前地图中没有加载任何图层！"
        Exit Sub
    End If
    CommonDialog.CancelError = True
    CommonDialog.Filter = "*.gst|*.gst"
    CommonDialog.ShowSave
    sFilePath = CommonDialog.FileName
    If Trim(sFilePath) <> "" Then
        sFileName = clsPublic.GetFileNamefromPath(sFilePath)
        Map.SaveMapAsGeoset "", sFilePath
        StatusBar.Panels(1).Text = sFilePath
    End If
    
End Sub

Private Sub mnuPartsAdd_Click()
    Map.CurrentTool = miSelectTool
    Map.FeatureEditMode = miEditModeAddNode + miEditModeNode
    If Not clsPublic.g_bSnaped Then
        mnuViewNodeSnap_Click
    End If
    
    If Not m_bShowLayerNodes Then
        mnuViewShowNodes_Click
    End If
    Map.SnapToNodeSupport = True
    
End Sub

Private Sub mnuPartsEdit_Click()
    Map.CurrentTool = miSelectTool
    Map.FeatureEditMode = miEditModeNode
    If Not clsPublic.g_bSnaped Then
        mnuViewNodeSnap_Click
    End If
    
    If Not m_bShowLayerNodes Then
        mnuViewShowNodes_Click
    End If
    Map.SnapToNodeSupport = True
    
End Sub

Private Sub mnuSelectbyCircle_Click()
    Map.CurrentTool = miRadiusSelectTool
    Map.FeatureEditMode = miEditModeFeature
    If clsPublic.g_bSnaped Then
        Map.SnapToNodeSupport = True
    Else
        Map.SnapToNodeSupport = False
    End If
    
End Sub

Private Sub mnuSelectbyMaquee_Click()
    Map.CurrentTool = miRectSelectTool
    Map.FeatureEditMode = miEditModeFeature
    If clsPublic.g_bSnaped Then
        Map.SnapToNodeSupport = True
    Else
        Map.SnapToNodeSupport = False
    End If
    
End Sub

Private Sub mnuSelectbyPoint_Click()
    Map.CurrentTool = miSelectTool
'    If clsPublic.g_bSnaped Then
'        Map.SnapToNodeSupport = True
'    Else
'        Map.SnapToNodeSupport = False
'    End If
End Sub

Private Sub mnuSelectbyPolygon_Click()
    Map.CurrentTool = miPolygonSelectTool
    Map.FeatureEditMode = miEditModeFeature
    If clsPublic.g_bSnaped Then
        Map.SnapToNodeSupport = True
    Else
        Map.SnapToNodeSupport = False
    End If
    
End Sub

Private Sub mnuSelectI_Click()
    m_bIQuery = True
    mnuSelectI.Checked = Not mnuSelectI.Checked
    If mnuSelectI.Checked Then
        Toolbar.Buttons(11).value = tbrPressed
    Else
        Toolbar.Buttons(11).value = tbrUnpressed
    End If
    Map.CurrentTool = miSelectTool
    Map.FeatureEditMode = miEditModeFeature
    If clsPublic.g_bSnaped Then
        Map.SnapToNodeSupport = True
    Else
        Map.SnapToNodeSupport = False
    End If
End Sub

Private Sub mnuSelectLocateFeatures_Click()
    Set Map.Bounds = Map.Layers.Bounds
End Sub

Private Sub mnuSelectShowFeatures_Click()
    frmShowFeatures.Show 1, Me
End Sub

Private Sub mnuTablePacking_Click()
    If Map.Layers.Count > 0 Then
        frmPackOption.Show vbModal, Me
    Else
        MsgBox "当前地图中没有加载图层，无法执行该操作！"
    End If
End Sub

Private Sub mnuThemeLabel_Click()
Dim oLayer As MapXLib.Layer
Dim oDS As MapXLib.Dataset


End Sub

Private Sub mnuViewCoord_Click()
    Map.DisplayCoordSys.PickCoordSys
End Sub

Private Sub mnuViewCursorCoord_Click()
    clsPublic.g_bShowCursorCoord = Not clsPublic.g_bShowCursorCoord
    If clsPublic.g_bShowCursorCoord Then
        StatusBar.Panels.Add 2, "CoordPanel", ""
        If StatusBar.Panels.Count = 2 Then
            StatusBar.Panels(1).Width = StatusBar.Width * 0.6
            StatusBar.Panels(2).Width = StatusBar.Width * 0.4
        Else
            StatusBar.Panels(1).Width = StatusBar.Width * 0.4
            StatusBar.Panels(2).Width = StatusBar.Width * 0.4
            StatusBar.Panels(3).Width = StatusBar.Width * 0.2
        End If
    Else
        StatusBar.Panels.Remove 2
        If StatusBar.Panels.Count = 1 Then
            StatusBar.Panels(1).Width = StatusBar.Width
        Else
            StatusBar.Panels(1).Width = StatusBar.Width * 0.7
            StatusBar.Panels(2).Width = StatusBar.Width * 0.3
        End If
        
    End If
    mnuViewCursorCoord.Checked = clsPublic.g_bShowCursorCoord
    
End Sub

Private Sub mnuViewLayerCtrl_Click()
    Map.PropertyPage
End Sub

Private Sub mnuViewNodeSnap_Click()
    clsPublic.g_bSnaped = Not clsPublic.g_bSnaped
    Map.SnapTolerance = m_iSnapTolerance
    If clsPublic.g_bSnaped Then
        
        If StatusBar.Panels.Count = 1 Then
            StatusBar.Panels.Add 2, "InfoPanel", ""
            StatusBar.Panels(2).Text = "捕捉节点"
            StatusBar.Panels(1).Width = StatusBar.Width * 0.8
            StatusBar.Panels(2).Width = StatusBar.Width * 0.2
        Else
            StatusBar.Panels.Add 3, "InfoPanel", ""
            StatusBar.Panels(3).Text = "捕捉节点"
            StatusBar.Panels(1).Width = StatusBar.Width * 0.4
            StatusBar.Panels(2).Width = StatusBar.Width * 0.4
            StatusBar.Panels(3).Width = StatusBar.Width * 0.2
        End If
    Else
        If StatusBar.Panels.Count = 2 Then
            StatusBar.Panels.Remove 2
            StatusBar.Panels(1).Width = StatusBar.Width
        Else
            StatusBar.Panels.Remove 3
            StatusBar.Panels(1).Width = StatusBar.Width * 0.7
            StatusBar.Panels(2).Width = StatusBar.Width * 0.3
        End If
       
    End If
    
    mnuViewNodeSnap.Checked = clsPublic.g_bSnaped
End Sub

Private Sub mnuViewOption_Click()
    frmOptions.Show vbModal, Me
End Sub

Private Sub mnuViewPan_Click()
    Map.CurrentTool = miPanTool
End Sub

Private Sub mnuViewShowNodes_Click()
    m_bShowLayerNodes = Not m_bShowLayerNodes
    If m_bShowLayerNodes Then
        If Trim(m_sEditLayerName) <> "" Then
            Map.Layers(Trim(m_sEditLayerName)).ShowNodes = True
        End If
    Else
        If Trim(m_sEditLayerName) <> "" Then
            Map.Layers(Trim(m_sEditLayerName)).ShowNodes = False
        End If
    End If
    mnuViewShowNodes.Checked = m_bShowLayerNodes
    
End Sub

Private Sub mnuViewZoomIn_Click()
    Map.CurrentTool = miZoomInTool
End Sub

Private Sub mnuViewZoomOut_Click()
    Map.CurrentTool = miZoomOutTool
End Sub

Private Sub RefreshcbLayers(ByRef combobox As combobox, ByVal Map As MapXLib.Map, ByVal sLayerName As String)
On Error Resume Next
Dim i As Integer
Dim iSelected As Integer
    combobox.Clear
    
    iSelected = 0
    For i = 1 To Map.Layers.Count
        combobox.AddItem Map.Layers(i)
        If StrComp(sLayerName, Map.Layers(i).Name, vbTextCompare) = 0 Then
            iSelected = i - 1
            
        End If
        Map.Layers(i).Editable = False
    Next i
    If combobox.ListCount <> 0 Then
        combobox.ListIndex = iSelected
        Set Map.Layers.InsertionLayer = Map.Layers(iSelected + 1)
        Map.Layers(iSelected + 1).Editable = True
    End If
    
End Sub

Private Sub mnuZoomtoLayer_Click()
    If Map.Layers.Count > 0 Then
        frmSelectLayer.Show vbModal, frmMain
        If m_sLayerName <> "" Then
            If m_sLayerName = "所有图层" Then
                Set Map.Bounds = Map.Layers.Bounds
            Else
                Set Map.Bounds = Map.Layers(m_sLayerName).Bounds
            End If
        End If
    End If

End Sub

Private Sub OpenTxtFile(ByVal sFileName As String)
    Dim sWinDir As String
    Dim sHelpFilePath As String
    Const MAX_PATH = 260
    
    On Error Resume Next
    
    '构造帮助文件的全路径名
    If Right(App.Path, 1) = "\" Then
        sHelpFilePath = App.Path & sFileName
    Else
        sHelpFilePath = App.Path & "\" & sF