displayrenderers.frm

AO开发六种专题图的代码[独立执行程序]

VERSION 5.00
Object = "{C552EA90-6FBB-11D5-A9C1-00104BB6FC1C}#1.0#0"; "MapControl.ocx"
Begin VB.Form frmDisplayRenderers 
   Caption         =   "Display Renderers"
   ClientHeight    =   6300
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8205
   LinkTopic       =   "Form1"
   ScaleHeight     =   6300
   ScaleWidth      =   8205
   StartUpPosition =   3  'Windows Default
   Begin esriMapControl.MapControl MapControl1 
      Height          =   4215
      Left            =   120
      OleObjectBlob   =   "DisplayRenderers.frx":0000
      TabIndex        =   9
      Top             =   120
      Width           =   6615
   End
   Begin VB.TextBox txbOutput 
      BackColor       =   &H8000000F&
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1695
      Left            =   4200
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   8
      Top             =   4440
      Width           =   3855
   End
   Begin VB.CommandButton cmdLoadData 
      Caption         =   "Load States Shape File"
      Height          =   735
      Left            =   6960
      TabIndex        =   7
      Top             =   120
      Width           =   1095
   End
   Begin VB.CommandButton cmdBarChart 
      Caption         =   "Bar Chart"
      Height          =   735
      Left            =   1440
      TabIndex        =   6
      Top             =   5400
      Width           =   1095
   End
   Begin VB.CommandButton cmdDotDensity 
      Caption         =   "Dot Density"
      Height          =   735
      Left            =   2760
      TabIndex        =   5
      Top             =   5400
      Width           =   1095
   End
   Begin VB.CommandButton cmdPropSymbol 
      Caption         =   "Proportional Symbol"
      Height          =   735
      Left            =   120
      TabIndex        =   4
      Top             =   5400
      Width           =   1095
   End
   Begin VB.CommandButton cmdClassBreaks 
      Caption         =   "Class Breaks"
      Height          =   735
      Left            =   2760
      TabIndex        =   3
      Top             =   4440
      Width           =   1095
   End
   Begin VB.CommandButton cmdSimpleRenderer 
      Caption         =   "Simple"
      Height          =   735
      Left            =   120
      TabIndex        =   2
      Top             =   4440
      Width           =   1095
   End
   Begin VB.CommandButton cmdUniqueValue 
      Caption         =   "Unique Value "
      Height          =   735
      Left            =   1440
      TabIndex        =   1
      Top             =   4440
      Width           =   1095
   End
   Begin VB.CommandButton cmdFullExtent 
      Caption         =   "Full Extent"
      Height          =   735
      Left            =   6960
      TabIndex        =   0
      Top             =   3600
      Width           =   1095
   End
End
Attribute VB_Name = "frmDisplayRenderers"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' This sample shows a standalone Visual Basic application that uses the ArcObjects
' components to load the US states shape file. Simple zoom in and full extent are
' implemented. The main aim is to illustrate some of the different
' renderer objects that are available by selecting an appropriate button
'

' Form variables used in this project
'

' This is used to reference the loaded layer
Private m_pGeoFeatureLayer As IGeoFeatureLayer

' Field name for unique value Renderer
Const strNameField = "STATE_NAME"

' Population fields for Class Breaks, Propotional symbol, bar chart, dot densiy renderers
Const strPopField1 = "POP1990"
Const strPopField2 = "POP1999"

' Number of breaks for class breaks renderer
Const numDesiredClasses As Long = 3
'
' Set up a renderer to draw bar charts for two population fields
'
Private Sub cmdBarChart_Click()
  Dim pChartRenderer As IChartRenderer
  Dim pRendererFields As IRendererFields

  Set pChartRenderer = New ChartRenderer
  
  ' Set up the fields to draw charts of
  Set pRendererFields = pChartRenderer
  pRendererFields.AddField strPopField1
  pRendererFields.FieldAlias(0) = pRendererFields.Field(0)
  pRendererFields.AddField strPopField2
  pRendererFields.FieldAlias(1) = pRendererFields.Field(1)
    
  ' Calculate the max value of the data fields to allow the bar chart
  ' to scale the bars correctly
  ' Do this by looking through all the data fields of all the features
  '
  Dim pTable As ITable
  Dim pCursor As ICursor
  Dim pQueryFilter As IQueryFilter
  Dim pRow As IRowBuffer
  
  Set pTable = m_pGeoFeatureLayer
  Set pQueryFilter = New QueryFilter
  pQueryFilter.AddField strPopField1
  pQueryFilter.AddField strPopField2
  Set pCursor = pTable.Search(pQueryFilter, True)
  
  ' Make an array of the field numbers to iterate accross,
  ' this is to keep the code generic in the number of bars to draw.
  '
  Const numFields As Long = 2 ' Number of bars
  Dim fieldIndecies(0 To numFields - 1) As Long
  Dim fieldIndex As Long
  Dim maxValue As Double
  Dim firstValue As Boolean
  Dim fieldValue As Double
  
  fieldIndecies(0) = pTable.FindField(strPopField1)
  fieldIndecies(1) = pTable.FindField(strPopField2)
  firstValue = True
  maxValue = 0
  
  ' Iterate across each feature
  Set pRow = pCursor.NextRow
  Do While Not pRow Is Nothing
    
    ' iterate  through each data field and update the maxVal if needed
    For fieldIndex = 0 To numFields - 1
      fieldValue = pRow.Value(fieldIndecies(fieldIndex))
      If firstValue Then
        ' Special case for the first value in a feature class
        maxValue = fieldValue
        firstValue = False
      Else
        If fieldValue > maxValue Then
          ' we've got a new biggest value
          maxValue = fieldValue
        End If
      End If
      
    Next fieldIndex
    
    Set 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 pBarChartSymbol As IBarChartSymbol
  Dim pFillSymbol As IFillSymbol
  Dim pMarkerSymbol As IMarkerSymbol
  Dim pSymbolArray As ISymbolArray
  Dim pChartSymbol As IChartSymbol
    
  Set pBarChartSymbol = New BarChartSymbol
  Set pChartSymbol = pBarChartSymbol
  pBarChartSymbol.Width = 6
  Set pMarkerSymbol = pBarChartSymbol
  
  ' 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
  
  ' Now set up symbols for each bar
  Set pSymbolArray = pBarChartSymbol
  
  ' Add some colours in for each bar
  
  Set pFillSymbol = New SimpleFillSymbol
  ' This is a pastel purple
  pFillSymbol.Color = GetRGBColor(213, 212, 252)
  pSymbolArray.AddSymbol pFillSymbol
  
  Set pFillSymbol = New SimpleFillSymbol
  ' This is a pastel green
  pFillSymbol.Color = GetRGBColor(193, 252, 179)
  pSymbolArray.AddSymbol pFillSymbol
  
  ' Now set the barchart symbol into the renderer
  Set pChartRenderer.ChartSymbol = pBarChartSymbol
  pChartRenderer.Label = "Population"
  
  ' set up the background symbol to use tan color
  Set pFillSymbol = New SimpleFillSymbol
  pFillSymbol.Color = GetRGBColor(239, 228, 190)
  Set pChartRenderer.BaseSymbol = pFillSymbol
  
  ' Disable overpoaster so that charts appear in the centre of polygons
  pChartRenderer.UseOverposter = False
   
  ' Update the renderer and refresh the screen
  Set m_pGeoFeatureLayer.Renderer = pChartRenderer

  MapControl1.Refresh esriViewGeography
  
  Dim strMax As String
  strMax = Format$(maxValue, "###,###,###")
  
  txbOutput.Text = "Chart Renderer" & vbNewLine & vbNewLine & _
  "This uses a bar chart symbol and a chart renderer to show population change in each US state." & vbNewLine & _
  "The change is illustrated between two fields " & strPopField1 & " (purple) and " & strPopField2 & " (green)." & vbNewLine & _
  "To size the bar chart the maximum of these two fields is calculated which is " & strMax & "."

End Sub
'
' ClassBreaks Renderer:
' Colors states according to population of each state,
' breaks the population into equal interval classes
'
Private Sub cmdClassBreaks_Click()

  Dim pTable As ITable
  Dim pClassify As IClassify
  Dim pTableHistogram As ITableHistogram
  Dim pHistogram As IHistogram
  Dim dataFrequency As Variant
  Dim dataValues As Variant
  Dim strOutput As String
  
  ' We're going to retrieve frequency data from a population field
  ' and then classify this data
  '
  Set pTable = m_pGeoFeatureLayer
  Set pTableHistogram = New TableHistogram
  Set pHistogram = pTableHistogram
  
  ' Get values and frequencies for the population field
  ' into a table histogram object
  pTableHistogram.Field = strPopField1
  Set pTableHistogram.Table = pTable
  pHistogram.GetHistogram dataValues, dataFrequency
  
  ' Put the values and frequencies into an Equal Interval classify object
  '
  Set pClassify = New EqualInterval
  pClassify.SetHistogramData dataValues, dataFrequency

  ' Now a generate the classes
  ' Note:
  ' 1/ The number of classes returned may be different from requested
  '    (depends on classification algorithm)
  ' 2/ The classes array starts at index 0 and has datavalues starting
  '    from the minumum value, going to maximum
  '
  Dim Classes() As Double
  Dim ClassesCount As Long
  
  pClassify.Classify numDesiredClasses
  Classes = pClassify.ClassBreaks
  ClassesCount = UBound(Classes)

  ' Initialise a new class breaks renderer and supply the number of
  ' class breaks and the field to perform the class breaks on.
  '
  Dim pClassBreaksRenderer As IClassBreaksRenderer
  
  Set pClassBreaksRenderer = New ClassBreaksRenderer
  pClassBreaksRenderer.Field = strPopField1
  pClassBreaksRenderer.BreakCount = ClassesCount
  pClassBreaksRenderer.SortClassesAscending = True

  ' Use an algorithmic color ramp to generate an range of colors between
  ' yellow to red (taken from ArcMaps colorramp properties)
  '
  
  ' Set the initial color to yellow
  '
  Dim pFromColor As IHsvColor
  
  Set pFromColor = New HsvColor
  pFromColor.Hue = 60         ' Yellow
  pFromColor.Saturation = 100
  pFromColor.Value = 96
  
  ' Set the final color to be red
  '
  Dim pToColor As IHsvColor
  
  Set pToColor = New HsvColor
  pToColor.Hue = 0         ' Red
  pToColor.Saturation = 100
  pToColor.Value = 96
  
  ' Set up the HSV colour ramp to span from yellow to red
  '
  Dim pRamp As IAlgorithmicColorRamp
  Dim pEnumColors As IEnumColors
  Dim ok As Boolean
  
  Set pRamp = New AlgorithmicColorRamp
  pRamp.Algorithm = esriHSVAlgorithm
  pRamp.FromColor = pFromColor
  pRamp.ToColor = pToColor
  pRamp.Size = ClassesCount
  pRamp.CreateRamp ok
  Set pEnumColors = pRamp.Colors
  
  
  ' Iterate through each class brake, setting values and corresponding
  ' fill symbols for each polygon, note we skip the minimum value (classes(0))
  '
  Dim pColor As IColor
  Dim pFillSymbol As ISimpleFillSymbol
  Dim breakIndex As Long
  
  For breakIndex = 0 To ClassesCount - 1
  
    ' Retrieve a color and set up a fill symbol,
    ' put this in the symbol array corresponding to the class value
    '
    Set pColor = pEnumColors.Next
    Set pFillSymbol = New SimpleFillSymbol
    pFillSymbol.Color = pColor
    pFillSymbol.Style = esriSFSSolid
    pClassBreaksRenderer.Symbol(breakIndex) = pFillSymbol
    pClassBreaksRenderer.Break(breakIndex) = Classes(breakIndex + 1)
    
    ' Store each break value for user output
    strOutput = strOutput & "- " & Classes(breakIndex + 1) & vbNewLine
    
  Next breakIndex

  ' Assign the renderer to the layer and update the display
  '
  Set m_pGeoFeatureLayer.Renderer = pClassBreaksRenderer
  
  MapControl1.Refresh esriViewGeography
  
  txbOutput.Text = "Class Breaks Renderer" & vbNewLine & vbNewLine & _
  "Fills the States polygons with a color according to population from field " & strPopField1 & "." & vbNewLine & _
  "Colors range from yellow (low) to red (high)." & vbNewLine & _
  "The " & pClassify.MethodName & " classification is used to generate " & ClassesCount & " classes." & _
  "Class breaks are:" & vbNewLine & _
  strOutput
   
End Sub
'
' DotDensity Renderer:
'  This draws marker symbols randomly in the polygon, the number of markers corresponds
'  to the population
'
Private Sub cmdDotDensity_Click()
  Dim pDotDensityRenderer As IDotDensityRenderer
  Dim pDotDensityFillSymbol As IDotDensityFillSymbol
  Dim pRendererFields As IRendererFields
  Dim pSymbolArray As ISymbolArray

  Set pDotDensityRenderer = New DotDensityRenderer
  
    ' Set up the fields to draw charts of
  Set pRendererFields = pDotDensityRenderer
  pRendererFields.AddField strPopField1

  ' Set up dot density symbol
  Set pDotDensityFillSymbol = New DotDensityFillSymbol
  pDotDensityFillSymbol.DotSize = 3
  pDotDensityFillSymbol.Color = GetRGBColor(0, 0, 0)
  pDotDensityFillSymbol.BackgroundColor = GetRGBColor(239, 228, 190) ' color of tan
  
  Dim pMarkerSymbol As ISimpleMarkerSymbol
  
  ' Put one marker type into the dot density symbol
  Set pSymbolArray = pDotDensityFillSymbol
  Set pMarkerSymbol = New SimpleMarkerSymbol
  pMarkerSymbol.Style = esriSMSCircle