VB+mapx实现各种专题图的事例

 

Private Sub Command5_Click()
'创建专题图层

     Dim oDs As MapXLib.Dataset
     Dim oLayer As MapXLib.Layer
     Dim oTheme As MapXLib.Theme
     Dim oFields As New MapXLib.Fields
     Dim oField As MapXLib.Field
     Dim oCoordSys As MapXLib.CoordSys
    
     Dim strLayerName As String
     Dim nType As Integer
    
     Dim s As Integer
    
'改变投影系
     Set oCoordSys = Map1.DisplayCoordSys.Clone
     SetCoordsys
        
'设置专题图层
     strLayerName = GetThemeLayerName()
     If strLayerName = "" Then
         MsgBox "请选择绑定图层"
         Exit Sub
     End If
    
'设置专题绑定数据集
     Set oLayer = Map1.Layers.Item(strLayerName)
     Map1.DataSets.RemoveAll
     Set oDs = Map1.DataSets.Add(miDataSetLayer, oLayer, oLayer.KeyField)

'获得专题图类型
     nType = GetThemeType
     If nType = -1 Or nType = 9 Then
         MsgBox "请选择专题类型"
         Exit Sub
     End If

'设置专题图
     oFields.RemoveAll
     Set oField = oFields.Add(oDs.Fields.Item(2), "data1"
    
     oDs.Themes.RemoveAll
     If nType = 1 Or nType = 2 Then
         oFields.Add oDs.Fields.Item(3), "data2"

         Set oTheme = oDs.Themes.Add(nType, oFields)
     ElseIf nType = 9 Then
         'Set oTheme = oDs.Themes.Add(nType)
     Else
         Set oTheme = oDs.Themes.Add(nType, oField)
     End If
    
   
   
'还原投影系
    
     Set Map1.DisplayCoordSys = oCoordSys
     'Set Map1.NumericCoordSys = oCoordSys
     Set Map1.NumericCoordSys = Map1.DisplayCoordSys
    
End Sub
Sub SetCoordsys()
'设置投影系
     Dim oDatum As New MapXLib.Datum

     oDatum.Set 0, 0, 0, 0, 0, 0, 0, 0, 0
     Map1.DisplayCoordSys.Set miLongLat, oDatum, miUnitDegree
     Set Map1.NumericCoordSys = Map1.DisplayCoordSys

End Sub

Private Function GetThemeType() As Integer
'获得专题图类型
     Dim nType As Integer, nIndex As Integer
    
     nIndex = Combo1.ListIndex
    
     Select Case nIndex
    
         Case 0   '范围图
             nType = 0
         Case 1   '柱状图
             nType = 1
         Case 2   '饼状图
             nType = 2
         Case 3   '等级符号图
             nType = 3
         Case 4   '点密度图
             nType = 4
         Case 5   '独立值图
             nType = 5
         Case 6   '自动专题图
             nType = 6
         Case 7   '标注范围专题图
             nType = 7
         Case 8   '标注独立值专题图
             nType = 8
         Case 9   '非专题图
             nType = 9
            
         Case Else    '提示用户选择专题类型
             nType = -1
        
     End Select
    
     GetThemeType = nType
    
End Function

Private Function GetThemeLayerName() As String
'获得专题图层名称
     Dim strLayerName As String
     Dim nIndex As Integer
    
     nIndex = Combo2.ListIndex
     If nIndex < 0 Then
         strLayerName = ""
     Else
         strLayerName = Combo2.List(nIndex)
     End If
    
     GetThemeLayerName = strLayerName
    
End Function

Private Sub Form_Load()

     Dim i As Integer, nLayerCount As Integer
    
'加载专题图类型
     Combo1.AddItem "范围图", 0
     Combo1.AddItem "柱状图", 1
     Combo1.AddItem "饼状图", 2
     Combo1.AddItem "等级符号图", 3
     Combo1.AddItem "点密度图", 4
     Combo1.AddItem "独立值图", 5
     Combo1.AddItem "自动专题图", 6
     Combo1.AddItem "标注范围专题图", 7
     Combo1.AddItem "标注独立值专题图", 8
     Combo1.AddItem "非专题图", 9

'加载图层列表
    
     If Map1.Layers.Count > 0 Then
         nLayerCount = Map1.Layers.Count
         For i = 1 To nLayerCount
            Combo2.AddItem Map1.Layers.Item(i).Name, i - 1
         Next
     End If
    
End Sub