[转帖]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