GIS之家

[转帖]GIS二次开发经典代码:渲染栅格图层
[ 2008-5-30 14:23:00 | By: 月夜随风 ]

0
推荐Public Sub SetRasterRenderer()
Dim NumOfClass As Integer
NumOfClass = 5
' Get Map
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap

' Get raster input from layer
Dim pRLayer As IRasterLayer
Set pRLayer = pMap.Layer(0)
Dim pRaster As IRaster
Set pRaster = pRLayer.Raster

' Create classfy renderer and QI RasterRenderer interface
Dim pClassRen As IRasterClassifyColorRampRenderer
Set pClassRen = New RasterClassifyColorRampRenderer
Dim pRasRen As IRasterRenderer
Set pRasRen = pClassRen
字串5
' Set raster for the render and update
Set pRasRen.Raster = pRaster
pClassRen.ClassCount = NumOfClass

pRasRen.Update

' Create a color ramp to use
Dim pRamp As IAlgorithmicColorRamp
Set pRamp = New AlgorithmicColorRamp
pRamp.Size = NumOfClass
Dim pFColor As IColor
Dim pTColor As IColor
Set pFColor = New RgbColor
Set pTColor = New RgbColor
pFColor.RGB = RGB(10, 100, 10)
pTColor.RGB = RGB(60, 0, 60)

pRamp.FromColor = pFColor
pRamp.ToColor = pTColor
pRamp.CreateRamp True

' Create symbol for the classes 字串2
Dim pFSymbol As IFillSymbol
Set pFSymbol = New SimpleFillSymbol

' loop through the classes and apply the color and label
Dim i As Integer
For i = 0 To pClassRen.ClassCount - 1
pFSymbol.Color = pRamp.Color(i)
pClassRen.Symbol(i) = pFSymbol
pClassRen.Label(i) = "Class" & CStr(i)
Next i

' Update the renderer and plug into layer
pRasRen.Update

Set pRLayer.Renderer = pClassRen
pMxDoc.ActiveView.Refresh
pMxDoc.UpdateContents

' Release memeory
Set pMxDoc = Nothing 字串4
Set pMap = Nothing
Set pRLayer = Nothing
Set pRaster = Nothing
Set pRasRen = Nothing
Set pClassRen = Nothing
Set pRamp = Nothing
Set pFSymbol = Nothing
End Sub