frmmain.frm

GIS地理信息系统开发。大名鼎鼎的MAPX＋VisualBasic6.0软件开发

    Next
    If Me.WindowState = vbNormal Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
    
    ' Save the current settings to restore for the
    ' next time the application is run
    SaveSetting App.Title, "Settings", "WindowState", Me.WindowState
    SaveSetting App.Title, "Settings", "ToolbarVisibility", tbToolBar.Visible
    SaveSetting App.Title, "Settings", "StatusBarVisibility", sbStatusBar.Visible
    SaveSetting App.Title, "Settings", "MapToolsVisibility", Toolbar1.Visible
    SaveSetting App.Title, "Settings", "PolyRuler", UsePolyRuler
    SaveSetting App.Title, "Settings", "ExportFormat", ExportFormat
    SaveSetting App.Title, "Settings", "ExportFormatString", ExportFormatString
    SaveSetting App.Title, "Settings", "ExportFormatExt", ExportFormatExt
    SaveSetting App.Title, "Settings", "RulerUnit", RulerUnit
    SaveSetting App.Title, "Settings", "RulerUnitString", RulerUnitString
    SaveSetting App.Title, "Settings", "ExportWidth", ExportWidth
    SaveSetting App.Title, "Settings", "ExportHeight", ExportHeight
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 And Map1.CurrentTool = RulerToolID Then
        ' Place the current screen coordinates in MouseDownX1 and MouseDownY1
        ' Since these points will be used in the Map.Distance call, they
        ' must be in map coordinates, not screen coordinates
        Map1.ConvertCoord X, Y, MouseDownX1, MouseDownY1, miScreenToMap
    End If
End Sub

Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 And Map1.CurrentTool = RulerToolID Then
        Dim X2 As Double
        Dim Y2 As Double
        
        ' RulerUnit is the unit selected in the options dialog (default Miles)
        ' RulerUnitString is its name. Here, we make sure this is the current map unit.
        Map1.MapUnit = RulerUnit
        
        ' Convert from Screen Coordinates to Map Coordinates
        Map1.ConvertCoord X, Y, X2, Y2, miScreenToMap
        sbStatusBar.SimpleText = Map1.Distance(MouseDownX1, MouseDownY1, X2, Y2) & " " & RulerUnitString
    End If
End Sub

Private Sub Map1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' If the user right clicks on the map, pop up the builtin MapX properties dialog
    If Button = 2 Then
        Map1.PropertyPage
    End If
End Sub

Private Sub Map1_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 ToolNum = PolyRulerToolID Then
        Dim i As Integer
        Dim DistanceSoFar As Double
        
        ' RulerUnit is the unit selected in the options dialog (default Miles)
        ' RulerUnitString is its name. Here, we make sure this is the current map unit.
        Map1.MapUnit = RulerUnit
        DistanceSoFar = 0#
        
        ' Find the total distance by adding up each of the line segment distances
        If Points.Count > 1 Then
            For i = 2 To Points.Count
                DistanceSoFar = DistanceSoFar + Map1.Distance(Points.Item(i).X, Points.Item(i).Y, Points.Item(i - 1).X, Points.Item(i - 1).Y)
            Next
        End If
        
        ' Now, we have the total distance along the polyline
        ' If the user is done with the poly-ruler tool, show this distance
        ' in a message box. Otherwise, just show it in the status bar.
        If Flags = miPolyToolEnd Then
            'First, clear the status bar
            sbStatusBar.SimpleText = ""
            MsgBox "Distance: " & DistanceSoFar & " " & RulerUnitString
        Else
            sbStatusBar.SimpleText = DistanceSoFar & " " & RulerUnitString
        End If
    End If
End Sub

Private Sub Map1_ThemeModifyRequested(ByVal Theme As Object)
    ' When the user double clicks on the legend of an existing theme,
    ' this event is fired.  Here, we show the builtin MapX theme dialog.
    Theme.ThemeDlg
End Sub

Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean)
    If ToolNum = RulerToolID Then
        ' The two-point ruler tool has been used.  This tool displays
        ' the distance in the status bar as the mouse is moved, and
        ' displays the distance in a message box as when the mouse is
        ' released.  See Map1_MouseDown and Map1_MouseMove for the rest
        ' of the implementation.
        
        ' RulerUnit is the unit selected in the options dialog (default Miles)
        ' RulerUnitString is its name. Here, we make sure this is the current map unit.
        Map1.MapUnit = RulerUnit
        
        ' Clear the status bar and display the distance in a message box
        sbStatusBar.SimpleText = ""
        MsgBox "Distance: " & Map1.Distance(X1, Y1, X2, Y2) & " " & RulerUnitString
    End If
End Sub

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

Private Sub mnuFileExport_Click()
    Dim SaveFile As String
    On Error GoTo MapErr
    With dlgCommonDialog
        .DialogTitle = "Export Bitmap"
        .CancelError = True
        .Filter = ExportFormatString & " (" & ExportFormatExt & ")|" & ExportFormatExt
        .ShowSave
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        SaveFile = .FileName
    End With
    
    If ExportHeight = 0 Or ExportWidth = 0 Then
        ' The user did not specify dimensions to export
        Map1.ExportMap SaveFile, ExportFormat
    Else
        ' ExportWidth/Height are in Map1.MapPaperUnit units, which was
        ' set to inches in Form_Load
        Map1.ExportMap SaveFile, ExportFormat, ExportWidth, ExportHeight
    End If
    Exit Sub
MapErr:
    If Err <> 32755 Then ' 32755 : Cancel was selected
        MsgBox "Could not export to: """ & SaveFile & """. Error #" & Str(Err) & ": " & Error
    End If
End Sub

Private Sub mnuFileLayerAdd_Click()
    Dim sFile As String
    
    On Error GoTo MapErr
    ' Show the open dialog to add a layer
    With dlgCommonDialog
        .DialogTitle = "Add Layer"
        .Flags = 0
        '.Flags = cdlOFNAllowMultiselect ' Let the user select multiple tables to add
        .CancelError = True
        .FileName = ""
        .Filter = "MapInfo Tables (*.tab)|*.tab"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    
    ' Add the layer to the current map
    Map1.Layers.Add sFile
    Exit Sub
MapErr:
    If Err <> 32755 Then ' 32755 : Cancel was selected
        MsgBox "Could not add layer: """ & sFile & """. Error #" & Str(Err) & ": " & Error
    End If
 End Sub

Private Sub mnuFilePageSetup_Click()
    On Error Resume Next ' Since an error is raised when cancel is pressed
    With dlgCommonDialog
        .CancelError = True
        .DialogTitle = "Page Setup"
        .Flags = cdlPDPrintSetup
        .ShowPrinter
    End With
End Sub

Private Sub mnuMap_Click()
    ' The Add theme menu item should only be enabled if there
    ' is any datasets to theme
    ' The modify theme and modify legend menu items should only
    ' be enabled if there are any themes
    If Map1.Datasets.Count = 0 Then
        ' There are no datasets, no themes; everything should be
        ' disabled
        mnuMapCreateTheme.Enabled = False
        mnuMapModifyTheme.Enabled = False
        mnuMapModifyLegend.Enabled = False
    Else
        mnuMapCreateTheme.Enabled = True
        Dim HasThemes As Boolean
        Dim ds As Dataset
        HasThemes = False
        For Each ds In Map1.Datasets
            If ds.Themes.Count <> 0 Then
                HasThemes = True
            End If
        Next
        mnuMapModifyTheme.Enabled = HasThemes
        mnuMapModifyLegend.Enabled = HasThemes
    End If
    
    
    ' The Query selection and select within distance menu items
    ' should only be enabled if there is a selection
    Dim lyr As Layer
    mnuMapQuery.Enabled = False
    mnuMapSelectDistance.Enabled = False
    For Each lyr In Map1.Layers
        If lyr.Selection.Count <> 0 Then
            mnuMapQuery.Enabled = True
            mnuMapSelectDistance.Enabled = True
        End If
    Next
End Sub

Private Sub mnuMapCreateTheme_Click()
    frmCreateTheme.Show vbModal, Me
End Sub

Private Sub mnuMapFind_Click()
    frmFind.Show vbModeless, Me
End Sub

Private Sub mnuMapInsertData_Click()
    frmDatasets.Show vbModal, Me
End Sub

Private Sub mnuMapLayer_Click()
    Map1.Layers.LayersDlg
End Sub

Private Sub mnuMapModifyLegend_Click()
    frmModifyLegend.Show vbModal, Me
End Sub

Private Sub mnuMapModifyTheme_Click()
    frmModifyTheme.Show vbModal, Me
End Sub

Private Sub mnuMapProjection_Click()
    Map1.DisplayCoordSys.PickCoordSys
    ' Keep the numeric coordinate system the same as the display
    Set Map1.NumericCoordSys = Map1.DisplayCoordSys
End Sub

Private Sub mnuMapProperties_Click()
    Map1.PropertyPage
End Sub

Private Sub mnuMapQuery_Click()
    frmQueryResults.Show vbModal, Me
End Sub

Private Sub mnuMapSelectDistance_Click()
    frmSelectDistance.Show vbModal, Me
End Sub

Private Sub mnuMapViewEntire_Click()
    frmViewEntireLayer.Show vbModeless, Me
End Sub

Private Sub mnuMapZoom_Click()
    frmZoomDialog.Show vbModeless, Me
End Sub

Private Sub mnuToolsAddSymbolAnnotation_Click()
    ' Place a check in the menu for the current tool, and depress the
    ' appropriate button in the toolbar
    CheckedMenu.Checked = False
    PressedButton.Value = tbrUnpressed
    Set CheckedMenu = mnuToolsAddSymbolAnnotation
    Set PressedButton = Toolbar1.Buttons(13)
    CheckedMenu.Checked = True
    PressedButton.Value = tbrPressed
    Toolbar1.Refresh
    
    Map1.CurrentTool = miSymbolTool
End Sub

Private Sub mnuToolsAddTextAnnotation_Click()
    ' Place a check in the menu for the current tool, and depress the
    ' appropriate button in the toolbar
    CheckedMenu.Checked = False
    PressedButton.Value = tbrUnpressed
    Set CheckedMenu = mnuToolsAddTextAnnotation
    Set PressedButton = Toolbar1.Buttons(14)
    CheckedMenu.Checked = True
    PressedButton.Value = tbrPressed
    Toolbar1.Refresh
    
    Map1.CurrentTool = miTextTool
End Sub

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

Private Sub mnuToolsAnnotationStyle_Click()
    ' This dialog allows the user to modify the style of the annotations