frmmain.frm

VB+sql实现区域环境管理信息系统的部分功能

         End
         Begin VB.Menu weihai 
            Caption         =   "威海市"
            Index           =   217
         End
         Begin VB.Menu rizhao 
            Caption         =   "日照市"
            Index           =   218
         End
      End
      Begin VB.Menu zhuanti 
         Caption         =   "生态环境专题数据"
         Index           =   22
      End
      Begin VB.Menu guanli 
         Caption         =   "生态管理专题数据库"
         Index           =   23
      End
   End
   Begin VB.Menu ch 
      Caption         =   "生态功能区数据查询菜单"
      Index           =   3
      Begin VB.Menu cod 
         Caption         =   "COD排放量图"
         Index           =   31
      End
   End
   Begin VB.Menu gongju 
      Caption         =   "系统工具"
      Index           =   4
      Begin VB.Menu xinz 
         Caption         =   "新增图层"
         Index           =   41
      End
      Begin VB.Menu gai 
         Caption         =   "修改图层"
         Index           =   42
      End
      Begin VB.Menu st 
         Caption         =   "停止编辑"
         Index           =   43
      End
      Begin VB.Menu db 
         Caption         =   "数据库编辑"
         Index           =   44
      End
   End
   Begin VB.Menu help 
      Caption         =   "帮助"
      Index           =   5
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False




Private Sub cod_Click(Index As Integer)
codp.Show
End Sub

Private Sub Form_Resize()

listalllayers
List1.ListIndex = 1
End Sub

Private Sub listalllayers()
List1.Clear
Dim x As Integer
For x = 1 To Map1.Layers.Count
List1.AddItem Map1.Layers(x).Name
Next
End Sub

Private Sub jinan_Click(Index As Integer)
jichu.Caption = "济南市基础环境信息"

jichu.Show
End Sub

Private Sub List1_Click()
Dim ly As MapXLib.Layer, Y As Integer
Y = List1.ListIndex
If Y = -1 Then
Exit Sub
Else
Set ly = Map1.Layers(Y + 1)
ly.Editable = True
Set Map1.Layers.InsertionLayer = ly
End If
End Sub



Private Sub open_Click(Index As Integer)
     CommonDialog1.Filter = "mapinfo文件(*.tab)|*.tab|所有文件(*.*)|*.*|"
     CommonDialog1.FilterIndex = 0
     CommonDialog1.DialogTitle = "打开"
     CommonDialog1.ShowOpen
     If CommonDialog1.FileName = "" Then
      Exit Sub
    End If
     Map1.Layers.Add CommonDialog1.FileName

     listalllayers
End Sub

Private Sub quit_Click(Index As Integer)
Unload Me
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
 Select Case Button.Index
 Case 2
        Dim Y As Integer
        With CommonDialog1
        .DefaultExt = "tab"
        .DialogTitle = "创建新表"
        .Filter = "MapInfo Tables (*.tab)|*.tab"
        .ShowSave
        If Len(CommonDialog1.FileName) = 0 Then
        Exit Sub
        End If
         Dim friendlyName As String
        friendlyName = Left$(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4)
        Set Lyr = Map1.Layers.CreateLayer(friendlyName)
        List1.Clear
        Lyr.Editable = True
        Set Map1.Layers.InsertionLayer = Lyr
        End With
        
        listalllayers
        
 Case 3
       'Map1.Layers.LayersDlg
     CommonDialog1.Filter = "mapinfo文件(*.tab)|*.tab|所有文件(*.*)|*.*|"
     CommonDialog1.FilterIndex = 0
     CommonDialog1.DialogTitle = "打开"
     CommonDialog1.ShowOpen
     If CommonDialog1.FileName = "" Then
      Exit Sub
    End If
     Map1.Layers.Add CommonDialog1.FileName

     listalllayers
 Case 4
           Dim sFile As String

    On Error GoTo MapErr
    ' Show the "Save" dialog
    With dlgCommonDialog
        .DialogTitle = "Save As"
        .Flags = cdlOFNHideReadOnly
        .CancelError = True
        .FileName = ""
        .Filter = "Geoset Files (*.gst)|*.gst"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    
    ' A Geoset is a collection of layers, view settings, etc.
    ' The first parameter to Map.SaveMapAs Geoset is the
    ' "Friendly" name of the Geoset (e.g. "United States"
    ' instead of "us.gst"). By default, the title of the map is used
    Map1.SaveMapAsGeoset "", sFile
    Exit Sub
MapErr:
    If Err = 1147 Then
        ' 1147 is an error that MapX sends to say that there were temporary layers
        ' that were not saved in the Geoset.  The user should know this, but we don't
        ' want to say that it resulted in not saving to the Geoset
        MsgBox Error
    Else
        If Err <> 32755 Then ' 32755 : Cancel was selected
            MsgBox "Could not save to Geoset: """ & sFile & """ Error #" & Str(Err) & ": " & Error
        End If
    End If
 Case 6
      On Error GoTo MapErr
    With CommonDialog2
        .DialogTitle = "Print"
        .CancelError = True
        .ShowPrinter
    End With
    
    ' The Map1.PrintMap method requires coordinates of HIMETRIC, or 100ths of a
    ' millimeter.  Change the PaperUnit to Millimeters and multiply by 100 to
    ' get the correct values
    
    Map1.PaperUnit = miPaperUnitMillimeter
    Printer.CurrentX = 0
    Printer.CurrentY = 0
    Printer.Print " "
    If ExportWidth = 0 Or ExportHeight = 0 Then
        ' The user did not specify a print size
        Map1.PrintMap Printer.hDC, 0, 0, Map1.MapPaperWidth * 100, Map1.MapPaperHeight * 100
    Else
        ' The user did specify a print size. These values are in inches.
        ' 1 inch = 25.39545 mm = 2539.545 HIMETRIC
        Map1.PrintMap Printer.hDC, 0, 0, ExportWidth * 2539.545, ExportHeight * 2539.545
    End If
    Printer.NewPage
    Printer.EndDoc
    Exit Sub

    If Err <> 32755 Then ' 32755 : Cancel was selected
        MsgBox "Could not print the map. Error #" & Str(Err) & ": " & Error
    End If
 Case 8
      Set lay = Map1.Layers.InsertionLayer
    Set selectedFtrs = lay.Selection
    For Each obj In selectedFtrs
   lay.DeleteFeature (obj)
       Next
 Case 9

     Map1.ExportMap "clipboard", miFormatBMP
  
    
        ' Copy a bitmap picture of the map to the clipboard
 Case 10
    
 End Select
End Sub

Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 2
  Map1.CurrentTool = miSelectTool
Case 3
  Map1.CurrentTool = miRectSelectTool
Case 4
 Map1.CurrentTool = miPolygonSelectTool
Case 5
 Map1.CurrentTool = miRadiusSelectTool
Case 7
 Map1.CurrentTool = miZoomInTool
Case 8
 Map1.CurrentTool = miZoomOutTool
Case 9
 Map1.CurrentTool = miPanTool
Case 11
 If List1.ListIndex = -1 Then
MsgBox "请选择您要编辑的图层！！！！"

Else
      Map1.CurrentTool = miAddPointTool
    End If
Case 12
 If List1.ListIndex = -1 Then
MsgBox "请选择您要编辑的图层！！！！"
Else
     Map1.CurrentTool = miAddLineTool
    End If
Case 13
 If List1.ListIndex = -1 Then
MsgBox "请选择您要编辑的图层！！！！"
Else
     Map1.CurrentTool = miAddPolylineTool
   End If
Case 14
 Map1.CurrentTool = miAddRegionTool
Case 15
 If List1.ListIndex = -1 Then
MsgBox "请选择您要编辑的图层！！！！"
Else
   Map1.CurrentTool = miAddRegionTool
End If
Case 16
 Map1.CurrentTool = miAddRegionTool
End Select
End Sub



Private Sub Map2_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim MapX As Double
Dim MapY As Double
bDown = True
Map2.ConvertCoord x, Y, MapX, MapY, miScreenToMap
Map1.CenterX = MapX
Map1.CenterY = MapY

End Sub

Private Sub Map2_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim MapX As Double
Dim MapY As Double
If bDown Then
Map2.ConvertCoord x, Y, MapX, MapY, miScreenToMap
Map1.CenterX = MapX
Map1.CenterY = MapY
End If
End Sub

Private Sub Map2_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
bDown = False
End Sub