frmmain.frm

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

      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7} 
         NumListImages   =   11
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":0C51
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":0F6B
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":1285
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":159F
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":18B9
            Key             =   ""
         EndProperty
         BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":1BD3
            Key             =   ""
         EndProperty
         BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":1EED
            Key             =   ""
         EndProperty
         BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":2207
            Key             =   ""
         EndProperty
         BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":2521
            Key             =   ""
         EndProperty
         BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":283B
            Key             =   ""
         EndProperty
         BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7} 
            Picture         =   "frmMain.frx":2B55
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Text
Option Explicit

' This sample application and corresponding sample code is provided
' for example purposes only.  It has not undergone rigorous testing
' and as such should not be shipped as part of a final application
' without extensive testing on the part of the organization releasing
' the end-user product.

Dim bDatasets As Boolean, rsSales As Recordset, rsRepres As Recordset, rsDemographic As Recordset, bHandlerOff As Boolean
Dim dSalesTotal As Double, StateLayer As MapXLib.Layer, StateSel As MapXLib.Selection

Private Sub ckDemographic_Click()
  If ckDemographic.Value = 1 Then
' Add the demographic bar theme
    mapxMap.Datasets("Demographic").Themes.Add 1, 3, "Demographic"
    mapxMap.Datasets("Demographic").Themes(1).Legend.Compact = False
    mapxMap.Datasets("Demographic").Themes(1).Properties.MultivarCategories(1).Style.RegionColor = vbMagenta
  Else
' Remove the demographic theme
    If mapxMap.Datasets("Demographic").Themes.Count > 0 Then
      mapxMap.Datasets("Demographic").Themes.Remove 1
    End If
  End If
End Sub

Private Sub ckFilter_Click()
  If ckFilter.Value = 1 Then
    MakeDataFilter
    lblTotalValue.Caption = Format(CalculateSum(dataSales.Recordset, 2), "#,#")
  Else
    Set dataSales.Recordset = rsSales
    lblTotalValue.Caption = Format(dSalesTotal, "#,#")
  End If
End Sub

Private Sub ckLabel_Click()
' Control States layer auto-label option
  StateLayer.AutoLabel = (ckLabel.Value = 1)
End Sub

Private Sub ckRepres_Click()
  If ckRepres.Value = 1 Then
    If mapxMap.Datasets("Representative").Themes.Count = 0 Then
      mapxMap.Datasets("Representative").Themes.Add 5, 3, "Individual Representatives"
      mapxMap.Datasets("Representative").Themes(1).Legend.Compact = False
    End If
  Else
    If mapxMap.Datasets("Representative").Themes.Count > 0 Then
      mapxMap.Datasets("Representative").Themes.Remove 1
    End If
  End If
End Sub

Private Sub ckRevenue_Click()
  If ckRevenue.Value = 1 Then
' Add the sales revenue pie theme
    If mapxMap.Datasets("Sales").Themes.Count = 0 Then
      mapxMap.Datasets("Sales").Themes.Add 2, 3, "Sales"
      mapxMap.Datasets("Sales").Themes(1).Legend.Compact = False
      mapxMap.Datasets("Sales").Themes(1).Properties.MultivarCategories(1).Style.RegionColor = RGB(160, 120, 0)
    End If
  Else
' Remove the sales revenue theme
    If mapxMap.Datasets("Sales").Themes.Count > 0 Then
      mapxMap.Datasets("Sales").Themes.Remove 1
    End If
  End If
End Sub

Private Sub cmdCancel_Click()
  Unload Main
End Sub

Private Sub cmdModifyTheme_Click()
  ModifyTheme.Activate mapxMap
End Sub

Private Sub cmdNewRepres_Click()
  AssignRepres.Activate dataReps, StateSel, mapxMap.Datasets("Representative")
End Sub

Private Sub cmdPrint_Click()
  PrintMapX mapxMap
End Sub

Private Sub Form_Activate()
  If Not bDatasets Then
' Add the datasets, if they were not added before
    mapxMap.Datasets.Add miDataSetDAO, dataDemographic.Recordset.Clone, "Demographic"
    mapxMap.Datasets.Add miDataSetDAO, dataReps.Recordset.Clone, "Representative"
    mapxMap.Datasets.Add miDataSetDAO, dataSales.Recordset.Clone, "Sales"
' Adjust grid columns' width
    gridSales.Columns(0).Width = 1000
    gridSales.Columns(1).Width = 1620
    gridSales.Columns(2).Width = 1760
    bDatasets = True
' Store recordsets
    Set rsSales = dataSales.Recordset
    Set rsRepres = dataReps.Recordset
    Set rsDemographic = dataDemographic.Recordset
' Make info tool
    mapxMap.CreateCustomTool 1, miToolTypePoint, miCrossCursor
' Calculate total sales
    dSalesTotal = CalculateSum(dataSales.Recordset, 2)
    lblTotalValue.Caption = Format(dSalesTotal, "#,#")
    gridSales.Visible = True
' Set States layer
    Set StateLayer = mapxMap.Layers("USA")
    Set StateSel = StateLayer.Selection
' Move Focus to the tool bar
    ckRepres.SetFocus
  End If
End Sub

Private Function CalculateSum(rs As Recordset, ByVal iFldInd As Integer) As Double
  Dim dSum As Double

  If rs.BOF And rs.EOF Then
    CalculateSum = 0
    Exit Function
  End If
  
  rs.MoveFirst
  dSum = 0
  Do
    dSum = dSum + rs.Fields(iFldInd).Value
    rs.MoveNext
  Loop While Not rs.EOF
  rs.MoveFirst
  CalculateSum = dSum
End Function

Private Sub Form_Load()
  bDatasets = False
' Initialize the data source path
  dataReps.DatabaseName = App.Path
  dataDemographic.DatabaseName = dataReps.DatabaseName
  dataSales.DatabaseName = dataReps.DatabaseName
'  gridSales.DragIcon = LoadPicture(App.Path & "\drag1pg.ico")
  bHandlerOff = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
  End
End Sub

Private Sub mapxMap_DragDrop(Source As Control, X As Single, Y As Single)
  If Source.Name = "gridSales" Then
    If mapxMap.Datasets("Sales").Themes.Count > 0 Then
      Exit Sub
    End If
    ckRevenue.Value = 1
    ckRevenue_Click
  End If
End Sub

Private Sub mapxMap_SelectionChanged()
  cmdNewRepres.Enabled = (StateSel.Count > 0)
  If bHandlerOff Then
    Exit Sub
  End If
  If ckFilter.Value = 1 Then
    MakeDataFilter
    lblTotalValue.Caption = Format(CalculateSum(dataSales.Recordset, 2), "#,#")
  End If
End Sub

Private Sub mapxMap_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)
  Dim sAnnot As String

  If ToolNum = miTextTool Then
'    sAnnot = InputBox("Exter annotation text", "Add annotation")
'    If sAnnot = "" Then
'      Exit Sub
'    End If
'    mapxMap.Annotations.AddText sAnnot, X1, Y1
  ElseIf ToolNum = 1 Then ' info tool
    ShowInfo X1, Y1
  End If
End Sub

Private Sub tlbMapTools_ButtonClick(ByVal Button As Button)
  Dim i As Integer

' Control the Map object tools
  Select Case Button.Index
    Case 1
      mapxMap.CurrentTool = miArrowTool
    Case 2
      mapxMap.CurrentTool = miPanTool
    Case 3
      mapxMap.CurrentTool = miZoomInTool
    Case 4
      mapxMap.CurrentTool = miZoomOutTool
    Case 5
      mapxMap.CurrentTool = miCenterTool
    Case 6
      mapxMap.CurrentTool = miTextTool
    Case 7
      mapxMap.CurrentTool = 1 ' info tool
    Case 9
      mapxMap.CurrentTool = miSelectTool
    Case 10
      mapxMap.CurrentTool = miRectSelectTool
    Case 11
      mapxMap.CurrentTool = miRadiusSelectTool
    Case 12
      StateSel.SelectAll miSelectionNew
      mapxMap.AutoRedraw = True
      Exit Sub
  End Select
  For i = 1 To tlbMapTools.Buttons.Count - 1
    tlbMapTools.Buttons(i).Value = 0
  Next
  If Button.Index = 7 Then
    ckFilter.Value = 0
    ckFilter.Enabled = False
    tlbMapTools.Buttons(12).Enabled = False
  Else
    ckFilter.Enabled = True
    tlbMapTools.Buttons(12).Enabled = True
  End If
  Button.Value = 1
End Sub

Private Sub MakeDataFilter()
  Dim rs As Recordset, sFilter As String, i As Integer, sel As Feature, sep As String

  Set rs = rsSales.OpenRecordset(dbOpenDynaset)
  sFilter = "Ucase(STATE) IN("
  sep = ""
  For Each sel In StateSel
    sFilter = sFilter & sep & "'" & sel.Name & "'"
    sep = ","
  Next
  If sep = "" Then
    sFilter = "STATE=''"
  Else
    sFilter = sFilter & ")"
  End If
  rs.Filter = sFilter
  Set dataSales.Recordset = rs.OpenRecordset
  mapxMap.SetFocus
  rs.Close
End Sub

Private Sub ShowInfo(ByVal X As Double, ByVal Y As Double)
  Dim sName As String, rs As Recordset, rs2 As Recordset

  bHandlerOff = True
  StateSel.SelectByPoint X, Y, miSelectionNew
  If StateSel.Count < 1 Then
    lblInfoRepres.Caption = ""
    lblInfoState.Caption = ""
    lblInfoRevenue.Caption = ""
    lblInfoPopulation.Caption = ""
    bHandlerOff = False
    Exit Sub
  End If
  sName = StateSel(1).Name
  
  Set rs = rsRepres.OpenRecordset(dbOpenDynaset)
  rs.Filter = "Ucase(STATE) ='" & sName & "'"
  Set rs2 = rs.OpenRecordset
  rs2.MoveFirst
  lblInfoRepres.Caption = rs2.Fields(2).Value
  lblInfoState.Caption = rs2.Fields(1).Value
  rs2.Close
  rs.Close
  
'  lblInfoState.Caption = sName
  
  Set rs = rsSales.OpenRecordset(dbOpenDynaset)
  rs.Filter = "Ucase(STATE) ='" & sName & "'"
  Set rs2 = rs.OpenRecordset
  rs2.MoveFirst
  lblInfoRevenue.Caption = rs2.Fields(2).Value
  rs2.Close
  rs.Close
  
  Set rs = rsDemographic.OpenRecordset(dbOpenDynaset)
  rs.Filter = "Ucase(STATE) ='" & sName & "'"
  Set rs2 = rs.OpenRecordset
  rs2.MoveFirst
  lblInfoPopulation.Caption = rs2.Fields(2).Value
  rs2.Close
  rs.Close

  bHandlerOff = False
End Sub