frmmain.frm

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

Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer

    '关闭所有子窗口,用 SaveSetting 语句将一个新值保存至存储于应用程序注册位置中的注册表项中。
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    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
    
    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 Help_Click()
'SendKeys "{F1}"
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
       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
              
        Map1.MapUnit = RulerUnit
        Map1.ConvertCoord x, y, X2, Y2, miScreenToMap '将鼠标捕获的屏幕坐标转换为地图坐标
        
        '显示正常的小数形式
        If CDec(Map1.Distance(MouseDownX1, MouseDownY1, X2, Y2)) < 1 And CDec(Map1.Distance(MouseDownX1, MouseDownY1, X2, Y2)) > 0 Then
        sbStatusBar.SimpleText = "0" & CDec(Map1.Distance(MouseDownX1, MouseDownY1, X2, Y2)) & " " & RulerUnitString
        Else
        sbStatusBar.SimpleText = CDec(Map1.Distance(MouseDownX1, MouseDownY1, X2, Y2)) & " " & RulerUnitString
        End If
    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
        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
        If Flags = miPolyToolEnd Then
            'First, clear the status bar
            sbStatusBar.SimpleText = ""
            
            '显示正常的小数形式
            Dim TempDb  As Double
            TempDb = CDec(DistanceSoFar)
            'If CDec(DistanceSoFar) < 1 And CDec(DistanceSoFar) > 0 Then
            If TempDb < 1 And TempDb > 0 Then
            'MsgBox "两地折线距离为：0" & CDec(DistanceSoFar) * 1000000 & " " & RulerUnitString
            MsgBox "两地折线距离为：0" & TempDb & " " & RulerUnitString
            Else
            'MsgBox "两地折线距离为： " & CDec(DistanceSoFar) * 1000000 & " " & RulerUnitString
            MsgBox "两地折线距离为：" & TempDb & " " & RulerUnitString
            End If
        Else
            sbStatusBar.SimpleText = CDec(DistanceSoFar) & " " & RulerUnitString
        End If
    End If
End Sub
Private Sub Map1_SelectionChanged()
    Dim i As Long, j As Long
    Dim SelectFeatures  As MapXLib.Features
    Dim SelectFeature   As New Feature
    Dim ds              As Dataset
    Dim rvs             As MapXLib.RowValues
    Dim rv              As MapXLib.RowValue
    Dim myflag As Boolean   '判断yearsdata是否被绑定
    Dim SelectPoint     As New MapXLib.Point  '用以判断选中的1g12的feature中心点在aa中的哪个feature中
    Dim curfeatures     As MapXLib.Features
    Dim DsRows As Long, DsCols As Long       'MSflexgrid 的行和列
    Dim selectfeature_aa As New Feature
    Dim myfeatures_aa As Features  '定义aa层中features
    Dim myfeature_aa As Feature    '定义aa层中feature
    Dim FoundFeatures_aa As Features    '定义查找的被包含在aa中某个feature的属于1g12的features集合
    Dim selectfeatures_1g12 As Features ' 定义1g12层中的features
    Dim mypoints As New MapXLib.Points
    Dim mystring As String
    Dim myvalue As Integer

    ProBar1.Min = 0
    ProBar1.Value = 0
    ProBar1.Max = 100

   On Error Resume Next

   myflag = False
   For i = 1 To Map1.Datasets.Count
       If Map1.Datasets.Item(i).Name = "1g12_year" Then
          myflag = True      '说明yearsdata被绑定
          Exit For
       End If
   Next
  If fMainForm.Map1.Layers("1g12").Selection.Count > 0 Then
      Unload frmSelectnone
      If fMainForm.Map1.Layers("1g12").Selection.Count < 2 Then  '有一个地物被选中
         Unload frmselectmore
         Unload frminfo
         Set SelectFeature = fMainForm.Map1.Layers("1g12").Selection.Item(1)
         Set ds = Map1.Datasets.Item("1g12")
         frmSelectPoint.List1.Clear
         If frmSelectPoint.List1.ListCount > 0 Then
            For i = 0 To frmSelectPoint.List1.ListCount
                frmSelectPoint.List1.RemoveItem (i)
            Next
         End If
        frmSelectPoint.List1.AddItem "     县名         |" & ds.RowValues(SelectFeature).Item("县名").Value
        frmSelectPoint.List1.AddItem "    行政代码      |" & ds.RowValues(SelectFeature).Item("行政代码").Value
        frmSelectPoint.List1.AddItem "    邮政编码      |" & ds.RowValues(SelectFeature).Item("邮政编码").Value
        frmSelectPoint.List1.AddItem "土地面积(平方公里)|" & ds.RowValues(SelectFeature).Item("土地面积").Value
         If Map1.Geoset <> App.Path & "\maps\四川省行政区划图.gst" Then      '针对其它地图
             ProBar1.Visible = True
            '/*地貌层*/
             Set myfeatures_aa = fMainForm.Map1.Layers.Item("a-地貌").AllFeatures
             '/*以下判断1g12层中selectfeature的被包含在aa层中的哪个feature中*/
             i = 1     '判断是否第一次给list1 add item，如果是第一次要加上“所属地貌类型 ”这四个字，否则不要加这几个字
             For Each myfeature_aa In myfeatures_aa
                If Map1.FeatureFactory.IntersectionTest(SelectFeature, myfeature_aa, 1) Then
                   Set ds = fMainForm.Map1.Datasets.Item("a-dm")
                   If i = 1 Then
                      frmSelectPoint.List1.AddItem "   所属地貌类型   |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   Else
                      frmSelectPoint.List1.AddItem "                  |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   End If
                   i = i + 1
                End If
             Next
             ProBar1.Value = ProBar1.Value + 11
             
             '/*气候层*/
             Set myfeatures_aa = fMainForm.Map1.Layers.Item("a-气候").AllFeatures
             '/*以下判断1g12层中selectfeature的被包含在aa层中的哪个feature中*/
             i = 1     '判断是否第一次给list1 add item，如果是第一次要加上“所属地貌类型 ”这四个字，否则不要加这几个字
             For Each myfeature_aa In myfeatures_aa
                If Map1.FeatureFactory.IntersectionTest(SelectFeature, myfeature_aa, 1) Then
                   Set ds = fMainForm.Map1.Datasets.Item("a-qh")
                   If i = 1 Then
                      frmSelectPoint.List1.AddItem "   所属气候类型   |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   Else
                      frmSelectPoint.List1.AddItem "                  |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   End If
                   i = i + 1
                End If
             Next
             ProBar1.Value = ProBar1.Value + 11
             
             '/*水利层*/
             Set myfeatures_aa = fMainForm.Map1.Layers.Item("a-水利").AllFeatures
             '/*以下判断1g12层中selectfeature的被包含在aa层中的哪个feature中*/
             i = 1     '判断是否第一次给list1 add item，如果是第一次要加上“所属地貌类型 ”这四个字，否则不要加这几个字
             For Each myfeature_aa In myfeatures_aa
                If Map1.FeatureFactory.IntersectionTest(SelectFeature, myfeature_aa, 1) Then
                   Set ds = fMainForm.Map1.Datasets.Item("a-sl")
                   If i = 1 Then
                      frmSelectPoint.List1.AddItem "   所属水利类型   |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   Else
                      frmSelectPoint.List1.AddItem "                  |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   End If
                   i = i + 1
                End If
             Next
             ProBar1.Value = ProBar1.Value + 11
             
             '/*水文层*/
             Set myfeatures_aa = fMainForm.Map1.Layers.Item("a-水文").AllFeatures
             '/*以下判断1g12层中selectfeature的被包含在aa层中的哪个feature中*/
             i = 1     '判断是否第一次给list1 add item，如果是第一次要加上“所属地貌类型 ”这四个字，否则不要加这几个字
             For Each myfeature_aa In myfeatures_aa
                If Map1.FeatureFactory.IntersectionTest(SelectFeature, myfeature_aa, 1) Then
                   Set ds = fMainForm.Map1.Datasets.Item("a-sw")
                   If i = 1 Then
                      frmSelectPoint.List1.AddItem "   所属水文类型   |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   Else
                      frmSelectPoint.List1.AddItem "                  |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   End If
                   i = i + 1
                End If
                Set myfeature_inter = Nothing
             Next
             ProBar1.Value = ProBar1.Value + 11
             
             '/*企业层*/
             Set myfeatures_aa = fMainForm.Map1.Layers.Item("a-企业").AllFeatures
             '/*以下判断1g12层中selectfeature的被包含在aa层中的哪个feature中*/
             i = 1     '判断是否第一次给list1 add item，如果是第一次要加上“所属地貌类型 ”这四个字，否则不要加这几个字
             For Each myfeature_aa In myfeatures_aa
                If Map1.FeatureFactory.IntersectionTest(SelectFeature, myfeature_aa, 1) Then
                   Set ds = fMainForm.Map1.Datasets.Item("a-qy")
                   If i = 1 Then
                      frmSelectPoint.List1.AddItem " 所属乡镇企业类型 |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   Else
                      frmSelectPoint.List1.AddItem "                  |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   End If
                   i = i + 1
                End If
             Next
             ProBar1.Value = ProBar1.Value + 11
             
             '/*畜牧业层*/
             Set myfeatures_aa = fMainForm.Map1.Layers.Item("a-畜牧").AllFeatures
             '/*以下判断1g12层中selectfeature的被包含在aa层中的哪个feature中*/
             i = 1     '判断是否第一次给list1 add item，如果是第一次要加上“所属地貌类型 ”这四个字，否则不要加这几个字
             For Each myfeature_aa In myfeatures_aa
                If Map1.FeatureFactory.IntersectionTest(SelectFeature, myfeature_aa, 1) Then
                   Set ds = fMainForm.Map1.Datasets.Item("a-xm")
                   If i = 1 Then
                      frmSelectPoint.List1.AddItem "  所属畜牧业类型  |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   Else
                      frmSelectPoint.List1.AddItem "                  |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   End If
                   i = i + 1
                End If
             Next
             ProBar1.Value = ProBar1.Value + 11
             
             '/*渔业层*/
             Set myfeatures_aa = fMainForm.Map1.Layers.Item("a-渔业").AllFeatures
             '/*以下判断1g12层中selectfeature的被包含在aa层中的哪个feature中*/
             i = 1     '判断是否第一次给list1 add item，如果是第一次要加上“所属地貌类型 ”这四个字，否则不要加这几个字
             For Each myfeature_aa In myfeatures_aa
                If Map1.FeatureFactory.IntersectionTest(SelectFeature, myfeature_aa, 1) Then
                   Set ds = fMainForm.Map1.Datasets.Item("a-yy")
                   If i = 1 Then
                      frmSelectPoint.List1.AddItem "   所属渔业类型   |" & ds.RowValues(myfeature_aa).Item("说明").Value
                   Else
                      frmSelectPoint.List1.AddItem "                  |" & ds.RowValues(myfeature_aa).Item("说明").Value