Change Renderer

Created:7/11/2000
Description:

This sample deomonstrates how different renderers can be assigned to a particular feature layer. The sample automatically creates a new toolbar with four command buttons on it. Each command changes the renderer for the feature layer. This sample works with the US States shape file.

How to use:
  1. Add the US States shapefile to an ArcMap Document.
  2. Press Alt+F11 to display the Visual Basic Editor.
  3. Copy the following code into the Code Window.
  4. Save the document.
  5. Press Alt+Q to close the Visual Basic Editor and return to ArcMap.
  6. Open another ArcMap document or Exit ArcMap.
  7. Open the document in which you saved the code example.
  8. In the Renderers toolbar, switch among the different renderers.
Private Function MxDocument_OpenDocument() As Boolean
  CreateBar
End Function

Sub CreateBar()
  ' Get the commandbars collection
  Dim pCmdBars As ICommandBars
  Set pCmdBars = ThisDocument.CommandBars
  
  ' Create the new toolbar
  Dim pNewBar As ICommandBar
  Set pNewBar = pCmdBars.Create("Renderers", esriCmdBarTypeToolbar)
  
  'Add three items to the toolbar - each represents a renderer
  pNewBar.CreateMacroItem "CB", 20, "Project.ThisDocument.CB"
  pNewBar.CreateMacroItem "PS", 28, "Project.ThisDocument.PS"
  pNewBar.CreateMacroItem "UV", 3, "Project.ThisDocument.UV"
  pNewBar.CreateMacroItem "SF", 14, "Project.ThisDocument.SF"
  
  'add tooltips
  pNewBar.Find("CB").Tooltip = "ClassBreaks Renderer"
  pNewBar.Find("PS").Tooltip = "ProportionalSymbol Renderer"
  pNewBar.Find("UV").Tooltip = "UniqueValue Renderer"
  pNewBar.Find("SF").Tooltip = "SimpleFill Renderer"
  
End Sub

Sub CB()
  Dim pDoc As IMxDocument
  Set pDoc = ThisDocument
  Dim pMap As IMap
  Set pMap = pDoc.FocusMap
  
  Dim pLayer As ILayer
  Set pLayer = pMap.Layer(0)
  
  Dim pFLayer As IFeatureLayer
  Set pFLayer = pLayer
  Dim pLyr As IGeoFeatureLayer
  Set pLyr = pFLayer
  
  'create a renderer and classify the data
  Dim pCBR As IClassBreaksRenderer
  Set pCBR = New ClassBreaksRenderer
  
  With pCBR
     .BreakCount = 5
     .Break(0) = 1000000
     .Break(1) = 4000000
     .Break(2) = 7000000
     .Break(3) = 10000000
     .Break(4) = 30000000
     .Field = "POP1990"
     .Label(0) = "= 1000000"
     .Label(1) = ">   1000000 and <=   4000000"
     .Label(2) = ">   4000000 and <=   7000000"
     .Label(3) = ">   7000000 and <= 10000000"
     .Label(4) = "> 10000000 and <= 30000000"
  End With
  
  Dim pColorEnum As IEnumColors
  Dim pAColorRamp As IAlgorithmicColorRamp
  Dim pColor1 As IRgbColor
  Dim pColor2 As IRgbColor
  Dim pSFSym As ISimpleFillSymbol
  Dim i As Integer
  
  ' setup an algorithmic color ramp
  Set pColor1 = New RgbColor
  pColor1.RGB = RGB(242, 233, 250)     ' lavender
  Set pColor2 = New RgbColor
  pColor2.RGB = RGB(56, 45, 121)       ' deep purple
  Set pAColorRamp = New AlgorithmicColorRamp
  With pAColorRamp
    .Algorithm = esriHSVAlgorithm
    .Size = 5
    .FromColor = pColor1
    .ToColor = pColor2
    .CreateRamp (True)
    Set pColorEnum = .Colors
  End With
  pColorEnum.Reset
  
  ' set fill symbol for each class
  For i = 0 To 4
     Set pSFSym = New SimpleFillSymbol
     pSFSym.Color = pColorEnum.Next
     pCBR.Symbol(i) = pSFSym
  Next i
  
  'assign the ClassBreaksRenderer to the layer
  Set pLyr.Renderer = pCBR
  
 'Establish a heading for the legend in the TOC
  Dim pLegendInfo As ILegendInfo
  Set pLegendInfo = pCBR 'qi
  pLegendInfo.LegendGroup(0).Heading = "1990 Population"
 
  ' redraw the TOC and the map
  pDoc.UpdateContents
  pDoc.ActiveView.Refresh
     
End Sub

Sub PS()

  Dim pDoc As IMxDocument
  Set pDoc = ThisDocument
  Dim pMap As IMap
  Set pMap = pDoc.FocusMap
  
  Dim pLayer As ILayer
  Set pLayer = pMap.Layer(0)
  
  Dim pFLayer As IFeatureLayer
  Set pFLayer = pLayer
  Dim pLyr As IGeoFeatureLayer
  Set pLyr = pFLayer
  
  'Create two colors
  'pColor1 is for the proportional symbol
  'pColor2 is for the background fill
  
  Dim pColor1 As IRgbColor
  Set pColor1 = New RgbColor
  pColor1.RGB = RGB(128, 128, 192)
  
  Dim pColor2 As IRgbColor
  Set pColor2 = New RgbColor
  pColor2.RGB = RGB(255, 255, 128)
  
  'create a marker symbol for the proportional symbol
  Dim pSMSym As ISimpleMarkerSymbol
  Set pSMSym = New SimpleMarkerSymbol
  With pSMSym
    .Style = esriSMSCircle
    .Color = pColor1
    .Size = 6
    .Outline = True
    .OutlineSize = 0.4
  End With
  
  'create a simple fill symbol for the background
  Dim pSFSym As ISimpleFillSymbol
  Set pSFSym = New SimpleFillSymbol
  With pSFSym
    .Color = pColor2
    .Style = esriSFSSolid
    .Outline.Width = 0.4
  End With
  
  'create a renderer and classify the data
  Dim pPSR As IProportionalSymbolRenderer
  Set pPSR = New ProportionalSymbolRenderer
  
  With pPSR
    .Field = "POP1990"
    .MinDataValue = 1000000
    .MaxDataValue = 30000000
    .FlanneryCompensation = False
    .LegendSymbolCount = 5
    .ValueRepresentation = esriValueRepRadius
    .MinSymbol = pSMSym
    .BackgroundSymbol = pSFSym
    .CreateLegendSymbols
  End With
  
  'assign the ProportionalSymbolRenderer to the layer
  Set pLyr.Renderer = pPSR
  
 'Establish a heading for the legend in the TOC
  Dim pLegendInfo As ILegendInfo
  Set pLegendInfo = pPSR 'QI
  pLegendInfo.LegendGroup(0).Heading = "1990 Population"
  
  ' redraw the TOC and the map
  pDoc.UpdateContents
  pDoc.ActiveView.Refresh
End Sub

Sub UV()
  Dim pDoc As IMxDocument
  Set pDoc = ThisDocument
  Dim pMap As IMap
  Set pMap = pDoc.FocusMap
  
  Dim pLayer As ILayer
  Set pLayer = pMap.Layer(0)
  
  Dim pFLayer As IFeatureLayer
  Set pFLayer = pLayer
  Dim pLyr As IGeoFeatureLayer
  Set pLyr = pFLayer
  
  Dim pFeatCls As IFeatureClass
  Set pFeatCls = pFLayer.FeatureClass
  Dim pQueryFilter As IQueryFilter
  Set pQueryFilter = New QueryFilter 'empty supports: SELECT *
  Dim pFeatCursor As IFeatureCursor
  Set pFeatCursor = pFeatCls.Search(pQueryFilter, False)
  
  '** Make the color ramp we will use for the symbols in the renderer
  Dim rx As IRandomColorRamp
  Set rx = New RandomColorRamp
  rx.MinSaturation = 20
  rx.MaxSaturation = 40
  rx.MinValue = 85
  rx.MaxValue = 100
  rx.StartHue = 76
  rx.EndHue = 188
  rx.UseSeed = True
  rx.Seed = 43
  
  '** Make the renderer and the classify objects
  Dim pRender As IUniqueValueRenderer, n As Long
  Set pRender = New UniqueValueRenderer
  
  Dim symd As ISimpleFillSymbol
  Set symd = New SimpleFillSymbol
  symd.Style = esriSFSSolid
  symd.Outline.Width = 0.4
  
  '** These properties should be set prior to adding values
  pRender.FieldCount = 1
  pRender.Field(0) = "SUB_REGION"
  pRender.DefaultSymbol = symd
  pRender.UseDefaultSymbol = True
  
  Dim pFeat As IFeature
  n = pFeatCls.FeatureCount(pQueryFilter)
  '** Loop through the features
  Do Until i = n
      Dim symx As ISimpleFillSymbol
      Set symx = New SimpleFillSymbol
      symx.Style = esriSFSSolid
      symx.Outline.Width = 0.4
      Set pFeat = pFeatCursor.NextFeature
      Dim x As String
      Dim idx As Long
      idx = pFeat.Fields.FindField("SUB_REGION")
      x = pFeat.Value(idx) '** SUB_REGION Field is at index idx in fields collection
      '** Test to see if we've already added this value
      '** to the renderer, if not, then add it.
      ValFound = False
      For uh = 0 To (pRender.ValueCount - 1)
        If pRender.Value(uh) = x Then
          NoValFound = True
          Exit For
        End If
      Next uh
      If Not ValFound Then
          pRender.AddValue x, "Region Name", symx
          pRender.Label(x) = x
          pRender.Symbol(x) = symx
      End If
      i = i + 1
  Loop
  
  '** now that we know how many unique values there are
  '** we can size the color ramp and assign the colors.
  rx.Size = pRender.ValueCount
  rx.CreateRamp (True)
  Dim RColors As IEnumColors, ny As Long
  Set RColors = rx.Colors
  RColors.Reset
  For ny = 0 To (pRender.ValueCount - 1)
      Dim xv As String
      xv = pRender.Value(ny)
      If xv <> "" Then
          Dim jsy As ISimpleFillSymbol
          Set jsy = pRender.Symbol(xv)
          jsy.Color = RColors.Next
          pRender.Symbol(xv) = jsy
      End If
  Next ny
  
  Set pLyr.Renderer = pRender
  
  '** Refresh the TOC
  pDoc.UpdateContents
  
  '** Draw the map
  pDoc.ActiveView.Refresh
     
End Sub
  
Sub SF()
  Dim pDoc As IMxDocument
  Set pDoc = ThisDocument
  Dim pMap As IMap
  Set pMap = pDoc.FocusMap
  
  Dim pLayer As ILayer
  Set pLayer = pMap.Layer(0)
  
  Dim pFLayer As IFeatureLayer
  Set pFLayer = pLayer
  Dim pLyr As IGeoFeatureLayer
  Set pLyr = pFLayer
  
  'Create a color
  Dim pColor As IRgbColor
  Set pColor = New RgbColor
  pColor.RGB = RGB(255, 255, 128)

  'Create a symbol
  Dim pSFSymbol As ISimpleFillSymbol
  Set pSFSymbol = New SimpleFillSymbol
  
  With pSFSymbol
    .Color = pColor
    .Outline.Width = 0.4
    .Style = esriSFSSolid
  End With
  
  'Create a renderer
  Dim pSimpleRenderer As ISimpleRenderer
  Set pSimpleRenderer = New SimpleRenderer
  
  With pSimpleRenderer
    .Label = "State Border"
    Set .Symbol = pSFSymbol
  End With
  
  'Set the layer's renderer
  Set pLyr.Renderer = pSimpleRenderer
  
  ' redraw the TOC and the map
  pDoc.UpdateContents
  pDoc.ActiveView.Refresh
  
End Sub