mapobject学习

1、下载安装mapobject2，并破解

2、实例及代码

2.1添加控件

在窗体上添加两个map控件，一个legend控件，一个commondialog控件

2.2在map1控件显示地图（*.shp）

Private Sub Command1_Click()
Dim dc As New DataConnection
Dim gs As GeoDataset
Dim name As String
Dim layer As MapObjects2.MapLayer
CommonDialog1.Filter = “ESRI ShapeFiles(.shp)|.shp”
CommonDialog1.ShowOpen
If Len(CommonDialog1.FileName) = 0 Then Exit Sub
dc.Database = CurDir
If Not dc.Connect Then Exit Sub
name = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4)
Set gs = dc.FindGeoDataset(name)
If gs Is Nothing Then Exit Sub
Set layer = New MapLayer
layer.GeoDataset = gs
Map1.Layers.Add layer
Map2.Layers.Add layer

legend1.setMapSource Map1**'legend控件显示加载的地图**
legend1.LoadLegend True
legend1.ShowAllLegend
legend1.Active(0) = True
End Sub

2.3 通过legend实现图层的显示与隐藏

Private Sub legend1_AfterSetLayerVisible(Index As Integer, isVisible As Boolean) '实现图层的隐藏
Map1.Refresh
Map2.Refresh
End Sub

Private Sub legend1_RenderClick(LayerIndex As Integer, BreakIndex As Integer, val1 As Variant, val2 As Variant)
Map1.Refresh
Map2.Refresh
End Sub

2.4 map控件的矩形响应

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim kuang As New MapObjects2.Rectangle
Dim pt As New MapObjects2.Point
Set kuang = Map1.TrackRectangle
Set pt = Map1.ToMapPoint(X, Y)
Map1.CenterAt pt.X, pt.Y
End Sub

Private Sub Map2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim kuang As New MapObjects2.Rectangle
Dim pt As New MapObjects2.Point
Set kuang = Map2.TrackRectangle
Set Map1.Extent = kuang '设置map1的范围为kuang的范围
Set pt = Map2.ToMapPoint(X, Y) '将屏幕坐标转换为地图坐标
Map1.CenterAt pt.X, pt.Y '将地图中心移动到鼠标位置
End Sub

2.5 画点

2、画点

（1）预定义画点：可以用Point对象画一个点，也可以用Points对象画多个点。示例：

Dim sym As New MapObjects2.Symbol

Dim p As Point

Dim pts As Points

Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)

Set pts = New Points

Set p = Map1.ToMapPoint(1000, 1000)

pts.Add p’是Points对象中的一个函数，功能是增加一个Point成员到Points对象内。

Set p = Map1.ToMapPoint(3000, 2000)

pts.Add p

sym.Color = moRed

sym.SymbolType = moPointSymbol

sym.Size = 3

Map1.DrawShape pts, sym

End Sub

（2）利用鼠标点击画点：通过鼠标点击屏幕获取点的坐标，进行画点操作。示例：

Dim sym As New MapObjects2.Symbol

Dim p As Point

Dim pts As New Points

Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)

If Not pts Is Nothing Then

sym.Color = moRed

sym.SymbolType = moPointSymbol

sym.Size = 3

Map1.DrawShape pts, sym

Map1.DrawShape pts, sym

End If

End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Set p = Map1.ToMapPoint(X, Y)

pts.Add p

Map1.TrackingLayer.Refresh True’ TrackingLayer对象是MAP控件中的一个图层，它描述位置可以动态改变的地理目标，Refresh是TrackingLayer对象的成员函数，强制刷新TrackingLayer对象。

End Sub

2.6 画线

MO中画线的基本原理是先设置两个点，将他们添加到一个Points对象中，再将Points对象放到一个Line对象中，使用DrawShape方法就可以画出一条线段来。如果在Points对象中有N个点，则可以产生一条N-1段的折线。

（1）预定义点画线，示例：

Dim g_line As MapObjects2.Line

Dim pts As Points

Dim p As Point

Dim sym As Symbol

Private Sub Command1_Click()

Set g_line = New MapObjects2.Line

Set pts = New Points

Set p = Map1.ToMapPoint(1000, 1000)

pts.Add p

Set p = Map1.ToMapPoint(2000, 3000)

pts.Add p

g_line.Parts.Add pts 'Parts是Line对象的一个属性，此属性指向一个Parts集合对象，通过Parts属性可以检索组成线的片断（Parts），而Parts的每一个成员是一个点集（Points）。

Set pts = g_line.Parts(0)

Map1.Refresh

End Sub

Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)

If Not g_line Is Nothing Then

Dim sym As New Symbol

If pts.Count > 1 Then’ Count属性表示当前Points对象内成员的数目，这是一个只读值。

sym.Color = moRed

sym.SymbolType = moLineSymbol

sym.Size = 5

Map1.DrawShape g_line, sym

End If

End If

End Sub

2.6 创建一个图层（shp）文件

Private Sub Command5_Click()
Dim dc As New DataConnection
Dim layer As New MapLayer
Dim tb As New TableDesc
Dim rs As Recordset
Dim w As Double
Dim h As Double
Dim pt As New Point
Dim t As Date
dc.Database = CurDir
If Not dc.Connect Then Exit Sub
Set layer.GeoDataset = dc.AddGeoDataset(“TestSpeed”, moShapeTypePoint, tb)
If Not layer.Valid Then Exit Sub
Map1.Layers.Add layer
Set rs = layer.Records
Randomize
h = Map1.Extent.Height
w = Map1.Extent.Width
Debug.Print h, w
'rs.AutoFlush = False '注释后添加效率就会非常低
t = Now
For i = 1 To 1000
pt.Set Rnd * w, Rnd * h
rs.AddNew
rs.Fields(“Shape”).Value = pt
rs.Update
Text1.Text = “当前位置：” & i
DoEvents
Next
rs.StopEditing
Map1.Refresh
Text2.Text = “总计耗时（秒）：” & DateDiff(“s”, t, Now)

'Map1.ExportMap moExportClipboardBMP, CurDir + “\Test.bmp”, 1#
End Sub

通过下面代码获取上面添加点的坐标
dim pt as point
Set pt = recs.Fields.Item(“shape”).Value
Debug.Print pt.X, pt.Y