VB辅导:VB实现地理对象的几种渲染方法

Private Sub Command1_Click()
　　Map1.Layers.Clear
　　Form_Load
　　End Sub
　　Private Sub Command2_Click()
　　Screen.MousePointer = vbHourglass
　　Map1.Layers("necenter").Visible = False
　　Set layer = Map1.Layers("counties")
　　'下面以hbeds_1000字段加入收藏 计算点数
　　'获取hbeds_1000字段统计数据
　　Set layer.renderer = New MapObjects2.DotDensityRenderer
　　layer.renderer.Field = "hbeds_1000"
　　Set stats = layer.Records.CalculateStatistics("hbeds_1000")
　　With layer.renderer
　　.DotColor = moRed
　　.DotSize = 5
　　'计算点数
　　.DotValue = (stats.Min + (stats.Max - stats.Min) / 2) / 20
　　End With
　　Map1.Refresh
　　Screen.MousePointer = vbDefault
　　End Sub
　　Private Sub Command3_Click()
　　Screen.MousePointer = vbHourglass
　　Map1.Layers("NeCenter").Visible = False
　　'由记录中的STATE_NAME字段生成序列值，Strings对象会自动识别重复的字符串
　　Dim strings As New MapObjects2.strings
　　Set layer = Map1.Layers("Counties")
　　Set recs = layer.Records
　　Do While Not recs.EOF
　　strings.Add recs("STATE_NAME").Value
　　recs.MoveNext
　　Loop
　　'建立新的ValueMapRenderer对象
　　Set layer.renderer = New ValueMapRenderer
　　'设置着色所依据的字段
　　layer.renderer.Field = "STATE_NAME"
　　'添加值序列到ValueMapRenderer对象
　　layer.renderer.ValueCount = strings.Count
　　For i = 0 To strings.Count - 1
　　layer.renderer.Value(i) = strings(i)
　　Next i
　　'刷新地图
　　Map1.Refresh
　　Screen.MousePointer = vbDefault
　　End Sub
　　Private Sub Command4_Click()
　　Screen.MousePointer = vbHourglass
　　Map1.Layers("necenter").Visible = False
　　Set layer = Map1.Layers("counties")
　　'建立新的ClassBreaksRenderer对象
　　Set layer.renderer = New ClassBreaksRenderer
　　Set r = layer.renderer
　　'设置着色字段
　　r.Field = "P_OTHER"
　　'设置统计对象
　　Set stats = layer.Records.CalculateStatistics("P_OTHER")
　　'以字段P_OTHER的标准差为区间长度，在P_OTHER字段的平均值附近生成7个区间
　　Dim breadVal As Double
　　breakval = stats.Mean - (stats.StdDev * 3)
　　For i = 0 To 6
　　If breakval >= stats.Min And breadVal <= stats.Max Then
　　r.BreakCount = r.BreakCount + 1
　　'设置区间分界点
　　r.Break(r.BreakCount - 1) = breakval
　　End If
　　breakval = breakval + stats.StdDev
　　Next i
　　'使用RampColors方法对区间序列渐变填色
　　r.RampColors moLightYellow, moBlue
　　Map1.Refresh
　　Screen.MousePointer = vbDefault
　　End Sub
　　Private Sub Command5_Click()
　　Screen.MousePointer = vbHourglass
　　Map1.Layers("necenter").Visible = False
　　Set layer = Map1.Layers("counties")
　　Set layer.renderer = New MapObjects2.ClassBreaksRenderer
　　Set r = layer.renderer
　　r.Field = "P_OTHER"
　　'设置区间数量为5
　　nclasses = 5
　　'获取记录数
　　nrecs = layer.Records.Count
　　r.BreakCount = nclasses - 1
　　'获取所有地理对象的记录
　　Set recs = layer.SearchExpression("FeatureID>-1 order by P_OTHER")
　　'浏览记录并获取区间分界点
　　For i = 1 To r.BreakCount - 1
　　For j = 1 To nrecs / nclasses
　　recs.MoveNext
　　Next j
　　r.Break(i) = recs("P_OTHER").Value
　　Next i
　　r.RampColors moLightYellow, moBlue
　　Map1.Refresh
　　Screen.MousePointer = vbDefault
　　End SubPrivate Sub Command6_Click()
　　Screen.MousePointer = vbHourglass
　　Map1.Layers("necenter").Visible = True
　　Set Map1.Layers("counties").renderer = Nothing
　　Set layer = Map1.Layers("necenter")
　　Set layer.renderer = New ClassBreaksRenderer
　　Set r = layer.renderer
　　r.Field = "P_OTHER"
　　r.SymbolType = layer.Symbol.SymbolType
　　'设置统计对象
　　Set stats = layer.Records.CalculateStatistics("P_OTHER")
　　'以字段P_OTHER的标准差为区间长度，在P_OTHER字段的平均值附近生成7个区间
　　Dim breakval As Double
　　breakval = stats.Mean - (stats.StdDev * 3)
　　For i = 0 To 6
　　If breakval >= stats.Min And breakval <= stats.Max Then
　　r.BreakCount = r.BreakCount + 1
　　r.Break(r.BreakCount - 1) = breakval
　　End If
　　breakval = breakval + stats.StdDev
　　Next i
　　'使用SizeSymbols改变区间序列符号的大小
　　r.SizeSymbols 3, 8
　　For i = 0 To r.BreakCount
　　'将所有区间颜色变成红色
　　r.Symbol(i).Color = moRed
　　Next i
　　Map1.Refresh
　　Screen.MousePointer = vbDefault
　　End Sub
　　Private Sub Command8_Click()
　　Set Map1.Extent = Map1.FullExtent
　　End Sub
　　Private Sub Form_Load()
　　Command1.Caption = "单一符号"
　　Command2.Caption = "点密度(DotDensityRenderer)"
　　Command3.Caption = "值图(ValueMapRenderer)"
　　Command4.Caption = "标准差图(ClassBreakRenderer)"
　　Command5.Caption = "数量分类图(ClassBreakRenderer)"
　　Command6.Caption = "渐变符号图(ClassBreakRenderer)"
　　Command7.Caption = "文本标注图(LabelRenderer)"
　　Command8.Caption = "全图显示"
　　Dim dc As New MapObjects2.DataConnection
　　dc.Database = "D:Program FilesESRIMapObjects2SamplesDataNorthEast"
　　If Not dc.Connect Then Exit Sub
　　Dim layer As New MapObjects2.MapLayer
　　layer.GeoDataset = dc.FindGeoDataset("Counties")
　　layer.Symbol.Color = RGB(0, 0, 250)
　　Map1.Layers.Add layer
　　Set layer = New MapLayer
　　layer.GeoDataset = dc.FindGeoDataset("NeCenter")
　　layer.Visible = False
　　Map1.Layers.Add layer
　　End Sub
　　Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
　　If Button = 1 Then
　　Dim tmpExtent As MapObjects2.Rectangle
　　Set tmpExtent = Map1.TrackRectangle
　　Map1.Extent = tmpExtent
　　ElseIf Button = 2 Then
　　Dim r As MapObjects2.Rectangle
　　Set r = Map1.Extent
　　r.ScaleRectangle 1.5
　　Map1.Extent = r
　　End If
　　End Sub
　　ValueMapRenderer对象主要属性
　　DefaultSymbol属性: 返回绘制的MapLayer的缺省Symbol对象的引用
　　field属性: 设置着色所依据的属性字段
　　RotationField属性：设置点状符号的旋转角度，仅仅对点对象且Symbol的Style的属性为moTrueTypemarker的图层有效
　　ScalingField属性:设置相对反打倍数因子，仅仅对点对象且Symbol的Style的属性为moTrueTypemarker的图层有效
　　Symbol属性: 返回由属性字段的一系列值所确定的Symbol对象的集合
　　SymbolType属性: 返回要显示的地理对象睦嘈?/p>
　　Tag属性: 用于填写描述信息
　　UseDefault属性: 设置是否采用DefaultSymbol
　　ValueCount属性: 值序列中值的个数
　　Value序列: 用Field指定的属性字段所产生的一系列值
　　ClassBreaksRenderer对象属性
　　RampColors方法: 以渐变色的方法依次设置各个级别的符号的颜色属性，RampColors 颜色一，颜色二
　　SizeSymbol方法: 设置各个级别的符号对象的Size属性，SizeSymbol size1, size2
　　BreakCount属性: 区间分界点的数量
　　Break属性: 由区间分界点生成的区间序列
　　Field , Symbol, SymbolType, Tag同上
　　DotDensityRenderer对象属性
　　DotColor，DotSize分别设置点的颜色大小
　　DotValue属性: 点的基准值
　　DrawBackground属性: 除了显示点外还显示地理对象
　　Field , Tag属性同上
　　以上三种使用方法一般是:
　　Dim Xrenderer As MapObjects2.DotDensityRenderer
　　然后对各种属性设置
　　Set Map1.Layers("").renderer = renderer