Multivariate renderer
MultivariateRenderer.vb
' Copyright 2012 ESRI
' 
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See the use restrictions.
' 

Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.Geometry

Public Enum EColorCombinationType
    enuComponents
    enuCIELabColorRamp
    enuLabLChColorRamp
    enuRGBAverage
    enuCIELabMatrix
End Enum

<ComClass(MultivariateRenderer.ClassId, MultivariateRenderer.InterfaceId, MultivariateRenderer.EventsId)> _
Public Class MultivariateRenderer

  Inherits ExportSupport

  ' class definition for MultivariateRenderer, a custom multivariate feature renderer
  '   consisting of 

  Implements IFeatureRenderer     ' all feature renderers must support this interface
  Implements IMultivariateRenderer ' custom interface
  Implements ILegendInfo          ' for TOC and legend support
  Implements IPersistVariant      ' to support saving and loading .mxd and .lyr files that contain this renderer
  Implements IRotationRenderer    ' to support symbol rotation by field value
  Implements ITransparencyRenderer ' we don't do anything real with this




#Region "COM GUIDs"
    ' These  GUIDs provide the COM identity for this class 
    ' and its COM interfaces. If you change them, existing 
    ' clients will no longer be able to access the class.
    Public Const ClassId As String = "6A921DB3-5D31-4D85-9857-687CEDBC0D29"
    Public Const InterfaceId As String = "DDC4CD50-DF02-4B2F-9B85-DA87FDED9EA7"
    Public Const EventsId As String = "36E15D76-2463-41DD-A673-0C83021AC30A"
#End Region

    ' data members
    Private m_eColorCombinationMethod As EColorCombinationType = EColorCombinationType.enuComponents
    Private m_pShapePatternRend As IFeatureRenderer
    Private m_pColorRend1 As IFeatureRenderer
    Private m_pColorRend2 As IFeatureRenderer
    Private m_pSizeRend As IFeatureRenderer
    ' for the renderer's TOC and legend entry 
    ' current implementation is simple, but could be extended
    Private m_pLegendGroups() As ILegendGroup
    Private m_sRotationField As String
    Private m_eRotationType As esriSymbolRotationType = esriSymbolRotationType.esriRotateSymbolGeographic
    Private m_sTransparencyField As String
    Private m_pMainRend As IFeatureRenderer ' as renderers are assigned, use this to keep track of which one has the base symbols
    Private m_ShapeType As esriGeometryType
    Private m_pFeatureClass As IFeatureClass
    Private m_pQueryFilter As IQueryFilter
    Private m_OLEColorMatrix(3, 3) As Long

    Private Const E_FAIL As Long = &H80004005

    Public Sub New()
        
    End Sub

    Protected Overrides Sub Finalize()
        m_pShapePatternRend = Nothing
        m_pColorRend1 = Nothing
        m_pColorRend2 = Nothing
        MyBase.Finalize()
    End Sub

    Public Sub CreateLegend() Implements IMultivariateRenderer.CreateLegend
        ' NOT IMPL

        ' this is a place holder sub for logic that can be called that creates a more
        '   involved entry for the layer's TOC and legend entry

    End Sub

    Public Function CanRender(ByVal featClass As IFeatureClass, ByVal Display As IDisplay) As Boolean Implements IFeatureRenderer.CanRender
        ' only use this renderer if we have points, lines, or polygons
        Return (featClass.ShapeType = esriGeometryType.esriGeometryPoint) Or _
               (featClass.ShapeType = esriGeometryType.esriGeometryPolyline) Or _
               (featClass.ShapeType = esriGeometryType.esriGeometryPolygon)
    End Function

    Public Sub Draw(ByVal cursor As IFeatureCursor, ByVal DrawPhase As esriDrawPhase, ByVal Display As IDisplay, ByVal trackCancel As ITrackCancel) Implements IFeatureRenderer.Draw
        ' loop through and draw each feature

        Dim pFeat As IFeature
        Dim pRend As IFeatureRenderer
        Dim pFeatDraw As IFeatureDraw

        Dim bContinue As Boolean

        ' do not draw features if no display
        If (Display Is Nothing) Then
            Exit Sub
        End If

        ' we can't draw without somewhere to get our base symbols from
        If (m_pMainRend Is Nothing) Then
            Exit Sub
        End If

        If Not m_pSizeRend Is Nothing Then
            ' size varies
            If m_ShapeType = esriGeometryType.esriGeometryPoint Or m_ShapeType = esriGeometryType.esriGeometryPolyline Then
                If DrawPhase = esriDrawPhase.esriDPGeography Then
                    ' draw symbols in order from large to small
                    DrawSymbolsInOrder(cursor, DrawPhase, Display, trackCancel)
                End If
            ElseIf m_ShapeType = esriGeometryType.esriGeometryPolygon Then
                If (DrawPhase = esriDrawPhase.esriDPAnnotation) Then
                    ' draw primary symbology from large to small
                    DrawSymbolsInOrder(cursor, DrawPhase, Display, trackCancel)
                ElseIf (DrawPhase = esriDrawPhase.esriDPGeography) Then
                    ' draw background symbology
                    pFeat = cursor.NextFeature
                    bContinue = True

                    ' while there are still more features and drawing has not been cancelled
                    Dim pBackFillSym As IFillSymbol
                    Do While (Not pFeat Is Nothing) And (bContinue = True)
                        ' draw the feature
                        pFeatDraw = pFeat
                        If TypeOf m_pSizeRend Is IClassBreaksRenderer Then
                            Dim pCBRend As IClassBreaksRenderer
                            pCBRend = m_pSizeRend
                            pBackFillSym = pCBRend.BackgroundSymbol
                        Else
                            Dim pPropRend As IProportionalSymbolRenderer
                            pPropRend = m_pSizeRend
                            pBackFillSym = pPropRend.BackgroundSymbol
                        End If
                        Display.SetSymbol(pBackFillSym)

                        'implementation of IExportSupport
                        BeginFeature(pFeat, Display)

                        pFeatDraw.Draw(DrawPhase, Display, pBackFillSym, True, Nothing, esriDrawStyle.esriDSNormal)

                        'implementation of IExportSupport
                        GenerateExportInfo(pFeat, Display)
                        EndFeature(Display)

                        pFeat = cursor.NextFeature
                        If Not trackCancel Is Nothing Then bContinue = trackCancel.[Continue]
                    Loop
                Else
                    ' raising this error makes the selection symbol draw for selected features
                    On Error GoTo 0
                    Err.Raise(E_FAIL)
                End If
            End If

        Else
            ' size does not vary
            If (DrawPhase <> esriDrawPhase.esriDPGeography) Then
                ' raising this error makes the selection symbol draw for selected features
                On Error GoTo 0
                Err.Raise(E_FAIL)
            Else
                DrawSymbols(cursor, DrawPhase, Display, trackCancel)
            End If
        End If

    End Sub

    Public WriteOnly Property ExclusionSet() As IFeatureIDSet Implements IFeatureRenderer.ExclusionSet
        Set(ByVal Value As IFeatureIDSet)
            ' NOT IMPL    
        End Set
    End Property

    Public Sub PrepareFilter(ByVal fc As IFeatureClass, ByVal queryFilter As IQueryFilter) Implements IFeatureRenderer.PrepareFilter
        ' prepare filter for drawing

        ' must add OID
        queryFilter.AddField(fc.OIDFieldName)

        m_ShapeType = fc.ShapeType
        If m_ShapeType = esriGeometryType.esriGeometryPoint Then
            If Not m_sRotationField = "" Then
                queryFilter.AddField(m_sRotationField)
            End If
        End If

        ' save the feature class and the query filter so that multiple cursors can be built in DrawSymbols
        m_pFeatureClass = fc
        m_pQueryFilter = queryFilter

        ' prepare filters on constituent renderers so I can use SymbolByFeature in Draw
        If Not m_pShapePatternRend Is Nothing Then m_pShapePatternRend.PrepareFilter(fc, queryFilter)
        If Not m_pColorRend1 Is Nothing Then m_pColorRend1.PrepareFilter(fc, queryFilter)
        If Not m_pColorRend2 Is Nothing Then m_pColorRend2.PrepareFilter(fc, queryFilter)
        If Not m_pSizeRend Is Nothing Then m_pSizeRend.PrepareFilter(fc, queryFilter)

        ' if we're combining colors from two (sequential) quantitative schemes, build color matrix now
        '   this gives flexibility to extend in future
        ' in current implementation we determine combined color based on two colors, one from each constituent 
        '   ClassBreaksRenderer.  so, we could determine color on demand when drawing. but, by creating 
        '   the color matrix here and storing for later use, we leave open the possibility of swapping in 
        '   different logic for determining combined colors based on all known colors in each constituent
        '   renderer, not just the colors for the given feature
        If (Not m_pColorRend1 Is Nothing) And (Not m_pColorRend2 Is Nothing) Then
            If Not m_eColorCombinationMethod = EColorCombinationType.enuComponents Then
                BuildColorMatrix()
            End If
        End If
        'implementation of IExportSupport
        AddExportFields(fc, queryFilter)

    End Sub

    Public ReadOnly Property RenderPhase(ByVal DrawPhase As esriDrawPhase) As Boolean Implements IFeatureRenderer.RenderPhase
        Get
            Return (DrawPhase = esriDrawPhase.esriDPGeography) Or (DrawPhase = esriDrawPhase.esriDPAnnotation)
        End Get
    End Property

    Public ReadOnly Property SymbolByFeature(ByVal Feature As IFeature) As ISymbol Implements IFeatureRenderer.SymbolByFeature
        Get
            Return GetFeatureSymbol(Feature)
        End Get
    End Property

    Public ReadOnly Property LegendGroup(ByVal Index As Integer) As ILegendGroup Implements ILegendInfo.LegendGroup
        Get
            Dim pLegendInfo As ILegendInfo = Nothing
            Dim strHeading As String

            Select Case Index
                Case 0
                    pLegendInfo = m_pMainRend
                    If m_pMainRend Is m_pShapePatternRend Then
                        strHeading = "Shape/Pattern: "
                    ElseIf m_pMainRend Is m_pSizeRend Then
                        strHeading = "Size: "
                    Else
                        strHeading = "Color 1: "
                    End If
                Case 1
                    If Not m_pShapePatternRend Is Nothing Then
                        If Not m_pSizeRend Is Nothing Then
                            pLegendInfo = m_pSizeRend
                            strHeading = "Size: "
                        Else
                            pLegendInfo = m_pColorRend1
                            strHeading = "Color 1: "
                        End If
                    Else
                        If Not m_pSizeRend Is Nothing Then
                            pLegendInfo = m_pColorRend1
                            strHeading = "Color 1: "
                        Else
                            pLegendInfo = m_pColorRend2
                            strHeading = "Color 2: "
                        End If
                    End If
                Case 2
                    pLegendInfo = m_pColorRend1
                    strHeading = "Color 1: "
                Case 3
                    pLegendInfo = m_pColorRend2
                    strHeading = "Color 2: "

            End Select

            Dim pLegendGroup As ILegendGroup
            pLegendGroup = pLegendInfo.LegendGroup(0)
            'pLegendGroup.Heading = strHeading & pLegendGroup.Heading

            Return pLegendGroup

        End Get
    End Property

    Public ReadOnly Property LegendGroupCount() As Integer Implements ILegendInfo.LegendGroupCount
        Get
            Dim pLegInfo As ILegendInfo
            Dim n As Integer

            n = 0
            If Not m_pSizeRend Is Nothing Then
                pLegInfo = m_pSizeRend
                If Not pLegInfo.LegendGroup(0) Is Nothing Then n = n + 1
            End If
            If Not m_pShapePatternRend Is Nothing Then
                pLegInfo = m_pShapePatternRend
                If Not pLegInfo.LegendGroup(0) Is Nothing Then n = n + 1
            End If
            If Not m_pColorRend1 Is Nothing Then
                pLegInfo = m_pColorRend1
                If Not pLegInfo.LegendGroup(0) Is Nothing Then n = n + 1
            End If
            If Not m_pColorRend2 Is Nothing And Not m_pColorRend2 Is m_pColorRend1 Then
                'If Not m_pColorRend2 Is Nothing Then
                pLegInfo = m_pColorRend2
                If Not pLegInfo.LegendGroup(0) Is Nothing Then n = n + 1
            End If

            Return n
        End Get
    End Property

    Public ReadOnly Property LegendItem() As ILegendItem Implements ILegendInfo.LegendItem
        Get
            Return Nothing
        End Get
    End Property

    Public Property SymbolsAreGraduated() As Boolean Implements ILegendInfo.SymbolsAreGraduated
        Get
            Return False
        End Get
        Set(ByVal Value As Boolean)
            ' NOT IMPL
        End Set
    End Property

    Public ReadOnly Property ID() As UID Implements IPersistVariant.ID
        Get
            Dim pUID As New UID
            pUID.Value = "MultivariateRenderer"
            'pUID.Value = ClassId
            Return pUID
        End Get
    End Property

    Public Sub Load(ByVal Stream As IVariantStream) Implements IPersistVariant.Load
        'load the persisted parameters of the renderer

        m_eColorCombinationMethod = Stream.Read
        m_pShapePatternRend = Stream.Read
        m_pColorRend1 = Stream.Read
        m_pColorRend2 = Stream.Read
        m_pSizeRend = Stream.Read
        'm_pLegendGroups = = Stream.Read
        m_sRotationField = Stream.Read
        m_eRotationType = Stream.Read
        m_sTransparencyField = Stream.Read
        m_pMainRend = Stream.Read

        'CreateLegend() ' not needed now
    End Sub

    Public Sub Save(ByVal Stream As IVariantStream) Implements IPersistVariant.Save
        'persist the settings for the renderer

        Stream.Write(m_eColorCombinationMethod)
        Stream.Write(m_pShapePatternRend)
        Stream.Write(m_pColorRend1)
        Stream.Write(m_pColorRend2)
        Stream.Write(m_pSizeRend)
        'Stream.Write(m_pLegendGroups)
        Stream.Write(m_sRotationField)
        Stream.Write(m_eRotationType)
        Stream.Write(m_sTransparencyField)
        Stream.Write(m_pMainRend)
    End Sub

    Private Function GetFeatureSymbol(ByVal pFeat As IFeature) As ISymbol

        Dim pSym As ISymbol

        ' get base symbol
        pSym = m_pMainRend.SymbolByFeature(pFeat)

        ' modify base symbol as necessary

        If (Not m_pSizeRend Is Nothing) And (Not m_pMainRend Is m_pSizeRend) And (Not pSym Is Nothing) Then
            pSym = ApplySize(pSym, pFeat)
        End If

        If ((Not m_pColorRend1 Is Nothing) Or (Not m_pColorRend2 Is Nothing)) And (Not pSym Is Nothing) Then
            pSym = ApplyColor(pSym, pFeat)
        End If

        If ((m_ShapeType = esriGeometryType.esriGeometryPoint) Or ((m_ShapeType = esriGeometryType.esriGeometryPolygon) And TypeOf pSym Is IMarkerSymbol)) And (Not pSym Is Nothing) Then
            If m_sRotationField <> "" Then
                pSym = ApplyRotation(pSym, pFeat)
            End If
        End If

        If m_sTransparencyField <> "" Then
            pSym = ApplyTransparency(pSym)
        End If
        'End If

        Return pSym

    End Function


    Private Function SortData(ByVal pCursor As IFeatureCursor, ByVal pTrackCancel As ITrackCancel) As IFeatureCursor
        ' sort in descending by value
        Dim pTable As ITable
        pTable = m_pFeatureClass

        Dim pTableSort As ITableSort
        pTableSort = New TableSort
        pTableSort.Table = pTable
        pTableSort.Cursor = pCursor

        ' why do I have to do this?
        Dim pQF As IQueryFilter
        pQF = New QueryFilter
        pQF.SubFields = "*"
        pQF.WhereClause = m_pQueryFilter.WhereClause
        pTableSort.QueryFilter = pQF

        Dim pPSRend As IProportionalSymbolRenderer
        pPSRend = m_pSizeRend
        Dim strValueField As String
        strValueField = pPSRend.Field
        pTableSort.Fields = strValueField
        pTableSort.Ascending(strValueField) = False

        Dim pDataNorm As IDataNormalization
        pDataNorm = pPSRend
        If pDataNorm.NormalizationType = esriDataNormalization.esriNormalizeByField Then
            ' comparison is not simple comparison of field values, use callback to do custom compare

            ' get normalization field and add to table sort
            Dim strFields As String = ""
            strFields = strFields & strValueField
            Dim strNormField As String
            strNormField = pDataNorm.NormalizationField
            strFields = strFields & ","
            strFields = strFields & strNormField
            pTableSort.Fields = strFields
            pTableSort.Ascending(strNormField) = False

            ' create new custom table call sort object and connect to the TableSort object
            Dim pTableSortCallBack As ITableSortCallBack
            pTableSortCallBack = New SortCallBack(pTable.Fields.FindField(strValueField), pTable.Fields.FindField(strNormField))
            pTableSort.Compare = pTableSortCallBack
        End If

        ' call the sort
        pTableSort.Sort(pTrackCancel)

        ' retrieve the sorted rows
        Dim pSortedCursor As IFeatureCursor
        pSortedCursor = pTableSort.Rows()

        Return pSortedCursor
    End Function

    Private Sub DrawSymbolsInOrder(ByVal Cursor As IFeatureCursor, ByVal drawPhase As esriDrawPhase, ByVal Display As IDisplay, ByVal trackCancel As ITrackCancel)
        ' this sub draws either markers or line symbols from large small so that the smallest symbols will be drawn on top

        ' in graduated symbol case, a cursor is built and parsed n times for n size classes
        ' in proportional symbol case, symbols are sorted and drawn from largest to smallest

        Dim iSizeIndex As Integer
        Dim iCurrentDrawableSymbolIndex As Integer
        Dim pMyCursor As IFeatureCursor
        Dim pFeat As IFeature
        Dim pFeatDraw As IFeatureDraw
        Dim bContinue As Boolean = True
        Dim pSizeSym As ISymbol
        Dim pDrawSym As ISymbol
        Dim pSortedCursor As IFeatureCursor

        If TypeOf m_pSizeRend Is IProportionalSymbolRenderer Then
            ' sort 
            pSortedCursor = SortData(Cursor, trackCancel)

            ' draw
            pFeat = pSortedCursor.NextFeature
            Do While Not pFeat Is Nothing
                pDrawSym = GetFeatureSymbol(pFeat)
                ' draw the feature
                pFeatDraw = pFeat
                Display.SetSymbol(pDrawSym)

                'implementation of IExportSupport
                BeginFeature(pFeat, Display)

                pFeatDraw.Draw(drawPhase, Display, pDrawSym, True, Nothing, esriDrawStyle.esriDSNormal)

                'implementation of IExportSupport
                GenerateExportInfo(pFeat, Display)
                EndFeature(Display)

                ' get next feature
                pFeat = pSortedCursor.NextFeature
                If Not trackCancel Is Nothing Then bContinue = trackCancel.[Continue]
            Loop

        Else
            Dim pSizeCBRend As IClassBreaksRenderer
            pSizeCBRend = m_pSizeRend
            pMyCursor = Cursor
            For iCurrentDrawableSymbolIndex = (pSizeCBRend.BreakCount - 1) To 0 Step -1
                ' do not build a cursor the 1st time because we already have one
                If iCurrentDrawableSymbolIndex < (pSizeCBRend.BreakCount - 1) Then
                    ' build pMyCursor
                    pMyCursor = m_pFeatureClass.Search(m_pQueryFilter, True)
                End If
                pFeat = pMyCursor.NextFeature
                Do While Not pFeat Is Nothing
                    ' check to see if we will draw in this pass
                    pSizeSym = m_pSizeRend.SymbolByFeature(pFeat)
                    iSizeIndex = GetSymbolIndex(pSizeSym, pSizeCBRend)
                    If (iSizeIndex = iCurrentDrawableSymbolIndex) Then
                        ' go ahead and draw the symbol
                        ' get symbol to draw
                        pDrawSym = GetFeatureSymbol(pFeat)

                        ' draw the feature
                        pFeatDraw = pFeat
                        Display.SetSymbol(pDrawSym)

                        'implementation of IExportSupport
                        BeginFeature(pFeat, Display)

                        pFeatDraw.Draw(drawPhase, Display, pDrawSym, True, Nothing, esriDrawStyle.esriDSNormal)

                        'implementation of IExportSupport
                        GenerateExportInfo(pFeat, Display)
                        EndFeature(Display)

                        If Not trackCancel Is Nothing Then bContinue = trackCancel.[Continue]
                    End If

                    pFeat = pMyCursor.NextFeature
                Loop

            Next iCurrentDrawableSymbolIndex ' increment DOWN to next symbol size

        End If

    End Sub

    Private Sub DrawSymbols(ByVal Cursor As IFeatureCursor, ByVal drawPhase As esriDrawPhase, ByVal Display As IDisplay, ByVal trackCancel As ITrackCancel)

        Dim pFeat As IFeature
        Dim pFeatDraw As IFeatureDraw
        Dim bContinue As Boolean = True
        Dim pDrawSym As ISymbol

        pFeat = Cursor.NextFeature
        bContinue = True
        ' while there are still more features and drawing has not been cancelled
        Do While (Not pFeat Is Nothing) And (bContinue = True)
            ' get symbol to draw
            pDrawSym = GetFeatureSymbol(pFeat)
            ' draw the feature
            pFeatDraw = pFeat
            Display.SetSymbol(pDrawSym)

            'implementation of IExportSupport
            BeginFeature(pFeat, Display)

            pFeatDraw.Draw(drawPhase, Display, pDrawSym, True, Nothing, esriDrawStyle.esriDSNormal)

            'implementation of IExportSupport
            GenerateExportInfo(pFeat, Display)
            EndFeature(Display)

            ' get next feature
            pFeat = Cursor.NextFeature
            If Not trackCancel Is Nothing Then bContinue = trackCancel.[Continue]
        Loop

    End Sub

    Private Function GetCombinedColor(ByVal pColor1 As IColor, ByVal pColor2 As IColor, ByVal eCombinationMethod As EColorCombinationType, Optional ByVal pOriginColor As IColor = Nothing) As ESRI.ArcGIS.Display.IColor
        ' combines the input colors based on m_eColorCombinationMethod

        Dim pOutColor As IColor

        Dim MyOLE_COLOR As Long ' As OLE_COLOR in VB6
        Dim pMainRGBColor As IRgbColor
        Dim pVariationRGBColor As IRgbColor
        Dim pMergedRGBColor As IRgbColor
        Dim bOK As Boolean
        Dim pAlgorithmicCR As IAlgorithmicColorRamp

        ' if either of the colors are null, then don't run the color through any algorithm,
        '   instead, just return the other color.  if both are null, then return a null color
        If pColor1.NullColor Then
            pOutColor = pColor2

        ElseIf pColor2.NullColor Then
            pOutColor = pColor1

        ElseIf eCombinationMethod = EColorCombinationType.enuComponents Then
            ' HSV components
            ' create a new HSV color
            Dim pHSVDrawColor As IHsvColor
            pHSVDrawColor = New HsvColor
            ' get HSV values from Color1 and Color2 and assign to pHSVDrawColor
            Dim pHSVColor1 As IHsvColor
            Dim pHSVColor2 As IHsvColor

            pHSVColor1 = New HsvColor
            pHSVColor1.RGB = pColor1.RGB
            pHSVColor2 = New HsvColor
            pHSVColor2.RGB = pColor2.RGB

            pHSVDrawColor.Hue = pHSVColor1.Hue
            pHSVDrawColor.Saturation = pHSVColor2.Saturation
            pHSVDrawColor.Value = pHSVColor2.Value

            pOutColor = pHSVDrawColor

        ElseIf eCombinationMethod = EColorCombinationType.enuRGBAverage Then
            ' use additive color model to merge the two colors
            MyOLE_COLOR = pColor1.RGB
            pMainRGBColor = New RgbColor
            pMainRGBColor.RGB = MyOLE_COLOR
            MyOLE_COLOR = pColor2.RGB
            pVariationRGBColor = New RgbColor
            pVariationRGBColor.RGB = MyOLE_COLOR
            ' merged color = RGB average of the two colors
            pMergedRGBColor = New RgbColor
            pMergedRGBColor.Red = (pMainRGBColor.Red + pVariationRGBColor.Red) / 2
            pMergedRGBColor.Green = (pMainRGBColor.Green + pVariationRGBColor.Green) / 2
            pMergedRGBColor.Blue = (pMainRGBColor.Blue + pVariationRGBColor.Blue) / 2

            pOutColor = pMergedRGBColor
        ElseIf (eCombinationMethod = EColorCombinationType.enuCIELabColorRamp) Or (eCombinationMethod = EColorCombinationType.enuLabLChColorRamp) Then
            ' use color ramp and take central color between the two colors
            pAlgorithmicCR = New AlgorithmicColorRamp
            If m_eColorCombinationMethod = EColorCombinationType.enuCIELabColorRamp Then
                pAlgorithmicCR.Algorithm = esriColorRampAlgorithm.esriCIELabAlgorithm
            Else
                pAlgorithmicCR.Algorithm = esriColorRampAlgorithm.esriLabLChAlgorithm
            End If
            pAlgorithmicCR.Size = 3
            pAlgorithmicCR.FromColor = pColor1
            pAlgorithmicCR.ToColor = pColor2
            pAlgorithmicCR.CreateRamp(bOK)

            pOutColor = pAlgorithmicCR.Color(1)     ' middle color in ramp
        Else ' EColorCombinationType.enuCIELabMatrix

            Dim iLab1(3) As Double ' L, a, b values for Color1
            Dim iLab2(3) As Double ' L, a, b values for Color2
            Dim iLabOrig(3) As Double ' L, a, b values for pOriginColor
            pColor1.GetCIELAB(iLab1(0), iLab1(1), iLab1(2))
            pColor2.GetCIELAB(iLab2(0), iLab2(1), iLab2(2))
            pOriginColor.GetCIELAB(iLabOrig(0), iLabOrig(1), iLabOrig(2))

            Dim iLabOut(3) As Double
            ' add color1 vector and color2 vector, then subtract the origin color vector
            iLabOut(0) = iLab1(0) + iLab2(0) - iLabOrig(0)
            iLabOut(1) = iLab1(1) + iLab2(1) - iLabOrig(1)
            iLabOut(2) = iLab1(2) + iLab2(2) - iLabOrig(2)

            CorrectLabOutofRange(iLabOut(0), iLabOut(1), iLabOut(2))

            Dim pHSVColor As IHsvColor
            pHSVColor = New HsvColor
            pHSVColor.SetCIELAB(iLabOut(0), iLabOut(1), iLabOut(2))
            pOutColor = pHSVColor
        End If

        Return pOutColor

    End Function

    Private Sub CorrectLabOutofRange(ByRef L As Double, ByRef a As Double, ByRef b As Double)

        If L > 100 Then
            L = 100
        ElseIf L < 0 Then
            L = 0
        End If

        If a > 120 Then
            a = 120
        ElseIf a < -120 Then
            a = -120
        End If

        If b > 120 Then
            b = 120
        ElseIf b < -120 Then
            b = -120
        End If

    End Sub

    Private Sub RemoveLegend()

        Dim i As Integer

        If Not m_pLegendGroups Is Nothing Then
            For i = 0 To UBound(m_pLegendGroups)
                m_pLegendGroups(i) = Nothing
            Next i
        End If
    End Sub

    Private Function CalcMainRend() As IFeatureRenderer
        ' consider using an internal array to keep track of active arrays in correct order, this will make it easier to implement ILegendInfo

        If (Not m_pShapePatternRend Is Nothing) Then
            If (m_ShapeType = esriGeometryType.esriGeometryPolygon) And Not m_pSizeRend Is Nothing Then
                Return m_pSizeRend
            Else
                Return m_pShapePatternRend
            End If
        ElseIf (Not m_pSizeRend Is Nothing) Then
            Return m_pSizeRend
        ElseIf (Not m_pColorRend1 Is Nothing) Then
            Return m_pColorRend1
        ElseIf (Not m_pColorRend2 Is Nothing) Then
            Return m_pColorRend2
        Else
            Return Nothing ' must have shape or color or size, if not you can't render...
        End If

    End Function

    Public Property ColorCombinationMethod() As EColorCombinationType Implements IMultivariateRenderer.ColorCombinationMethod
        Get
            Return m_eColorCombinationMethod
        End Get
        Set(ByVal Value As EColorCombinationType)
            m_eColorCombinationMethod = Value
        End Set
    End Property

    Public Property ColorRend1() As ESRI.ArcGIS.Carto.IFeatureRenderer Implements IMultivariateRenderer.ColorRend1
        Get
            Return m_pColorRend1
        End Get
        Set(ByVal Value As ESRI.ArcGIS.Carto.IFeatureRenderer)
            m_pColorRend1 = Value
            m_pMainRend = CalcMainRend()
        End Set
    End Property

    Public Property ColorRend2() As ESRI.ArcGIS.Carto.IFeatureRenderer Implements IMultivariateRenderer.ColorRend2
        Get
            Return m_pColorRend2
        End Get
        Set(ByVal Value As ESRI.ArcGIS.Carto.IFeatureRenderer)
            m_pColorRend2 = Value
        End Set
    End Property

    Public Property ShapePatternRend() As ESRI.ArcGIS.Carto.IFeatureRenderer Implements IMultivariateRenderer.ShapePatternRend
        Get
            Return m_pShapePatternRend
        End Get
        Set(ByVal Value As ESRI.ArcGIS.Carto.IFeatureRenderer)
            m_pShapePatternRend = Value
            m_pMainRend = CalcMainRend()
        End Set
    End Property

    Public Property SizeRend() As ESRI.ArcGIS.Carto.IFeatureRenderer Implements IMultivariateRenderer.SizeRend
        Get
            Return m_pSizeRend
        End Get
        Set(ByVal Value As ESRI.ArcGIS.Carto.IFeatureRenderer)
            m_pSizeRend = Value
            m_pMainRend = CalcMainRend()
        End Set
    End Property

    Private Function ApplyRotation(ByVal pMarkerSym As IMarkerSymbol, ByVal pFeat As IFeature) As IMarkerSymbol

        Dim lAngle As Double
        lAngle = Convert.ToDouble(pFeat.Value(pFeat.Fields.FindField(m_sRotationField)))

        If m_eRotationType = esriSymbolRotationType.esriRotateSymbolGeographic Then
            pMarkerSym.Angle = pMarkerSym.Angle - lAngle
        Else
            pMarkerSym.Angle = pMarkerSym.Angle + lAngle - 90
        End If

        Return pMarkerSym
    End Function

    Private Function ApplyTransparency(ByVal pSym As ISymbol) As ISymbol

        ' TODO

        Return pSym
    End Function

    Private Function ApplyColor(ByVal pSym As ISymbol, ByVal pFeat As IFeature) As ISymbol
        On Error GoTo ErrHand


        Dim pSym1 As ISymbol
        Dim pSym2 As ISymbol
        Dim pColor As IColor
        Dim pHSVColor As IHsvColor

        If (Not m_pColorRend1 Is Nothing) And (Not m_pColorRend2 Is Nothing) Then ' for now both color renderers need to be set to apply color
            pSym1 = m_pColorRend1.SymbolByFeature(pFeat)
            pSym2 = m_pColorRend2.SymbolByFeature(pFeat)
            ' only use GetCombinedColor for HSV component-type combination method
            If m_eColorCombinationMethod = EColorCombinationType.enuComponents Then
                pColor = GetCombinedColor(GetSymbolColor(pSym1), GetSymbolColor(pSym2), m_eColorCombinationMethod)

                pHSVColor = pColor

            Else
                'pColor = m_pColorMatrix(GetSymbolIndex(pSym1, m_pColorRend1), GetSymbolIndex(pSym2, m_pColorRend2))
                pColor = New RgbColor
                pColor.RGB = m_OLEColorMatrix(GetSymbolIndex(pSym1, m_pColorRend1), GetSymbolIndex(pSym2, m_pColorRend2))
            End If


            If TypeOf pSym Is IMarkerSymbol Then
                Dim pMarkerSym As IMarkerSymbol
                pMarkerSym = pSym
                pMarkerSym.Color = pColor
            ElseIf TypeOf pSym Is ILineSymbol Then
                Dim pLineSym As ILineSymbol
                pLineSym = pSym
                pLineSym.Color = pColor
            Else
                Dim pFillSym As IFillSymbol
                pFillSym = pSym
                pFillSym.Color = pColor

            End If


        End If

        Return pSym
        Exit Function
ErrHand:
        MsgBox("Apply Color " & Err.Description & "Line: " & Err.Erl)
    End Function


    

    Private Function ApplySize(ByVal pSym As ISymbol, ByVal pFeat As IFeature) As ISymbol

        If TypeOf pSym Is IMarkerSymbol Then
            ' Marker Symbol
            Dim pTargetMarkerSym As IMarkerSymbol
            pTargetMarkerSym = pSym
            Dim pSourceMarkerSym As IMarkerSymbol
            pSourceMarkerSym = m_pSizeRend.SymbolByFeature(pFeat)
            If Not (pSourceMarkerSym Is Nothing) Then
                pTargetMarkerSym.Size = pSourceMarkerSym.Size
            End If
        Else
            ' Line Symbol
            Dim pTargetLineSym As ILineSymbol
            pTargetLineSym = pSym
            Dim pSourceLineSym As ILineSymbol
            pSourceLineSym = m_pSizeRend.SymbolByFeature(pFeat)

            If Not (pSourceLineSym Is Nothing) Then
                pTargetLineSym.Width = pSourceLineSym.Width
            End If
        End If

        Return pSym
    End Function

    Public Property RotationField() As String Implements IRotationRenderer.RotationField
        Get
            Return m_sRotationField
        End Get
        Set(ByVal Value As String)
            m_sRotationField = Value
        End Set
    End Property

    Public Property TransparencyField() As String Implements ITransparencyRenderer.TransparencyField
        Get
            Return m_sTransparencyField
        End Get
        Set(ByVal Value As String)
            m_sTransparencyField = Value
        End Set
    End Property

    Public Property RotationType() As ESRI.ArcGIS.Carto.esriSymbolRotationType Implements IRotationRenderer.RotationType
        Get
            Return m_eRotationType
        End Get
        Set(ByVal Value As ESRI.ArcGIS.Carto.esriSymbolRotationType)
            m_eRotationType = Value
        End Set
    End Property

    Private Function GetSymbolIndex(ByVal pSym As ISymbol, ByVal pRend As IClassBreaksRenderer) As Integer
        ' given an input symbol and a renderer, this function returns the index of
        '   the class that the symbol represents in the renderer

        Dim i As Integer
        Dim iNumBreaks As Integer

        iNumBreaks = pRend.BreakCount
        i = 0
        Dim pLegendInfo As ILegendInfo
        pLegendInfo = pRend
        Do While (i < iNumBreaks - 1)
            If pLegendInfo.SymbolsAreGraduated Then
                ' compare based on size
                If SymbolsAreSameSize(pSym, pRend.Symbol(i)) Then Exit Do
            Else
                ' compare based on color
                If SymbolsAreSameColor(pSym, pRend.Symbol(i)) Then Exit Do
            End If
            i = i + 1
        Loop

        Return i

    End Function

    Private Function SymbolsAreSameSize(ByVal pSym1 As ISymbol, ByVal psym2 As ISymbol) As Boolean

        If TypeOf pSym1 Is IMarkerSymbol Then
            Dim pMS1 As IMarkerSymbol
            Dim pMS2 As IMarkerSymbol
            pMS1 = pSym1
            pMS2 = psym2
            Return pMS1.Size = pMS2.Size
        Else
            Dim pLS1 As ILineSymbol
            Dim pLS2 As ILineSymbol
            pLS1 = pSym1
            pLS2 = psym2
            Return pLS1.Width = pLS2.Width
        End If

    End Function

    Private Function SymbolsAreSameColor(ByVal pSym1 As ISymbol, ByVal psym2 As ISymbol) As Boolean

        Dim pColor1 As IColor
        Dim pColor2 As IColor
        pColor1 = GetSymbolColor(pSym1)
        pColor2 = GetSymbolColor(psym2)
        Return pColor1.RGB = pColor2.RGB

    End Function

    Private Sub BuildColorMatrix()
        On Error GoTo ErrHand

        Dim pCBRend1 As IClassBreaksRenderer
        Dim pCBRend2 As IClassBreaksRenderer

        pCBRend1 = New ClassBreaksRenderer()
        pCBRend2 = New ClassBreaksRenderer()

        If ((TypeOf m_pColorRend1 Is IFeatureRenderer) And (TypeOf m_pColorRend2 Is IFeatureRenderer)) Then
            pCBRend1 = CType(m_pColorRend1, IClassBreaksRenderer)
            pCBRend2 = CType(m_pColorRend2, IClassBreaksRenderer)

            Dim i As Integer
            Dim j As Integer
            Dim pColor1 As IColor
            Dim pColor2 As IColor
            Dim pColor As IColor

            If m_eColorCombinationMethod = EColorCombinationType.enuCIELabMatrix Then
                ' new (11/5/04) 

                ' origin (CIELab average now, but would be better to extend both lines to intersection point,
                '   or average of points where they are closest)
                pColor1 = GetSymbolColor(pCBRend1.Symbol(0))
                pColor2 = GetSymbolColor(pCBRend2.Symbol(0))
                pColor = GetCombinedColor(pColor1, pColor2, EColorCombinationType.enuCIELabColorRamp)
                Dim pOriginColor As IColor
                pOriginColor = pColor
                m_OLEColorMatrix(i, j) = pColor.RGB

                ' bottom edge (known)
                For i = 1 To pCBRend1.BreakCount - 1
                    pColor = GetSymbolColor(pCBRend1.Symbol(i))
                    m_OLEColorMatrix(i, 0) = pColor.RGB
                Next

                ' left edge (known)
                For j = 1 To pCBRend2.BreakCount - 1
                    pColor = GetSymbolColor(pCBRend2.Symbol(j))
                    m_OLEColorMatrix(0, j) = pColor.RGB
                Next

                ' remaining values (interpolated)
                For i = 1 To pCBRend1.BreakCount - 1
                    For j = 1 To pCBRend2.BreakCount - 1
                        pColor1 = GetSymbolColor(pCBRend1.Symbol(i))
                        pColor2 = GetSymbolColor(pCBRend2.Symbol(j))
                        pColor = GetCombinedColor(pColor1, pColor2, EColorCombinationType.enuCIELabMatrix, pOriginColor)
                        m_OLEColorMatrix(i, j) = pColor.RGB
                    Next j
                Next i

            Else

                For i = 0 To pCBRend1.BreakCount - 1
                    For j = 0 To pCBRend2.BreakCount - 1
                        pColor1 = GetSymbolColor(pCBRend1.Symbol(i))
                        pColor2 = GetSymbolColor(pCBRend2.Symbol(j))
                        pColor = GetCombinedColor(pColor1, pColor2, m_eColorCombinationMethod)
                        m_OLEColorMatrix(i, j) = pColor.RGB

                    Next j
                Next i

            End If
        
        End If

        Exit Sub
ErrHand:
        MsgBox(Err.Description)

    End Sub

    Private Function GetSymbolColor(ByVal pSym As ISymbol) As IColor
        Dim pMarkerSym As IMarkerSymbol
        Dim pLineSym As ILineSymbol
        Dim pFillSym As IFillSymbol
        Dim pColor As IColor


        If TypeOf pSym Is IMarkerSymbol Then
            pMarkerSym = pSym
            pColor = pMarkerSym.Color
        ElseIf TypeOf pSym Is ILineSymbol Then
            pLineSym = pSym
            pColor = pLineSym.Color
        ElseIf Not pSym Is Nothing Then
            pFillSym = pSym
            pColor = pFillSym.Color
        Else
            pColor = Nothing
        End If

        Return pColor

    End Function


End Class



'implementation of IExportSupport
' ExportSupport is a private helper class to help the renderer implement of IExportSupport.  This class contains
' the reference to the ExportInfoGenerator object used by the renderer.

Public Class ExportSupport
  Implements IExportSupport

  Dim m_symbologyEnvironment2 As ISymbologyEnvironment2
  Dim m_exportInfoGenerator As IFeatureExportInfoGenerator
  Dim m_exportAttributes As Boolean
  Dim m_exportHyperlinks As Boolean


  Public WriteOnly Property ExportInfo() As ESRI.ArcGIS.Carto.IFeatureExportInfoGenerator Implements ESRI.ArcGIS.Carto.IExportSupport.ExportInfo
    Set(ByVal value As ESRI.ArcGIS.Carto.IFeatureExportInfoGenerator)
      m_exportInfoGenerator = value
    End Set
  End Property


  Public Sub New()
    m_exportAttributes = False
    m_exportHyperlinks = False
  End Sub


  Protected Overrides Sub Finalize()
    m_symbologyEnvironment2 = Nothing
    m_exportInfoGenerator = Nothing
    MyBase.Finalize()
  End Sub



  Public Sub GetExportSettings()

    m_exportAttributes = False
    m_exportHyperlinks = False

    If m_exportInfoGenerator Is Nothing Then Exit Sub

    If m_symbologyEnvironment2 Is Nothing Then
      m_symbologyEnvironment2 = New SymbologyEnvironment
    End If

    m_exportAttributes = m_symbologyEnvironment2.OutputGDICommentForFeatureAttributes
    m_exportHyperlinks = m_symbologyEnvironment2.OutputGDICommentForHyperlinks

  End Sub


  Public Sub GenerateExportInfo(ByRef feature As IFeature, ByRef display As IDisplay)

    If m_exportInfoGenerator Is Nothing Then Exit Sub

    If m_exportAttributes Then m_exportInfoGenerator.GenerateFeatureInfo(feature, display)
    If m_exportHyperlinks Then m_exportInfoGenerator.GenerateHyperlinkInfo(feature, display)

  End Sub


  Public Sub GenerateExportInfo(ByRef featureDraw As IFeatureDraw, ByRef display As IDisplay)

    If m_exportInfoGenerator Is Nothing Then Exit Sub

    Dim feature As IFeature
    feature = featureDraw

    If m_exportAttributes Then m_exportInfoGenerator.GenerateFeatureInfo(feature, display)
    If m_exportHyperlinks Then m_exportInfoGenerator.GenerateHyperlinkInfo(feature, display)

  End Sub


  Public Sub AddExportFields(ByRef fc As IFeatureClass, ByRef queryFilter As IQueryFilter)

    If m_exportInfoGenerator Is Nothing Then Exit Sub

    GetExportSettings()

    If m_exportAttributes Or m_exportHyperlinks Then
      m_exportInfoGenerator.PrepareExportFilter(fc, queryFilter)
    End If

  End Sub


  Public Sub BeginFeature(ByRef feature As IFeature, ByRef display As IDisplay)

    If m_exportInfoGenerator Is Nothing Then Exit Sub

    m_exportInfoGenerator.BeginFeature(feature, display)

  End Sub


  Public Sub EndFeature(ByRef display As IDisplay)

    If m_exportInfoGenerator Is Nothing Then Exit Sub

    m_exportInfoGenerator.EndFeature(display)

  End Sub


End Class



<ComClass(SortCallBack.ClassId, SortCallBack.InterfaceId, SortCallBack.EventsId)> _
Public Class SortCallBack ' would like to declare this as private

    ' class definition for SortCallBack which implements custom table sorting based on field / normalization field

    Implements ITableSortCallBack

#Region "COM GUIDs"
    ' These  GUIDs provide the COM identity for this class 
    ' and its COM interfaces. If you change them, existing 
    ' clients will no longer be able to access the class.
    Public Const ClassId As String = "13137B0F-2255-46a4-9D6E-0A68FA560379"
    Public Const InterfaceId As String = "68A049DC-8E6C-4759-9797-960076474729"
    Public Const EventsId As String = "7BE0E19F-9AB3-4dd4-BB79-6EBD85E7930E"

#End Region

    ' data members
    Private m_value1 As VariantType
    Private m_value2 As VariantType
    Private m_iValueIndex As Integer
    Private m_iNormIndex As Integer

    Public Sub New(ByVal ValueIndex As Integer, ByVal NormIndex As Integer)
        m_iValueIndex = ValueIndex
        m_iNormIndex = NormIndex

    End Sub

    Public Function Compare(ByVal value1 As Object, ByVal value2 As Object, ByVal FieldIndex As Integer, ByVal fieldSortIndex As Integer) As Integer Implements ITableSortCallBack.Compare

        ' sort normalized values 

        If (FieldIndex = m_iValueIndex) Then

            m_value1 = value1
            m_value2 = value2
            Exit Function ' ?
        End If

        If (FieldIndex = m_iNormIndex) Then

            If (value1 = 0) Or (value2 = 0) Then Exit Function ' ?

            Dim dblNormedVal1 As Double
            Dim dblNormedVal2 As Double

            dblNormedVal1 = m_value1 / value1
            dblNormedVal2 = m_value2 / value2

            If dblNormedVal1 > dblNormedVal2 Then
                Compare = 1
            ElseIf dblNormedVal1 < dblNormedVal2 Then
                Compare = -1
            Else
                Compare = 0
            End If
        End If

    End Function

End Class