代码.txt

基于vb.net和arcgis engine9.0开发的三种在地图专题图渲染实现方法

'引用的类
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Geometry
Public Class Form1
    '如何为一个层设置UniqueValue Renderer
    Private Sub ButtonClass_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonClass.Click
        Dim pTable As ITable
        Dim strOutput As String
        Dim strPopField As String
        '由"pop1990"字段返回频率数据，并据此对数据进行分类
        '第一步，定义featurelayer，并得到histogram数据
        Dim m_pGeoFeatureLayer As IGeoFeatureLayer
        Dim pTableHistogram As ITableHistogram
        Dim pHistogram As IBasicHistogram
        Dim dataFrequency As Object
        Dim dataValues As Object
        Dim pMap As IMap
        pMap = Me.AxMapControl1.Map
        m_pGeoFeatureLayer = pMap.Layer(0)
        pTable = m_pGeoFeatureLayer
        pTableHistogram = New BasicTableHistogram
        pHistogram = pTableHistogram
        '从pop1990 得到数据值和频率，并输入到TableHistogram对象中
        strPopField = "Pop1990"
        pTableHistogram.Field = strPopField
        pTableHistogram.Table = pTable
        pHistogram.GetHistogram(dataValues, dataFrequency)
        ' Put the values and frequencies into an Equal Interval classify object
        '把数据值和频率输入到equalinterval分类对象中
        '第二部分，创建分级的渲染器,即class breaks renderer        '
        Dim pClassify As IClassifyGEN
        Dim Classes() As Double
        Dim ClassesCount As Long
        Dim numDesiredClasses As Integer
        numDesiredClasses = 5
        pClassify = New EqualInterval
        pClassify.Classify(dataValues, dataFrequency, numDesiredClasses)
        Classes = pClassify.ClassBreaks
        ClassesCount = UBound(Classes)
        Dim pClassBreaksRenderer As IClassBreaksRenderer
        pClassBreaksRenderer = New ClassBreaksRenderer
        pClassBreaksRenderer.Field = strPopField
        pClassBreaksRenderer.BreakCount = ClassesCount
        pClassBreaksRenderer.SortClassesAscending = True        '

        ' 第三步，创建颜色序列
        '设置开头颜色为黄色
        Dim pFromColor As IHsvColor
        pFromColor = New HsvColor
        pFromColor.Hue = 60         ' Yellow
        pFromColor.Saturation = 100
        pFromColor.Value = 96

        '设定最终颜色为红色
        Dim pToColor As IHsvColor

        pToColor = New HsvColor
        pToColor.Hue = 0         ' Red
        pToColor.Saturation = 100
        pToColor.Value = 96

        '产生从黄到红的颜色序列
        Dim pRamp As IAlgorithmicColorRamp
        Dim pEnumColors As IEnumColors

        pRamp = New AlgorithmicColorRamp
        pRamp.Algorithm = esriColorRampAlgorithm.esriHSVAlgorithm
        pRamp.FromColor = pFromColor
        pRamp.ToColor = pToColor
        pRamp.Size = ClassesCount
        pRamp.CreateRamp(True)
        pEnumColors = pRamp.Colors

        '第四步，把颜色系列，间隔值赋给各类
        Dim pColor As IColor
        Dim pFillSymbol As ISimpleFillSymbol
        Dim breakIndex As Long

        For breakIndex = 0 To ClassesCount - 1

            ' 利用fill样式设置颜色，并把其赋给相应的各类
            pColor = pEnumColors.Next
            pFillSymbol = New SimpleFillSymbol
            pFillSymbol.Color = pColor

            pClassBreaksRenderer.Symbol(breakIndex) = pFillSymbol
            pClassBreaksRenderer.Break(breakIndex) = Classes(breakIndex + 1)

            ' 储存各间隔值用于输出
            strOutput = strOutput & "- " & Classes(breakIndex + 1) & vbNewLine

        Next breakIndex

        ' 第五步，将渲染器赋给图层，并刷新图层

        m_pGeoFeatureLayer.Renderer = pClassBreaksRenderer
        Me.AxMapControl1.ActiveView.Refresh()

        MsgBox("分级专题图渲染" & vbNewLine & vbNewLine & _
        "利用字段" & strPopField & "." & vbNewLine & _
        "颜色从黄到红" & vbNewLine & _
        "分类方法采用" & pClassify.MethodName & "，分成" & ClassesCount & "类." & _
        "分类的间隔值为:" & vbNewLine & strOutput)

    End Sub
    'simplerenderer着色法
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        '新建一个填充符号
        Dim pcolor As IRgbColor
        pcolor = New RgbColor
        pcolor.RGB = RGB(250, 0, 0)
        Dim psimplefillsyl As ISimpleFillSymbol
        psimplefillsyl = New SimpleFillSymbol
        psimplefillsyl.Color = pcolor
        psimplefillsyl.Style = esriSimpleFillStyle.esriSFSSolid
        '新建一个填充对象
        Dim pSimpleRenderer As ISimpleRenderer
        pSimpleRenderer = New SimpleRenderer
        pSimpleRenderer.Symbol = psimplefillsyl
        pSimpleRenderer.Description = "usa"
        pSimpleRenderer.Label = "pSimpleRenderer"
        Dim ptrans As ITransparencyRenderer
        ptrans = pSimpleRenderer
        '设置透明属性的字段
        ptrans.TransparencyField = "Pop1999"
        Dim pgeofeatlayer As IGeoFeatureLayer
        pgeofeatlayer = AxMapControl1.Map.Layer(0)
        pgeofeatlayer.Renderer = ptrans
        AxMapControl1.ActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, Nothing)
    End Sub

    'pro

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim pUniqueValueRender As IUniqueValueRenderer
        Dim pGeoFeatureLayer As IGeoFeatureLayer
        Dim pSym As IFillSymbol
        Dim pNextUniqueColor As IColor
        Dim pEnumRamp As IEnumColors
        Dim pTable As ITable
        Dim fieldNumber As Long
        Dim pNextRow As IRow
        Dim pNextRowBuffer As IRowBuffer
        Dim pCursor As ICursor
        Dim pQueryFilter As IQueryFilter
        Dim codeValue As Object

        '新建一个单值着色对象
        pUniqueValueRender = New UniqueValueRenderer

        'pGeoFeatureLayer是要着色的图层
        pGeoFeatureLayer = AxMapControl1.Map.Layer(0)
        pTable = pGeoFeatureLayer

        '找出STATE_NAME在字段中的编号
        fieldNumber = pTable.FindField("STATE_NAME")

        '只用一个字段进行单值着色
        pUniqueValueRender.FieldCount = 1

        '用于区分着色的字段
        pUniqueValueRender.Field(0) = "STATE_NAME"

        '产生一个随机的着色条,使用的是HSV颜色模式
        Dim pColorRamp As IRandomColorRamp
        pColorRamp = New RandomColorRamp
        pColorRamp.StartHue = 0
        pColorRamp.MinValue = 99
        pColorRamp.MinSaturation = 15
        pColorRamp.EndHue = 360
        pColorRamp.MaxValue = 100
        pColorRamp.MaxSaturation = 30

        '任意产生个颜色,如果知道要素的数目则可以产生精确的颜色数目
        pColorRamp.Size = 100
        pColorRamp.CreateRamp(True)
        pEnumRamp = pColorRamp.Colors
        pNextUniqueColor = Nothing

        '产生查询过滤器对象
        pQueryFilter = New QueryFilter
        pQueryFilter.AddField("STATE_NAME")

        '依据某个字段在表中找出指向所有行的游标对象
        pCursor = pTable.Search(pQueryFilter, True)
        pNextRow = pCursor.NextRow

        '遍历所有的要素
        Do While Not pNextRow Is Nothing
            pNextRowBuffer = pNextRow
            '找出每ROW的"STATE_NAME"的值,即不同的州名
            codeValue = pNextRowBuffer.Value(fieldNumber)
            '获取随机颜色带中的任意一种颜色
            pNextUniqueColor = pEnumRamp.Next
            If pNextUniqueColor Is Nothing Then
                pEnumRamp.Reset()
                pNextUniqueColor = pEnumRamp.Next
            End If

            pSym = New SimpleFillSymbol
            pSym.Color = pNextUniqueColor

            '将每次得到的要素字段值和修饰它的符号放入着色对象中
            pUniqueValueRender.AddValue(codeValue, "", pSym)
            pNextRow = pCursor.NextRow
        Loop
        pGeoFeatureLayer.Renderer = pUniqueValueRender
        AxMapControl1.ActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, Nothing)
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub

    Private Sub Button3_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        '放大按钮
        Dim pEnvelop As IEnvelope
        pEnvelop = AxMapControl1.Extent
        pEnvelop.Expand(0.5, 0.5, True)
        AxMapControl1.Extent = pEnvelop
    End Sub

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
        '复位按钮
        AxMapControl1.Extent = AxMapControl1.FullExtent
    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        '缩小按钮
        Dim pEnvelop As IEnvelope
        pEnvelop = AxMapControl1.Extent
        pEnvelop.Expand(2, 2, True)
        AxMapControl1.Extent = pEnvelop
    End Sub
End Class