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字段加入收藏 計(jì)算點(diǎn)數(shù)
'獲取hbeds_1000字段統(tǒng)計(jì)數(shù)據(jù)
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
'計(jì)算點(diǎn)數(shù)
.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對(duì)象會(huì)自動(dòng)識(shí)別重復(fù)的字符串
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對(duì)象
Set layer.renderer = New ValueMapRenderer
'設(shè)置著色所依據(jù)的字段
layer.renderer.Field = "STATE_NAME"
'添加值序列到ValueMapRenderer對(duì)象
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對(duì)象
Set layer.renderer = New ClassBreaksRenderer
Set r = layer.renderer
'設(shè)置著色字段
r.Field = "P_OTHER"
'設(shè)置統(tǒng)計(jì)對(duì)象
Set stats = layer.Records.CalculateStatistics("P_OTHER")
'以字段P_OTHER的標(biāo)準(zhǔn)差為區(qū)間長(zhǎng)度，在P_OTHER字段的平均值附近生成7個(gè)區(qū)間
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
'設(shè)置區(qū)間分界點(diǎn)
r.Break(r.BreakCount - 1) = breakval
End If
breakval = breakval + stats.StdDev
Next i
'使用RampColors方法對(duì)區(qū)間序列漸變填色
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"
'設(shè)置區(qū)間數(shù)量為5
nclasses = 5
'獲取記錄數(shù)
nrecs = layer.Records.Count
r.BreakCount = nclasses - 1
'獲取所有地理對(duì)象的記錄
Set recs = layer.SearchExpression("FeatureID>-1 order by P_OTHER")
'瀏覽記錄并獲取區(qū)間分界點(diǎn)
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
'設(shè)置統(tǒng)計(jì)對(duì)象
Set stats = layer.Records.CalculateStatistics("P_OTHER")
'以字段P_OTHER的標(biāo)準(zhǔn)差為區(qū)間長(zhǎng)度，在P_OTHER字段的平均值附近生成7個(gè)區(qū)間
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改變區(qū)間序列符號(hào)的大小
r.SizeSymbols 3, 8
For i = 0 To r.BreakCount
'將所有區(qū)間顏色變成紅色
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 = "單一符號(hào)"
Command2.Caption = "點(diǎn)密度(DotDensityRenderer)"
Command3.Caption = "值圖(ValueMapRenderer)"
Command4.Caption = "標(biāo)準(zhǔn)差圖(ClassBreakRenderer)"
Command5.Caption = "數(shù)量分類圖(ClassBreakRenderer)"
Command6.Caption = "漸變符號(hào)圖(ClassBreakRenderer)"
Command7.Caption = "文本標(biāo)注圖(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對(duì)象主要屬性
DefaultSymbol屬性: 返回繪制的MapLayer的缺省Symbol對(duì)象的引用
field屬性: 設(shè)置著色所依據(jù)的屬性字段
RotationField屬性：設(shè)置點(diǎn)狀符號(hào)的旋轉(zhuǎn)角度，僅僅對(duì)點(diǎn)對(duì)象且Symbol的Style的屬性為moTrueTypemarker的圖層有效
ScalingField屬性:設(shè)置相對(duì)反打倍數(shù)因子，僅僅對(duì)點(diǎn)對(duì)象且Symbol的Style的屬性為moTrueTypemarker的圖層有效
Symbol屬性: 返回由屬性字段的一系列值所確定的Symbol對(duì)象的集合
SymbolType屬性: 返回要顯示的地理對(duì)象睦嘈?/p>
Tag屬性: 用于填寫描述信息
UseDefault屬性: 設(shè)置是否采用DefaultSymbol
ValueCount屬性: 值序列中值的個(gè)數(shù)
Value序列: 用Field指定的屬性字段所產(chǎn)生的一系列值
ClassBreaksRenderer對(duì)象屬性
RampColors方法: 以漸變色的方法依次設(shè)置各個(gè)級(jí)別的符號(hào)的顏色屬性，RampColors 顏色一，顏色二
SizeSymbol方法: 設(shè)置各個(gè)級(jí)別的符號(hào)對(duì)象的Size屬性，SizeSymbol size1, size2
BreakCount屬性: 區(qū)間分界點(diǎn)的數(shù)量
Break屬性: 由區(qū)間分界點(diǎn)生成的區(qū)間序列
Field , Symbol, SymbolType, Tag同上
DotDensityRenderer對(duì)象屬性
DotColor，DotSize分別設(shè)置點(diǎn)的顏色大小
DotValue屬性: 點(diǎn)的基準(zhǔn)值
DrawBackground屬性: 除了顯示點(diǎn)外還顯示地理對(duì)象
Field , Tag屬性同上
以上三種使用方法一般是:
Dim Xrenderer As MapObjects2.DotDensityRenderer
然后對(duì)各種屬性設(shè)置
Set Map1.Layers("").renderer = renderer
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字段加入收藏 計(jì)算點(diǎn)數(shù)
'獲取hbeds_1000字段統(tǒng)計(jì)數(shù)據(jù)
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
'計(jì)算點(diǎn)數(shù)
.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對(duì)象會(huì)自動(dòng)識(shí)別重復(fù)的字符串
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對(duì)象
Set layer.renderer = New ValueMapRenderer
'設(shè)置著色所依據(jù)的字段
layer.renderer.Field = "STATE_NAME"
'添加值序列到ValueMapRenderer對(duì)象
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對(duì)象
Set layer.renderer = New ClassBreaksRenderer
Set r = layer.renderer
'設(shè)置著色字段
r.Field = "P_OTHER"
'設(shè)置統(tǒng)計(jì)對(duì)象
Set stats = layer.Records.CalculateStatistics("P_OTHER")
'以字段P_OTHER的標(biāo)準(zhǔn)差為區(qū)間長(zhǎng)度，在P_OTHER字段的平均值附近生成7個(gè)區(qū)間
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
'設(shè)置區(qū)間分界點(diǎn)
r.Break(r.BreakCount - 1) = breakval
End If
breakval = breakval + stats.StdDev
Next i
'使用RampColors方法對(duì)區(qū)間序列漸變填色
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"
'設(shè)置區(qū)間數(shù)量為5
nclasses = 5
'獲取記錄數(shù)
nrecs = layer.Records.Count
r.BreakCount = nclasses - 1
'獲取所有地理對(duì)象的記錄
Set recs = layer.SearchExpression("FeatureID>-1 order by P_OTHER")
'瀏覽記錄并獲取區(qū)間分界點(diǎn)
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
'設(shè)置統(tǒng)計(jì)對(duì)象
Set stats = layer.Records.CalculateStatistics("P_OTHER")
'以字段P_OTHER的標(biāo)準(zhǔn)差為區(qū)間長(zhǎng)度，在P_OTHER字段的平均值附近生成7個(gè)區(qū)間
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改變區(qū)間序列符號(hào)的大小
r.SizeSymbols 3, 8
For i = 0 To r.BreakCount
'將所有區(qū)間顏色變成紅色
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 = "單一符號(hào)"
Command2.Caption = "點(diǎn)密度(DotDensityRenderer)"
Command3.Caption = "值圖(ValueMapRenderer)"
Command4.Caption = "標(biāo)準(zhǔn)差圖(ClassBreakRenderer)"
Command5.Caption = "數(shù)量分類圖(ClassBreakRenderer)"
Command6.Caption = "漸變符號(hào)圖(ClassBreakRenderer)"
Command7.Caption = "文本標(biāo)注圖(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對(duì)象主要屬性
DefaultSymbol屬性: 返回繪制的MapLayer的缺省Symbol對(duì)象的引用
field屬性: 設(shè)置著色所依據(jù)的屬性字段
RotationField屬性：設(shè)置點(diǎn)狀符號(hào)的旋轉(zhuǎn)角度，僅僅對(duì)點(diǎn)對(duì)象且Symbol的Style的屬性為moTrueTypemarker的圖層有效
ScalingField屬性:設(shè)置相對(duì)反打倍數(shù)因子，僅僅對(duì)點(diǎn)對(duì)象且Symbol的Style的屬性為moTrueTypemarker的圖層有效
Symbol屬性: 返回由屬性字段的一系列值所確定的Symbol對(duì)象的集合
SymbolType屬性: 返回要顯示的地理對(duì)象睦嘈?/p>
Tag屬性: 用于填寫描述信息
UseDefault屬性: 設(shè)置是否采用DefaultSymbol
ValueCount屬性: 值序列中值的個(gè)數(shù)
Value序列: 用Field指定的屬性字段所產(chǎn)生的一系列值
ClassBreaksRenderer對(duì)象屬性
RampColors方法: 以漸變色的方法依次設(shè)置各個(gè)級(jí)別的符號(hào)的顏色屬性，RampColors 顏色一，顏色二
SizeSymbol方法: 設(shè)置各個(gè)級(jí)別的符號(hào)對(duì)象的Size屬性，SizeSymbol size1, size2
BreakCount屬性: 區(qū)間分界點(diǎn)的數(shù)量
Break屬性: 由區(qū)間分界點(diǎn)生成的區(qū)間序列
Field , Symbol, SymbolType, Tag同上
DotDensityRenderer對(duì)象屬性
DotColor，DotSize分別設(shè)置點(diǎn)的顏色大小
DotValue屬性: 點(diǎn)的基準(zhǔn)值
DrawBackground屬性: 除了顯示點(diǎn)外還顯示地理對(duì)象
Field , Tag屬性同上
以上三種使用方法一般是:
Dim Xrenderer As MapObjects2.DotDensityRenderer
然后對(duì)各種屬性設(shè)置
Set Map1.Layers("").renderer = renderer