IChartRenderer の利用

'http://resources.esri.com/help/9.3/arcgisengine/arcobjects/esricarto/ichartrenderer_example.htm
 
Option Explicit
 
  
 
Private Sub PieChartRenderer()
 
    '** Paste into VBA
    '** Creates a PieChartRenderer and applies it to first layer in the map.
    '** First Layer in the map is the "States" feature class from ESRI's sample data
    '** Layer must have "POP1990" field
 
  Const strPopField1 = "POP1990"
  Dim pMxdoc As IMxDocument
  Dim pMap As IMap
  Dim pLayer As ILayer
  Dim pFeatLayer As IFeatureLayer
  Dim pFClass As IFeatureClass
  Dim pGeoFeatureLayer As IGeoFeatureLayer
 
  Set pMxdoc = ThisDocument
  Set pMap = pMxdoc.FocusMap
  Set pLayer = pMap.Layer(0)
  Set pFeatLayer = pLayer
  Set pGeoFeatureLayer = pFeatLayer
  Set pFClass = pFeatLayer.FeatureClass
   
  Dim pChartRenderer As IChartRenderer
  Dim pRendererFields As IRendererFields
  Dim pPieChartRenderer As IPieChartRenderer
   
  Set pChartRenderer = New ChartRenderer
   
  ' Set up the field to draw charts
  Set pRendererFields = pChartRenderer
  pRendererFields.AddField strPopField1
  Set pPieChartRenderer = pChartRenderer
     
  ' Calculate the max value of the data field to scale the chart
  Dim pTable As ITable
  Dim pCursor As ICursor
  Dim pQueryFilter As IQueryFilter
  Dim pRow As IRowBuffer
   
  Set pTable = pGeoFeatureLayer
  Set pQueryFilter = New QueryFilter
  pQueryFilter.AddField strPopField1
  Set pCursor = pTable.Search(pQueryFilter, True)
   
  Dim fieldIndex As Long
  Dim maxValue As Double
  Dim firstValue As Boolean
  Dim fieldValue As Double
   
  fieldIndex = pTable.FindField(strPopField1)
  firstValue = True
  maxValue = 0
   
  ' Iterate across each feature
  Set pRow = pCursor.NextRow
  Do While Not pRow Is Nothing
      fieldValue = pRow.Value(fieldIndex)
      If firstValue Then
        ' Special case for the first value in a feature class
        maxValue = fieldValue
        firstValue = False
      Else
        If fieldValue > maxValue Then
          ' we've got a new biggest value
          maxValue = fieldValue
        End If
      End If
    Set pRow = pCursor.NextRow
  Loop
   
  If (maxValue <= 0) Then
    MsgBox "Failed to calculate the maximum value or max value is 0."
    Exit Sub
  End If
   
  ' Set up the chart marker symbol to use with the renderer
  Dim pPieChartSymbol As IPieChartSymbol
  Dim pFillSymbol As IFillSymbol
  Dim pMarkerSymbol As IMarkerSymbol
  Dim pSymbolArray As ISymbolArray
  Dim pChartSymbol As IChartSymbol
    
  Set pPieChartSymbol = New PieChartSymbol
  Set pChartSymbol = pPieChartSymbol
  pPieChartSymbol.Clockwise = True
  pPieChartSymbol.UseOutline = True
  Dim pOutline  As ILineSymbol
  Set pOutline = New SimpleLineSymbol
  pOutline.Color = GetRGBColor(255, 0, 255)
  pOutline.Width = 1
  pPieChartSymbol.Outline = pOutline
 
  Set pMarkerSymbol = pPieChartSymbol
   
  ' Finally we've got the biggest value, set this into the symbol
  pChartSymbol.maxValue = maxValue
   
  ' This is the maximum height of the bars
  pMarkerSymbol.size = 16
   
  Set pSymbolArray = pPieChartSymbol
  Set pFillSymbol = New SimpleFillSymbol
  ' This is a pastel purple
  pFillSymbol.Color = GetRGBColor(213, 212, 252)
  pFillSymbol.Outline = pOutline
  pSymbolArray.AddSymbol pFillSymbol
 
  ' set up the background symbol to use tan color
  Set pFillSymbol = New SimpleFillSymbol
  pFillSymbol.Color = GetRGBColor(239, 228, 190)
  Set pChartRenderer.BaseSymbol = pFillSymbol
   
  ' Disable overpoaster so that charts appear in the centre of polygons
  pChartRenderer.UseOverposter = False
    
  ' Update the renderer and refresh the screen
   
  pPieChartRenderer.MinSize = 6
  pPieChartRenderer.MinValue = 453588
  pPieChartRenderer.FlanneryCompensation = False
  pPieChartRenderer.ProportionalBySum = True
   
  ' Now set the piechart symbol into the renderer
  Set pChartRenderer.ChartSymbol = pPieChartSymbol
  pChartRenderer.Label = "Population"
  pChartRenderer.CreateLegend
  Set pGeoFeatureLayer.Renderer = pChartRenderer
   
  pMxdoc.ActiveView.Refresh
  pMxdoc.UpdateContents
End Sub
 
 
 
' This function returns an RGB colour object initialised with the supplied Red Green and Blue values.
' All parameters range from 0 to 255 in value
 
Private Function GetRGBColor(yourRed As Long, yourGreen As Long, _
                             yourBlue As Long) As IRgbColor
  Dim pRGB As IRgbColor
   
  Set pRGB = New RgbColor
  With pRGB
    .Red = yourRed
    .Green = yourGreen
    .Blue = yourBlue
    .UseWindowsDithering = True
  End With
  Set GetRGBColor = pRGB
 
End Function