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