frmmain.frm

这是我的一个课题：我省农业分布调查咨询系统。课题是和省农业厅合作的。源代码完整

      End
      Begin VB.Menu mnuFileBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuToolsRuleroption 
         Caption         =   "测量设置"
      End
      Begin VB.Menu menufilebar3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFilePageSetup 
         Caption         =   "页面设置((&T)"
      End
      Begin VB.Menu mnuFilePrint 
         Caption         =   "打印(&P)"
      End
      Begin VB.Menu mnuFileBar2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "退出系统(&X)"
      End
   End
   Begin VB.Menu mnuMap 
      Caption         =   "地图"
      Begin VB.Menu mnuMapCreateTheme 
         Caption         =   "创建专题图(&C)"
      End
      Begin VB.Menu mnuMapBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuMapViewEntire 
         Caption         =   "查看整个图层(&A)"
      End
      Begin VB.Menu mnuMapBar3 
         Caption         =   "-"
      End
      Begin VB.Menu menumapclearselection 
         Caption         =   "清除选区"
      End
      Begin VB.Menu menuclearthe 
         Caption         =   "清除专题图"
      End
   End
   Begin VB.Menu FindMenuItem 
      Caption         =   "查询"
      Begin VB.Menu menufindsimple 
         Caption         =   "普通查询"
      End
      Begin VB.Menu menuFindCustomizeItem 
         Caption         =   "自定义查询(&C)"
      End
      Begin VB.Menu menufindelsemap 
         Caption         =   "按地图区域查询"
      End
   End
   Begin VB.Menu mnuTools 
      Caption         =   "工具"
      Begin VB.Menu mnuToolsArrow 
         Caption         =   "&Arrow"
      End
      Begin VB.Menu mnuToolsZoomIn 
         Caption         =   "放大(&I)"
      End
      Begin VB.Menu mnuToolsZoomOut 
         Caption         =   "缩小(&O)"
      End
      Begin VB.Menu mnuToolsPan 
         Caption         =   "漫游地图(&P)"
      End
      Begin VB.Menu mnuToolsRuler 
         Caption         =   "测量距离(&R)"
      End
      Begin VB.Menu mnuToolsSelect 
         Caption         =   "选择(&S)"
      End
      Begin VB.Menu mnuToolsSelectRectangle 
         Caption         =   "矩形选择(&E)"
      End
      Begin VB.Menu mnuToolsSelectRadius 
         Caption         =   "半径选择(&O)"
      End
      Begin VB.Menu mnuToolsSelectPolygon 
         Caption         =   "边界选择(&J)"
      End
   End
   Begin VB.Menu mnuView 
      Caption         =   "视图"
      Begin VB.Menu mnuViewToolbar 
         Caption         =   "工具条"
      End
      Begin VB.Menu mnuViewMapTools 
         Caption         =   "地图工具"
      End
      Begin VB.Menu mnuViewStatusBar 
         Caption         =   "状态条"
      End
      Begin VB.Menu mnuViewBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewRefresh 
         Caption         =   "刷新"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于...."
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Dim MouseDownX1 As Double ' The ruler tool displays the distance as the mouse is moved.
Dim MouseDownY1 As Double
Dim CheckedMenu As Menu ' The "Tools" menu item that is currently checked
Dim PressedButton As Button ' The Map Tool button that is currently down
Public searchLayer As Object     '搜索层对象


Private Sub Commandinfo_Click()
Map1.CurrentTool = infotool
End Sub

Private Sub Commandclear_Click()

End Sub





Private Sub FindAreaItem_Click()

End Sub


Private Sub FindCustomizeItem_Click()
FindCustomize.Show vbModal, Me '显示查询对话框
End Sub

Private Sub FindFountItem_Click()
FindFount.Show vbModal, Me
End Sub
Private Sub FindNameItem_Click()
FindName.Show , Me
End Sub


Private Sub Form_Load()
 '  Frmbegin.Show vbModal, Me
    Dim sFile As String
    sFile = App.Path & "\maps\四川省行政区划图.gst"
    Map1.Geoset = sFile

    
    
    '界面设置工作
    Map1.Title.Visible = False
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    Me.WindowState = GetSetting(App.Title, "Settings", "WindowState", vbNormal)

    ' Restore the settings that we saved in Form_Unload
   ' UsePolyRuler = GetSetting(App.Title, "Settings", "PolyRuler", False)
'    ExportFormat = GetSetting(App.Title, "Settings", "ExportFormat", miFormatBMP)
    ExportFormatString = GetSetting(App.Title, "Settings", "ExportFormatString", "Windows Bitmap")
    ExportFormatExt = GetSetting(App.Title, "Settings", "ExportFormatExt", "*.bmp")
  '  ExportWidth = GetSetting(App.Title, "Settings", "ExportWidth", 0#)
   ' ExportHeight = GetSetting(App.Title, "Settings", "ExportHeight", 0#)
   ' RulerUnit = GetSetting(App.Title, "Settings", "RulerUnit", miUnitMile)
    RulerUnitString = GetSetting(App.Title, "Settings", "RulerUnitString", "Miles")
    'Map1.MapUnit = RulerUnit
    Map1.MapUnit = miUnitMeter
    
    mnuViewToolbar.Checked = GetSetting(App.Title, "Settings", "ToolbarVisibility", True)
    mnuViewStatusBar.Checked = GetSetting(App.Title, "Settings", "StatusBarVisibility", True)
    mnuViewMapTools.Checked = GetSetting(App.Title, "Settings", "MapToolsVisibility", True)
    tbToolBar.ImageList = imlToolbarIcons
    tbToolBar.Visible = mnuViewToolbar.Checked
    'Toolbar1.Visible = mnuViewMapTools.Checked
    Toolbar1.Visible = True
    sbStatusBar.Visible = mnuViewStatusBar.Checked
    Map1.PaperUnit = miPaperUnitInch
    Set CheckedMenu = mnuToolsArrow
    Set PressedButton = Toolbar1.Buttons(1)
    CheckedMenu.Checked = True
    PressedButton.Value = tbrPressed
    
    mapCombo1.AddItem "四川省地貌区划图"
    mapCombo1.AddItem "四川省农业气候区划图"
    mapCombo1.AddItem "四川省水利区划图"
    mapCombo1.AddItem "四川省农业水文地质区划图"
    mapCombo1.AddItem "四川省乡镇企业区划图"
    mapCombo1.AddItem "四川省畜牧业区划图"
    mapCombo1.AddItem "四川省渔业区划图"
    mapCombo1.AddItem "四川省种植业区划图"
    mapCombo1.AddItem "四川省综合农业区划图"
    mapCombo1.AddItem "四川省行政区划图"
    mapCombo1.ListIndex = 9   '行政区划图
    
    '创建地图工具条
    Map1.CreateCustomTool RulerToolID, miToolTypeLine, miSizeAllCursor
    Map1.CreateCustomTool PolyRulerToolID, miToolTypePoly, miSizeAllCursor
    Map1.CreateCustomTool SEARCH_DISTANCE_TOOL, miToolTypeCircle, miRadiusSelectCursor
    Map1.CreateCustomTool SEARCH_RECTANGLE_TOOL, miToolTypeMarquee, miRectSelectCursor
    Map1.CreateCustomTool SEARCH_FEATURE_TOOL, miToolTypePoint, miSelectCursor
    Map1.CreateCustomTool SEARCH_POINT_TOOL, miToolTypePoint, miCenterCursor
    Map1.CreateCustomTool infotool, miToolTypePoint, miCrossCursor
    '创建数据集
     'Map1.Datasets.BuildSourceRows = True
'     Map1.Datasets.Add miDataSetLayer, Map1.Layers("1g12"), "1g12"   '四川省行政区划图属性表
'     '/*以下为作专题图创建的dataset
'     Dim db As Database
'     Dim myrs As Recordset
'     Set db = OpenDatabase(App.Path & "\scdb_yearsdata.mdb")
'     Set myrs = db.OpenRecordset("1g12_1999")
'     fMainForm.Map1.Datasets.Add miDataSetDAO, myrs, "1g12_1999", "行政代码", , "1g12"  '*/为作专题图创建的dataset
End Sub

Private Sub Form_Resize() '分配程序区域
   
    If Me.ScaleWidth > 420 And Me.ScaleHeight > tbToolBar.Height + sbStatusBar.Height Then
        Map1.Top = tbToolBar.Height + 200
        Map1.Height = Me.ScaleHeight - tbToolBar.Height - 380 - sbStatusBar.Height
        Map1.Left = 570
        Map1.Width = Me.ScaleWidth - 750
        Shape1.Top = 480
        Shape1.Height = Me.ScaleHeight - tbToolBar.Height - 100 - sbStatusBar.Height
        Shape1.Left = 460
        Shape1.Width = Me.ScaleWidth - 540
       ' ProBar1

'       If tbToolBar.Visible = True Then
'            Map1.Top = tbToolBar.Height + 200
'            Map1.Height = Me.ScaleHeight - tbToolBar.Height - 200 - sbStatusBar.Height
'           Else
'            Map1.Top = 0
'            Map1.Height = Me.ScaleHeight
'        End If
'
'        If Toolbar1.Visible = True Then
'            Map1.Left = 380 + 200 ' The width of the Map Tools toolbar
'            Map1.Width = Me.ScaleWidth - 500 - 200
'          Else
'            Map1.Left = 0
'            Map1.Width = Me.ScaleWidth - 500
'        End If
        
'        If sbStatusBar.Visible = True Then
'            Map1.Height = Map1.Height - sbStatusBar.Height
'        End If
    End If
    End Sub