AE ChartRenderer

来源:互联网 发布:足球阵容软件 编辑:程序博客网 时间:2024/05/17 04:23

Option Explicit
Public Function SetDotDensityRenderer(pFeatureLayer As IFeatureLayer, pSymbolArray As ISymbolArray, _
                                      intFieldCount As Integer, _
                                      pActiveView As IActiveView, _
                                      strFieldArray() As String, _
                                      dotSize As Double, _
                                      strLabel As String, _
                                      pBackGroundColor As IColor, _
                                      Optional strQueryFilter As String = "")
    Dim pGeoFeatureLayer As IGeoFeatureLayer
    Dim pQueryfilter As IQueryFilter
    Dim pcursor As ICursor
    Dim pDotDensitySymbol As IDotDensityFillSymbol
    Dim pDotDensityRender As IDotDensityRenderer
    Dim pRow As IRowBuffer
    Dim pTable As ITable
    Dim fieldindecies() As String
    Dim i As Integer
    Dim dmaxValue As Double
    Dim firstValue As Boolean
    Dim dFieldValue As Double
    Dim pRenderField As IRendererFields
    Dim pField As IField
   
    Set pGeoFeatureLayer = pFeatureLayer
    Set pDotDensityRender = New DotDensityRenderer
    Set pRenderField = pDotDensityRender
    For i = 0 To intFieldCount - 1
        pRenderField.AddField strFieldArray(i)
        Set pField = pFeatureLayer.FeatureClass.Fields.Field _
        (pFeatureLayer.FeatureClass.Fields.FindField(strFieldArray(i)))
        pRenderField.FieldAlias(i) = pField.AliasName
    Next
    Set pTable = pGeoFeatureLayer
    Set pQueryfilter = New QueryFilter
    pQueryfilter.WhereClause = strQueryFilter
    Set pcursor = pFeatureLayer.FeatureClass.Search(pQueryfilter, False)
    Set pRow = pcursor.NextRow
   
    ReDim fieldindecies(intFieldCount) As String
    For i = 0 To intFieldCount - 1
        fieldindecies(i) = pRow.Fields.FindField(strFieldArray(i))
    Next
   
    dmaxValue = 0
    firstValue = True
    dFieldValue = 0
    While Not pRow Is Nothing
        For i = 0 To intFieldCount - 1
            dFieldValue = pRow.Value(fieldindecies(i))
            If firstValue Then
'                设置第一个值
                dmaxValue = dFieldValue
                firstValue = False
             Else
                If dFieldValue > dmaxValue Then
'                得到最大值
                dmaxValue = dFieldValue
                End If
            End If
        Next
        Set pRow = pcursor.NextRow
    Wend
    If (dmaxValue <= 0) Then
        MsgBox "Failed to calculate the maximum value or max value is 0."
        Exit Function
    End If
   
    Set pDotDensitySymbol = New DotDensityFillSymbol
    Set pDotDensitySymbol = pSymbolArray
    pDotDensitySymbol.BackgroundColor = pBackGroundColor
    pDotDensitySymbol.dotSize = dotSize
    pDotDensitySymbol.DotSpacing = 100
   
    Set pDotDensityRender.DotDensitySymbol = pDotDensitySymbol
    Set pDotDensityRender.ControlLayer = pFeatureLayer
    Set pDotDensityRender.DotValue = dmaxValue / 10
    pDotDensityRender.MaintainSize = True
    Set pGeoFeatureLayer.Renderer = pDotDensityRender
   
    pActiveView.Refresh
End Function
Public Function SetPieChartRenderer(pFeatureLayer As IFeatureLayer, pSymbolArray As ISymbolArray, _
                                    intFieldCount As Integer, pActiveView As IActiveView, _
                                    strFieldArray() As String, dSize As Double, _
                                    strLabel As String, pBaseSymbol As ISymbol, Optional strQueryFilter As String = "")
    Dim pGeoFeatureLayer As IGeoFeatureLayer
    Dim pQueryfilter As IQueryFilter
    Dim pcursor As ICursor
    Dim pChartRender As IChartRenderer
    Dim pRow As IRowBuffer
    Dim pTable As ITable
    Dim fieldindecies() As String
    Dim i As Integer
    Dim pChartSymbol As IChartSymbol
    Dim pPieCharSymbol As IPieChartSymbol
    Dim dmaxValue As Double
    Dim firstValue As Boolean
    Dim dFieldValue As Double
    Dim pRenderField As IRendererFields
    Dim pMarkerSymbol As IMarkerSymbol
    Dim pField As IField
   
    Set pGeoFeatureLayer = pFeatureLayer
    Set pChartRender = New ChartRenderer
    Set pRenderField = pChartRender
   
    For i = 0 To intFieldCount - 1
        pRenderField.AddField strFieldArray(i)
        Set pField = pFeatureLayer.FeatureClass.Fields.Field _
        (pFeatureLayer.FeatureClass.Fields.FindField(strFieldArray(i)))
        pRenderField.FieldAlias(i) = pField.AliasName
    Next
    Set pTable = pGeoFeatureLayer
    Set pQueryfilter = New QueryFilter
    pQueryfilter.WhereClause = strQueryFilter
    Set pcursor = pFeatureLayer.FeatureClass.Search(pQueryfilter, False)
    Set pRow = pcursor.NextRow
   
    ReDim fieldindecies(intFieldCount) As String
    For i = 0 To intFieldCount - 1
        fieldindecies(i) = pRow.Fields.FindField(strFieldArray(i))
    Next
   
    dmaxValue = 0
    firstValue = True
    dFieldValue = 0
    While Not pRow Is Nothing
        For i = 0 To intFieldCount - 1
            dFieldValue = pRow.Value(fieldindecies(i))
            If firstValue Then
'                设置第一个值
                dmaxValue = dFieldValue
                firstValue = False
             Else
                If dFieldValue > dmaxValue Then
'                得到最大值
                dmaxValue = dFieldValue
                End If
            End If
        Next
        Set pRow = pcursor.NextRow
    Wend
    If (dmaxValue <= 0) Then
        MsgBox "Failed to calculate the maximum value or max value is 0."
        Exit Function
    End If
   
'    Set pPieCharSymbol = New PieChartSymbol
    Set pPieCharSymbol = pSymbolArray
    pPieCharSymbol.Clockwise = True
    Set pChartSymbol = pPieCharSymbol
    pChartSymbol.MaxValue = dmaxValue
    Set pMarkerSymbol = pPieCharSymbol
    pMarkerSymbol.size = dSize
   
    Set pChartRender.ChartSymbol = pPieCharSymbol
    Set pChartRender.BaseSymbol = pBaseSymbol
    pChartRender.Label = strLabel
    pChartRender.UseOverposter = False
    pChartRender.CreateLegend
    pChartRender.Label = strLabel
    Set pGeoFeatureLayer.Renderer = pChartRender
   
    pActiveView.Refresh
   
End Function

Public Function SetBarChartRenderer(pFeatureLayer As IFeatureLayer, pSymbolArray As ISymbolArray, _
                                    intFieldCount As Integer, pActiveView As IActiveView, _
                                    strFieldArray() As String, dWidth As Double, dHight As Double, _
                                    strLabel As String, pBaseSymbol As ISymbol, Optional strQueryFilter As String = "")
                                   
    Dim pGeoFeatureLayer As IGeoFeatureLayer
    Dim pQueryfilter As IQueryFilter
    Dim pcursor As ICursor
    Dim pChartRender As IChartRenderer
    Dim pRenderField As IRendererFields
    Dim pRow As IRowBuffer
    Dim pTable As ITable
    Dim fieldindecies() As String
    Dim i As Integer
    Dim pChartSymbol As IChartSymbol
    Dim pBarChartSymbol As IBarChartSymbol
    Dim dmaxValue As Double
    Dim firstValue As Boolean
    Dim dFieldValue As Double
    Dim pMarkerSymbol As IMarkerSymbol
    Dim pField As IField
   
   
    Set pGeoFeatureLayer = pFeatureLayer
    Set pChartRender = New ChartRenderer
    Set pRenderField = pChartRender
   
    For i = 0 To intFieldCount - 1
        pRenderField.AddField strFieldArray(i)
        Set pField = pFeatureLayer.FeatureClass.Fields.Field _
        (pFeatureLayer.FeatureClass.Fields.FindField(strFieldArray(i)))
        pRenderField.FieldAlias(i) = pField.AliasName
    Next
    Set pTable = pGeoFeatureLayer
    Set pQueryfilter = New QueryFilter
    pQueryfilter.WhereClause = strQueryFilter
    Set pcursor = pFeatureLayer.FeatureClass.Search(pQueryfilter, False)
    Set pRow = pcursor.NextRow
   
    ReDim fieldindecies(intFieldCount) As String
    For i = 0 To intFieldCount - 1
        fieldindecies(i) = pRow.Fields.FindField(strFieldArray(i))
    Next
    dmaxValue = 0
    firstValue = True
    dFieldValue = 0
    While Not pRow Is Nothing
        For i = 0 To intFieldCount - 1
            dFieldValue = pRow.Value(fieldindecies(i))
            If firstValue Then
'                设置第一个值
                dmaxValue = dFieldValue
                firstValue = False
             Else
                If dFieldValue > dmaxValue Then
'                得到最大值
                dmaxValue = dFieldValue
                End If
            End If
        Next
        Set pRow = pcursor.NextRow
    Wend
    If (dmaxValue <= 0) Then
        MsgBox "Failed to calculate the maximum value or max value is 0."
        Exit Function
    End If
    Set pBarChartSymbol = New BarChartSymbol
    Set pBarChartSymbol = pSymbolArray
    Set pChartSymbol = pBarChartSymbol
    Set pMarkerSymbol = pBarChartSymbol
'    设置最大值
    pChartSymbol.MaxValue = dmaxValue
    pBarChartSymbol.Width = dWidth
'    设置显示的宽度
    pMarkerSymbol.size = dHight
   
    Set pChartRender.ChartSymbol = pBarChartSymbol
    Set pChartRender.BaseSymbol = pBaseSymbol
    pChartRender.UseOverposter = True
    pChartRender.Label = strLabel
    pChartRender.CreateLegend
    pChartRender.Label = strLabel
    Set pGeoFeatureLayer.Renderer = pChartRender
   
    pActiveView.Refresh
End Function