main.frm

MapX示例程序：编辑特征示例

         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Map.Layers.Layer5.LabelProperties.Style.LineStyle=   1
      Map.Layers.Layer5.LabelProperties.Style.LineWidth=   1
      Map.NumericCoordSys.ProjectionInfo=   "Main.frx":0000
      Map.DisplayCoordSys.ProjectionInfo=   "Main.frx":0130
      Map.Zoom        =   3840.25
      Map.CenterX     =   133.530048
      Map.CenterY     =   -26.9901905
      FeatureEditMode =   1
   End
   Begin VB.CommandButton Command4 
      Caption         =   "选择"
      Height          =   375
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   855
   End
   Begin VB.CommandButton Command3 
      Caption         =   "平移"
      Height          =   375
      Left            =   840
      TabIndex        =   2
      Top             =   0
      Width           =   855
   End
   Begin VB.CommandButton Command2 
      Caption         =   "放大"
      Height          =   375
      Left            =   1680
      TabIndex        =   1
      Top             =   0
      Width           =   855
   End
   Begin VB.CommandButton Command1 
      Caption         =   "缩小"
      Height          =   375
      Left            =   2520
      TabIndex        =   0
      Top             =   0
      Width           =   855
   End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
    '放大功能
    Map1.CurrentTool = miZoomOutTool
End Sub

Private Sub Command2_Click()
    '缩小功能
    Map1.CurrentTool = miZoomInTool
End Sub

Private Sub Command3_Click()
    '平移功能
    Map1.CurrentTool = miPanTool
End Sub

Private Sub Command4_Click()
    '选择功能
    Map1.CurrentTool = miSelectTool
End Sub

Private Sub Command5_Click()
    '全图显示功能
    Set Map1.Bounds = Map1.Layers.Bounds
End Sub

Private Sub Command6_Click()
    '调用MapX内置的"专题图属性设置"对话框
    Map1.DataSets("ASIA_Data").Themes(1).ThemeDlg
End Sub

Private Sub Command7_Click()
    '调用MapX内置的"图例设置"对话框
    Map1.DataSets("ASIA_Data").Themes(1).Legend.LegendDlg
End Sub

Private Sub Command8_Click()
    Dim ThemeType As Long
    '当前要生成的专题图是否接受多字段
    Dim IsMultiVariateTheme As Boolean
    
    '由于生成专题图需要一定时间,设置鼠标光标
    Me.MousePointer = vbHourglass
    
    '判断欲生成的专题图类型,并判断是否接受多个字段
    Select Case ThemeTypeCombo.ListIndex
        Case 0  '范围专题图
            ThemeType = miThemeRanged
            IsMultiVariateTheme = False
        Case 1  '条状专题图
            ThemeType = miThemeBarChart
            IsMultiVariateTheme = True
        Case 2  '饼状专题图
            ThemeType = miThemePieChart
            IsMultiVariateTheme = True
        Case 3  '分级符号专题图
            ThemeType = miThemeGradSymbol
            IsMultiVariateTheme = False
        Case 4  '点密度专题图
            ThemeType = miThemeDotDensity
            IsMultiVariateTheme = False
        Case 5  '个别值专题图
            ThemeType = miThemeIndividualValue
            IsMultiVariateTheme = False
        Case Else   '自动生成专题图
            ThemeType = miThemeAuto
            IsMultiVariateTheme = True
    End Select
    
    '判断是否接受多个字段
    If IsMultiVariateTheme = True Then
        '判断用户是否选择字段
        If MultiFieldList.SelCount = 0 Then
            MsgBox "请选择生成专题图所依据的字段!", vbInformation, "注意"
            Exit Sub
        End If
        
        '用户选择多个字段,因此需要生成字段名列表
        Dim FieldList() As String
        ReDim FieldList(1 To MultiFieldList.SelCount)
        Dim i As Long, j As Long
        j = 1
        For i = 0 To MultiFieldList.ListCount - 1
            If MultiFieldList.Selected(i) Then
                '添加字段名到列表中
                FieldList(j) = MultiFieldList.List(i)
                j = j + 1
            End If
        Next i
        
        '根据用户是否指定专题图名称调用Add方法生成专题图
        If NameText.Text <> "" Then
            Map1.DataSets("ASIA_Data").Themes.Add ThemeType, FieldList, NameText.Text
        Else
            Map1.DataSets("ASIA_Data").Themes.Add ThemeType, FieldList
        End If
    Else
        '判断用户是否选择字段
        If SingleFieldList.ListIndex = -1 Then
            MsgBox "请选择生成专题图所依据的字段!", vbInformation, "注意"
            Exit Sub
        End If
        
        '根据用户是否指定专题图名称调用Add方法生成专题图
        If NameText.Text <> "" Then
            Map1.DataSets("ASIA_Data").Themes.Add _
                ThemeType, SingleFieldList.Text, NameText.Text
        Else
            Map1.DataSets("ASIA_Data").Themes.Add _
                ThemeType, SingleFieldList.Text
        End If
    End If
    '恢复鼠标光标
    Me.MousePointer = vbDefault
    
End Sub

Private Sub Command9_Click()
    '删除所有专题图
    Map1.DataSets("ASIA_Data").Themes.RemoveAll
End Sub

Private Sub Form_Load()
    Data1.DatabaseName = "C:\Program Files\MapInfo\MapX 5.0\data\Mapstats.mdb"
    Data1.RecordSource = "AUSTRALIA"
    Data1.Refresh
    Map1.DataSets.Add miDataSetDAO, Data1.Recordset.Clone, "ASIA_Data"
    Call Map1.DataSets("ASIA_Data").Themes.Add(miThemeIndividualValue, "GEOName", "GEO")
    Call InitThemeType
    
End Sub

Private Sub InitThemeType()
    '初始化专题图类别
    ThemeTypeCombo.Clear
    ThemeTypeCombo.AddItem "范围专题图" '（miThemeRanged）
    ThemeTypeCombo.AddItem "柱状专题图" '（miThemeBarChart）
    ThemeTypeCombo.AddItem "饼状专题图" '（miThemePieChart）
    ThemeTypeCombo.AddItem "分级符号专题图" '（miThemeGradSymbol）
    ThemeTypeCombo.AddItem "点密度专题图" '（miThemeDotDensity）
    ThemeTypeCombo.AddItem "个别值专题图" '（miThemeIndividualValue）
    ThemeTypeCombo.AddItem "自动"
    ThemeTypeCombo.ListIndex = 0
End Sub
Private Sub ThemeTypeCombo_Click()
    '本实例有两个字段列表框,分别用于选择单个字段和多个字段
    '当专题图类别改变时,需要改变这两个列表框的可见情况
    Select Case ThemeTypeCombo.ListIndex
        Case 0, 3, 4, 5     '单变量专题图
            SingleFieldList.Visible = True
            SingleFieldList.ListIndex = MultiFieldList.ListIndex
            MultiFieldList.Visible = False
        Case 1, 2, 6        '多变量专题图
            MultiFieldList.Visible = True
            MultiFieldList.ListIndex = SingleFieldList.ListIndex
            SingleFieldList.Visible = False
    End Select
    
    '某些专题图只支持数值类型字段,因此需要重新填写字段列表框
    Call RefillFieldList
    
End Sub

Private Sub RefillFieldList()
    
    '填写两个字段列表框
    SingleFieldList.Clear
    MultiFieldList.Clear
    
    Dim fld As MapXLib.Field
    Dim ds As MapXLib.Dataset
    Dim i As Long
    Set ds = Map1.DataSets("ASIA_Data")
    
    If ThemeTypeCombo.ListIndex = 5 Then
        '个别值专题图支持所有类型字段
        For Each fld In ds.Fields
            SingleFieldList.AddItem fld.Name
            MultiFieldList.AddItem fld.Name
        Next
    Else
        '其它专题图只支持数值类型字段,因此只添加这类字段到列表框
        For Each fld In ds.Fields
            If fld.Type = miTypeNumeric Then
                SingleFieldList.AddItem fld.Name
                MultiFieldList.AddItem fld.Name
            End If
        Next
    End If
    
End Sub