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

最新推荐文章于 2020-11-29 21:42:03 发布

weixin_34255793

最新推荐文章于 2020-11-29 21:42:03 发布

阅读量508

点赞数

   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

from: http://www.zdor.cn/inst/html/info/200845.html