Change the rendering method of featuerlayer (VB. NET source code)

Source: Internet
Author: User

Featuerlayer is rendered in different ways, including hierarchical rendering, unique value rendering, and chart rendering ..

 

''' <Summary>
'''Hierarchical rendering of featurelayer
''' </Summary>
''' <Param name = "Player"> passed featurelayer </param>
''' <Remarks> </remarks>
Public sub assignquantileclassbreaks (byval player as ilayer)
'Classifies data using iclassify2 and quantile classification,
'Then creates classbreaksrenderer using these breaks,
'And assigns to first layer in the map
Dim pflayer as igeofeaturelayer
Dim pfclass as ifeatureclass
Dim pfeature as ifeature
Dim pfcursor as ifeaturecursor
Dim Prender as iclassbreaksrenderer
Dim pcolorenum as ienumcolors
Dim pcramp as icolorramp
Dim psym as isimplefillsymbol
Dim ptable as itable
Dim pgeolayer as igeofeaturelayer
Dim pclassifygen as iclassifygen
Dim ptablehistogram as itablehistogram
Dim phistogram as ihistogram
Dim frqs as object, xvals as object
Dim CB as object
Dim pcolorramp as ialgorithmiccolorramp, penumcolors as ienumcolors
Dim pcolor1 as irgbcolor
Dim pcolor2 as irgbcolor
Dim I as integer
Dim puiproperties as iclassbreaksuiproperties
Dim psimplefillsym as isimplefillsymbol

Pflayer = player
Pfclass = pflayer. featureclass
Pfcursor = pfclass. Search (nothing, false)
Pfeature = pfcursor. nextfeature
Ptable = pfclass

Pgeolayer = pflayer
Prender = new classbreaksrenderer
Pclassifygen = new quantile

Ptablehistogram = new tablehistogram
Phistogram = ptablehistogram

Ptablehistogram. Field = "pop2000" 'matches Renderer Field
Ptablehistogram. Table = ptable

Phistogram. gethistogram (xvals, frqs)
Pclassifygen. classify (xvals, frqs, 5) 'use five classes

Prender = new classbreaksrenderer
CB = pclassifygen. classbreaks

Prender. Field = "pop2000"
Prender. breakcount = 5
Prender. minimumbreak = CB (0)
'Note: minimum break is not the first break, it is actually the lowest value
'In the data set, the minimum value.

'Create our color Ramp
Pcolorramp = new algorithmiccolorramp
Pcolorramp. algorithm = esricolorrampalgorithm. esricielabalgorithm
Pcolor1 = new rgbcolor
Pcolor2 = new rgbcolor
Pcolor1.red= 255
Pcolor1.green= 210
Pcolor1.blue = 210
Pcolor2.red= 190
Pcolor2.green = 0
Pcolor2.blue = 170
Pcolorramp. fromcolor = pcolor1
Pcolorramp. tocolor = pcolor2
Pcolorramp. size = 5
Pcolorramp. createramp (true)
Penumcolors = pcolorramp. colors
Penumcolors. Reset ()
'Use this interface to set dialog Properties
Puiproperties = Prender
Puiproperties. colorramp = "Custom"

'Be careful, indices are different for the diff lists
For I = 0 to 4
Prender. Break (I) = CB (I + 1)
'A better label
Prender. Label (I) = CB (I) & "-" & CB (I + 1)
Puiproperties. lowbreak (I) = CB (I)
Psimplefillsym = new simplefillsymbol
Psimplefillsym. Color = penumcolors. Next
Prender. symbol (I) = psimplefillsym
Next I

'Assign Renderer to Layer
Pgeolayer. Renderer = Prender
End sub

''' <Summary>
'''Chart rendering featurelayer
''' </Summary>
''' <Param name = "Player"> featurelayer </param>
''' <Remarks> </remarks>
Private sub piechartrenderer (byval player as ilayer)
'** Paste into VBA
'** Creates a piechartrenderer and applies it to first layer in the map.
'** First layer in the map is the "States" feature class from ESRI's sample data
'** Layer must have "pop1990" Field
Const strpopfield1 = "pop1990"
Dim pfeatlayer as ifeaturelayer
Dim pfclass as ifeatureclass
Dim pgeofeaturelayer as igeofeaturelayer
Pfeatlayer = player
Pgeofeaturelayer = pfeatlayer
Pfclass = pfeatlayer. featureclass

Dim pchartrenderer as ichartrenderer
Dim prendererfields as irendererfields
Dim ppiechartrenderer as ipiechartrenderer

Pchartrenderer = new chartrenderer

'Set up the field to draw charts
Prendererfields = pchartrenderer
Prendererfields. addfield (strpopfield1)
Ppiechartrenderer = pchartrenderer

'Calculate the max value of the data field to scale the chart
Dim ptable as itable
Dim pcursor as icursor
Dim pqueryfilter as iqueryfilter
Dim prow as irowbuffer

Ptable = pgeofeaturelayer
Pqueryfilter = new queryfilter
Pqueryfilter. addfield (strpopfield1)
Pcursor = ptable. Search (pqueryfilter, true)

Dim fieldindex as long
Dim maxvalue as double
Dim firstvalue as Boolean
Dim fieldvalue as double

Fieldindex = ptable. findfield (strpopfield1)
Firstvalue = true
Maxvalue = 0

'Iterate your SS each feature
Prow = pcursor. nextrow
Do while not prow is nothing
Fieldvalue = prow. Value (fieldindex)
If firstvalue then
'Special case for the first value in a feature class
Maxvalue = fieldvalue
Firstvalue = false
Else
If fieldvalue> maxvalue then
'Our' ve got a new biggest value
Maxvalue = fieldvalue
End if
End if
Prow = pcursor. nextrow
Loop

If (maxvalue <= 0) then
Msgbox ("failed to calculate the maximum value or max value is 0 .")
Exit sub
End if

'Set up the chart marker symbol to use with the Renderer
Dim ppiechartsymbol as ipiechartsymbol
Dim pfillsymbol as ifillsymbol
Dim pmarkersymbol as imarkersymbol
Dim psymbolarray as isymbolarray
Dim pchartsymbol as ichartsymbol

Ppiechartsymbol = new piechartsymbol
Pchartsymbol = ppiechartsymbol
Ppiechartsymbol. Clockwise = true
Ppiechartsymbol. useoutline = true
Dim poutline as ilinesymbol
Poutline = new simplelinesymbol
Poutline. Color = getrgbcolor (255, 0,255)
Poutline. width = 1
Ppiechartsymbol. Outline = poutline
Pmarkersymbol = ppiechartsymbol

'Finally we 've got the biggest value, set this into the symbol
Pchartsymbol. maxvalue = maxvalue

'This is the maximum height of the bars
Pmarkersymbol. size = 16

Psymbolarray = ppiechartsymbol
Pfillsymbol = new simplefillsymbol
'This is a pastel purple
Pfillsymbol. Color = getrgbcolor (213,212,252)
Pfillsymbol. Outline = poutline
Psymbolarray. addsymbol (pfillsymbol)
'Set up the background symbol to use tan color
Pfillsymbol = new simplefillsymbol
Pfillsymbol. Color = getrgbcolor (239,228,190)
Pchartrenderer. basesymbol = pfillsymbol

'Disable overpoaster so that charts appear in the center of polygons
Pchartrenderer. useoverposter = false

'Update the Renderer and refresh the screen

Ppiechartrenderer. minsize = 6
Ppiechartrenderer. Min value = 453588
Ppiechartrenderer. flannerycompensation = false
Ppiechartrenderer. proportionalbysum = true

'Now set the piechart symbol into the Renderer
Pchartrenderer. chartsymbol = ppiechartsymbol
Pchartrenderer. Label = "Population"
Pchartrenderer. createlegend ()
Pgeofeaturelayer. Renderer = pchartrenderer

End sub

'This function returns an RGB color object initialised with the supplied Red Green and Blue values.
'All parameters range from 0 to 255 in value
Private function getrgbcolor (byval yourred as long, byval yourgreen as long ,_
Byval yourblue as long) as irgbcolor
Dim prgb as irgbcolor prgb = new rgbcolor
With prgb
. Red = yourred
. Green = yourgreen
. Blue = yourblue
. Usewindowsdithering = true
End
Getrgbcolor = prgb
End Function


''' <Summary>
'''Uniquevalue rendering featurelayer
''' </Summary>
''' <Param name = "Player"> passed featurelayer </param>
''' <Remarks> </remarks>
Sub createandapplyuvrenderer (byval player as ilayer)

'** Paste into VBA
'** Creates a uniquevaluesrenderer and applies it to first layer in the map.
'** Layer must have "name" Field
Dim pflayer as ifeaturelayer
Pflayer = player
Dim plyr as igeofeaturelayer
Plyr = pflayer

Dim pfeatcls as ifeatureclass
Pfeatcls = pflayer. featureclass
Dim pqueryfilter as iqueryfilter
Pqueryfilter = new queryfilter 'empty supports: Select *
Dim pfeatcursor as ifeaturecursor
Pfeatcursor = pfeatcls. Search (pqueryfilter, false)

'** Make the color ramp we will use for the symbols in the Renderer
Dim RX as irandomcolorramp
RX = new randomcolorramp
Rx. minsaturation = 20
Rx. maxsaturation = 40
Rx. minvalue = 85
Rx. maxvalue = 100
Rx. starthue = 76
Rx. endhue = 188
Rx. useseed = true
Rx. Seed = 43

'** Make the Renderer
Dim Prender as iuniquevaluerenderer, N as long
Prender = new uniquevaluerenderer

Dim symd as isimplefillsymbol
Symd = new simplefillsymbol
Symd. Style = esrisimplefillstyle. esrisfssolid
Symd. outline. width = 0.4

'** These properties shocould be set prior to adding values
Prender. fieldcount = 1
Prender. Field (0) = "name"
Prender. defaultsymbol = symd
Prender. usedefasymsymbol = true

Dim pfeat as ifeature
N = pfeatcls. featurecount (pqueryfilter)
'** Loop through the features
Dim I as integer
I = 0
Dim valfound as Boolean
Dim novalfound as Boolean
Dim uh as integer
Dim pfields as ifields
Dim ifield as integer
Pfields = pfeatcursor. Fields
Ifield = pfields. findfield ("name ")
Do until I = N
Dim symx as isimplefillsymbol
Symx = new simplefillsymbol
Symx. Style = esrisimplefillstyle. esrisfssolid
Symx. outline. width = 0.4
Pfeat = pfeatcursor. nextfeature
Dim X as string
X = pfeat. Value (ifield) '* New Cory *
'** Test to see if we' ve already added this value
'** To the Renderer, if not, then add it.
Valfound = false
For uh = 0 to (Prender. valuecount-1)
If Prender. Value (Uh) = x then
Novalfound = true
Exit
End if
Next uh
If not valfound then
Prender. addvalue (x, "name", symx)
Prender. Label (x) = x
Prender. symbol (x) = symx
End if
I = I + 1
Loop

'** Now that we know how many unique values there are
'** We can size the color ramp and assign the colors.
Rx. size = Prender. valuecount
Rx. createramp (true)
Dim rcolors as ienumcolors, NY as long
Rcolors = Rx. colors
Rcolors. Reset ()
For ny = 0 to (Prender. valuecount-1)
Dim XV as string
XV = Prender. Value (NY)
If XV <> "" then
Dim jsy as isimplefillsymbol
Jsy = Prender. symbol (XV)
Jsy. Color = rcolors. Next
Prender. symbol (XV) = jsy
End if
Next ny

'** If You Didn' t use a color ramp that was predefined
'** In a style, you need to use "Custom" here, otherwise
'** Use the name of the color ramp you chose.
Prender. colorscheme = "Custom"
Prender. fieldtype (0) = true
Plyr. Renderer = Prender
Plyr. displayfield = "name"

'** This makes the layer properties symbology tab show
'** Show the correct interface.
Dim HX as irendererpropertypage
HX = new uniquevaluepropertypage
Plyr. rendererpropertypageclassid = HX. classid
End sub

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.