Below is the code I am using. It reads a sorted table in an access database to get the values to be rendered and the RGB values for their colors. I am having trouble setting the label values for each value rendered. The label values are stored in a field in the table.
Any help would be appreciated.
Thanks,
David Kelly
Private Sub standardCats(SomeLayer As IGeoFeatureLayer)
On Error GoTo Errorhandler
Dim pUVRenderer As IUniqueValueRenderer
Set pUVRenderer = New UniqueValueRenderer
pUVRenderer.FieldCount = 1
pUVRenderer.Field(0) = "PM"
Dim pFLayer As IFeatureLayer, pFClass As IFeatureClass
Set pFLayer = SomeLayer
Set pFClass = pFLayer.FeatureClass
Dim pFCursor As IFeatureCursor
Set pFCursor = pFClass.Search(Nothing, False)
Dim pfeature As IFeature, pSym As ISimpleFillSymbol
Set pfeature = pFCursor.NextFeature
Dim pColor As IRgbColor
Set pColor = New RgbColor
Dim pVsTable As ITable
Dim pVsCursor As ICursor
Dim pRow As IRow
Dim PM As Long
Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim Trans As Integer
Dim pFeatws As IFeatureWorkspace
Dim pTables As IStandaloneTableCollection
Dim pTable As ITable
Dim pFact As IWorkspaceFactory
Dim pWorkSpace As IWorkspace
Set pFact = New AccessWorkspaceFactory
Set pWorkSpace = pFact.OpenFromFile("C:\SmokeTools\VSmoke\Vsmoke.mdb", 0)
Set pFeatws = pWorkSpace
Set pTable = pFeatws.OpenTable("Cat_AQI_PM_Hourly")
Dim pStTab As IStandaloneTable
Set pStTab = New StandaloneTable
Set pStTab.Table = pTable
Dim pCursor As ICursor
Dim OldValue As Double
Dim pTabCursor As ICursor
Dim LabelCount As Integer
Dim x As String
LabelCount = 1
Set pTabCursor = pStTab.Table.Search(Nothing, False)
Set pRow = pTabCursor.NextRow
Do Until pfeature Is Nothing
PM = pfeature.Value(pFClass.FindField("PM"))
OldValue = 0
While Not pRow Is Nothing
If PM > OldValue And PM <= pRow.Value(1) Then
Set pSym = New SimpleFillSymbol
pColor.RGB = RGB(pRow.Value(3), pRow.Value(4), pRow.Value(5))
pSym.Color = pColor
pUVRenderer.AddValue _
pfeature.Value(pFClass.FindField("PM")), "PM", pSym
'pUVRenderer.label(0) = pRow.Value(2)
Trans = pRow.Value(6)
End If
OldValue = pRow.Value(1)
LabelCount = LabelCount + 1
Set pRow = pTabCursor.NextRow
Wend
Set pTabCursor = Nothing
Set pTabCursor = pStTab.Table.Search(Nothing, False)
Set pRow = pTabCursor.NextRow
Set pfeature = pFCursor.NextFeature
Loop
If TypeOf SomeLayer Is ILayerEffects Then
Dim pLayerEffects As ILayerEffects
Set pLayerEffects = SomeLayer
pLayerEffects.Transparency = Trans
End If
Set SomeLayer.Renderer = pUVRenderer
'** Refresh the TOC
pDoc.ActiveView.ContentsChanged
pDoc.UpdateContents
'** Draw the map
pDoc.ActiveView.Refresh
Exit Sub
Errorhandler:
MsgBox "Error in UniqueValueRenderer"
End Sub
