'Title: CustomColorRender v0.1
'Purpose: Create a custom value map renderer for a layer in ArcMap, based
'   on RGB values in a text file.
'Author: Chris Jennings, ISWS
'Date: 1/23/06

'How to use:
' 1. Open the VBA Editor in ArcMap and paste this method into the code editor.
' 2. This script works by loading the text file, parsing it for RBG values and generating
'   a custom renderer based on those values. It matches values in your text file
'    with values in your feature class/shapefile.
' 3. Customize the filename and pathnames at the top of the script.
' 4. Make sure your layer is listed first in the table of contents.
' 5. Run script within the VBA Editor.

'******* Format of text file must be as follows *******
    ' colorValueField,RED,GREEN,BLUE
    ' 0,153,235,255
    ' 1,204,135,58
    ' 2,255,255,255
    '
    ' Note: The colorValueField is used as a unique index to match up with
    '   values in your feature layer.
    '   RED,GREEN,BLUE values are standard RBG values.


Option Explicit

Sub CustomColorRenderer()
    '****************************************************
    '****** First, set some variables we'll need ********
    '****************************************************
    
    Dim objConnection, objRecordset, strPathtoTextFile
    Dim outlineColorRed, outlineColorGreen, outlineColorBlue As Integer
    Dim colorValueField, fileName As String
    Dim outlineWidth As Double
    
    strPathtoTextFile = "D:\tempGIS\project\" 	'** Path to the comma-delimited text file
    fileName = "map_styles.csv"            	'** Name of the csv file or text file
    colorValueField = "GEOSHADE"              	'** Field in the text file we'll use for the unique index
    
    'Set the polygon outline properties.	
    outlineWidth = 0.5                        	'** Width of polygon outline in pixels
    outlineColorRed = 100                     	'** Red color of polygon outline (1-255)
    outlineColorGreen = 100                   	'** Green color of polygon outline (1-255)
    outlineColorBlue = 100                    	'** Blue color of polygon outline (1-255)
    
  
    '***** Done setting user-specified variables. *******
    '****************************************************
    
    'Open the text file with the colors
    On Error Resume Next
    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H1
    
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordset = CreateObject("ADODB.Recordset")
    
    
    
    objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & strPathtoTextFile & ";" & _
              "Extended Properties=""text;HDR=YES;FMT=Delimited"""
    
    objRecordset.Open "SELECT * FROM " & fileName, _
              objConnection, adOpenStatic, adLockOptimistic, adCmdText
    
   
     
   '** Set up the map document
    Dim pApp As Application
    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 renderer
    Dim pRender As IUniqueValueRenderer, n As Long
    Set pRender = New UniqueValueRenderer

    '** These properties should be set prior to adding values
    pRender.FieldCount = 1
    pRender.Field(0) = colorValueField
 
    
    'Loop through recordset and add symbology to the renderer
    Do Until objRecordset.EOF
        'Create a fill color
        Dim pColor As IRgbColor
        Set pColor = New RgbColor
        pColor.RGB = RGB(objRecordset.Fields.Item("RED"), _
            objRecordset.Fields.Item("GREEN"), _
            objRecordset.Fields.Item("BLUE"))
        
        'Create outline color for polygon symbol
        Dim pOutLineColor As IColor
        Set pOutLineColor = New RgbColor
        pOutLineColor.RGB = RGB(outlineColorRed, outlineColorGreen, outlineColorBlue)
        
        'Create line symbol for outline
        Dim pOutLineSymbol As ISimpleLineSymbol
        Set pOutLineSymbol = New SimpleLineSymbol
        With pOutLineSymbol
            .Color = pOutLineColor
            .Width = outlineWidth
            .Style = esriSLSSolid
        End With
        
        'Finally, create a basic polygon fill symbol using above symbols
        Dim pSFSymbol As ISimpleFillSymbol
        Set pSFSymbol = New SimpleFillSymbol
        With pSFSymbol
            .Color = pColor
            .Outline = pOutLineSymbol
            .Style = esriSFSSolid
        End With
        
        
        pRender.AddValue objRecordset.Fields.Item(colorValueField), colorValueField, pSFSymbol
        pRender.Label(objRecordset.Fields.Item(colorValueField)) = objRecordset.Fields.Item(colorValueField)
        pRender.Symbol(objRecordset.Fields.Item(colorValueField)) = pSFSymbol
        objRecordset.MoveNext
    Loop


     Dim RColors As IEnumColors, numRecs As Long
     For numRecs = 0 To (pRender.ValueCount - 1)
         Dim rendVal As String
         rendVal = pRender.Value(numRecs)
         If rendVal <> "" Then
             Dim sfsymbol As ISimpleFillSymbol
             Set sfsymbol = pRender.Symbol(rendVal)
             pRender.Symbol(rendVal) = sfsymbol
         End If
     Next numRecs
 
     pRender.ColorScheme = "Custom"
     pRender.FieldType(0) = True
     Set pLyr.Renderer = pRender
     pLyr.DisplayField = colorValueField
 
     '** This makes the layer properties symbology tab show
     '** show the correct interface.
     Dim hx As IRendererPropertyPage
     Set hx = New UniqueValuePropertyPage
     pLyr.RendererPropertyPageClassID = hx.ClassID
 
     '** Refresh the TOC
     pDoc.ActiveView.ContentsChanged
     pDoc.UpdateContents
     
     '** Draw the map
     pDoc.ActiveView.Refresh
End Sub