Public Function GetColors(vbStartColor As Long, vbEndColor As Long, Colors As Long) As IEnumColors Dim pStartColor As IRgbColor Dim pEndColor As IRgbColor Set pStartColor = New RgbColor Set pEndColor = New RgbColor pStartColor.RGB = vbStartColor pEndColor.RGB = vbEndColor Dim pRamp As IAlgorithmicColorRamp Set pRamp = New AlgorithmicColorRamp pRamp.Algorithm = esriHSVAlgorithm pRamp.FromColor = pStartColor pRamp.ToColor = pEndColor pRamp.size = Colors Dim blnIsRampOK As Boolean pRamp.CreateRamp blnIsRampOK If Not blnIsRampOK Then Exit Function Set GetColors = pRamp.Colors End Function Public Sub ClassifyPop() Dim pMxDoc As IMxDocument Dim pGFLayer As IGeoFeatureLayer Set pMxDoc = ThisDocument Set pGFLayer = pMxDoc.FocusMap.Layer(2) Dim lngClasses As Long lngClasses = InputBox("人口をいくつにクラス分類しますか?") If lngClasses < 2 Then Exit Sub Dim arrBreaks() As Double arrBreaks = GetEqualIntervalBreaks(pGFLayer, "Pop1999", lngClasses) Dim pEnumColors As IEnumColors Set pEnumColors = GetColors(vbYellow, vbRed, lngClasses) Dim pClassBreaksRenderer As IClassBreaksRenderer Set pClassBreaksRenderer = New ClassBreaksRenderer pClassBreaksRenderer.Field = "Pop1999" pClassBreaksRenderer.BreakCount = lngClasses pClassBreaksRenderer.SortClassesAscending = True Dim pColor As IColor Dim pFillSymbol As ISimpleFillSymbol Dim intBreakIndex As Integer For intBreakIndex = 0 To lngClasses - 1 Set pFillSymbol = New SimpleFillSymbol Set pColor = pEnumColors.Next pFillSymbol.Color = pColor pClassBreaksRenderer.Symbol(intBreakIndex) = pFillSymbol pClassBreaksRenderer.Break(intBreakIndex) = arrBreaks(intBreakIndex + 1) Next intBreakIndex Set pGFLayer.Renderer = pClassBreaksRenderer pMxDoc.UpdateContents pMxDoc.ActiveView.Refresh End Sub
ClassBreaksRenderer の利用
2016/9/1 (木)