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
記事
