MapObject学习笔记－第四讲电子地图常用工具开发
第四讲电子地图常用工具开发
一、使用指示图
1、在指示窗口中改变主窗口大小
使用如下示例代码，可以在小窗口中点击移动大窗口位置，还可以画方框改变大窗口的大小。
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
Set pt = Map2.ToMapPoint(X, Y)
Map1.CenterAt pt.X, pt.Y
End Sub
几点说明：
（1）Rectangle对象描述矩形的特征，即具有四条边和四个直角的几何形状。
（2）Point对象表示一个点的地理形状，可以通过Point的X, Y属性修改得到它的地理位置坐标值。
（3）Map控件的几个用到的成员函数：CenterAt将当前的显示范围中心移动到指定的中心，语法为object.CenterAt x, y；ToMapPoint是将点的位置从以屏幕坐标表示转换为以地图坐标表示，语法为Set variable = object.ToMapPoint( xControl, yControl)。
2、在指示窗口中拖动方框
要实现在指示窗口中拖动方框的功能，程序非常复杂，但是MO中提供了类模块DragFeedback，只要在工程中添加类模块DragFeedback就可以了。其中类模块DragFeedback在MO安装不全的情况下是不存在的，可以在程序中加入。
示例代码见附录。
二、属性显示
在电子地图系统中，常常要查询地图上对象的属性，这时就需要属性显示的程序设计方法了。
1、显示一个区的属性
添加控件Map1和ListView1，并且设置ListView1的View属性为3。并添加如下代码实现区域属性的显示。
Option Explicit
Dim p As Point
Dim recs As Recordset
Dim fld As Field
Dim l As MapLayer
Private Sub Form_Load()
' 初始化ListView1的ColumnHeaders属性
Set col = ListView1.ColumnHeaders.Add()
col.Text = "Field"
Set col = ListView1.ColumnHeaders.Add()
col.Text = "Value"
' 加载地图数据
Dim dc As New DataConnection
dc.Database = App.Path + "\..\" + "world"
If Not dc.Connect Then End
Dim layer As MapLayer
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("country")
layer.Symbol.Color = 4636724
Map1.Layers.Add layer
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
' 获得地图对象，"country"即为Layers对象counts属性的名称，也可以以索引号代替
Dim newitem As Object
Set l = Map1.Layers("country")
' ToMapPoint是Map控件的成员函数之一，表示将点的位置从以屏幕坐标转换为以地图坐标系坐标表示，语法为Set variable = object.ToMapPoint( xControl, yControl)，variable是以地图坐标系表示的点位置，xControl, yControl是屏幕坐标的值。
Set p = Map1.ToMapPoint(x, y)
' 建立一个Recordset查找，语法为Set variable = object.SearchShape( shape, searchMethod, expression )；该函数是MapLayer对象的一个函数，返回值是图层地理特征的子集，即Recordset对象。Expression为逻辑条件表达式，一般为空。
Set recs = l.SearchShape(p, moPointInPolygon, "")
' EOF是Recordset对象的属性，表示当前记录是否是记录集中的最后一个记录。
If Not recs.EOF Then
ListView1.ListItems.Clear
'Fields属性记录集中包含了Fields对象的地址指针，而Fields对象存储所有Recordset对象的所有字段。
For Each fld In recs.Fields
'Field对象表示数据库中的一列数据，包括一般的数据类型和一系列属性值，Name是其的一个属性，表示字段名。
Set newItem = ListView1.ListItems.Add
newItem.Text = fld.Name
' 是Field对象的一个属性，是一个字符串，表示将当前记录的字段值转换字符串后的值。
newItem.SubItems(1) = fld.ValueAsString
Next fld
End If
End Sub
2、显示所有对象的属性
在电子地图系统中，对地理实体进行查询，点击一个位置，往往包含多个对象，如一个城市可能在一条河流上，而同时又位于一个地区内。程序可以用一个combo控件来区分不同的对象。程序比较复杂，这里只给出大家示例代码，在实际的电子地图系统设计过程中，可以直接引用。示例代码见附录。
三、其他电子地图常用工具
1、地图比例尺工具scalebar
scalebar控件可以动态显示地图的比例，还可以把鼠标的移动坐标写到statusbar上。一般对比例尺控件进行设置为：mapunits=2,minticspace=0.4,scalebarunits=2,screenunits=1，为了有效的显示比例信息，scalebar控件的宽度属性最少为1700，高度属性为600。
示例代码为：
Private Sub refreshscale()
ScaleBar1.MapExtent.MaxX = Map1.Extent.Right
ScaleBar1.MapExtent.MinX = Map1.Extent.Left
ScaleBar1.MapExtent.MaxY = Map1.Extent.Bottom
ScaleBar1.MapExtent.MinY = Map1.Extent.Top
ScaleBar1.PageExtent.MinX = Map1.Left / Screen.TwipsPerPixelX
ScaleBar1.PageExtent.MinY = Map1.Top / Screen.TwipsPerPixelY
ScaleBar1.PageExtent.MaxX = (Map1.Left + Map1.Width) / Screen.TwipsPerPixelX
ScaleBar1.PageExtent.MaxY = (Map1.Top + Map1.Height) / Screen.TwipsPerPixelY
ScaleBar1.Refresh
End Sub
2、状态栏StatusBar
添加一个状态栏，可以把鼠标的移动位置，比例信息以及其他的一些信息写到状态栏上。示例程序中添加一个状态栏控件并设置几个窗格，一个地图控件，一个命令按钮，一个Legend控件。示例代码如下：
Dim dc As New DataConnection
Dim layer As MapLayer
Private Sub refreshscale()
ScaleBar1.MapExtent.MaxX = Map1.Extent.Right
ScaleBar1.MapExtent.MinX = Map1.Extent.Left
ScaleBar1.MapExtent.MaxY = Map1.Extent.Bottom
ScaleBar1.MapExtent.MinY = Map1.Extent.Top
ScaleBar1.PageExtent.MinX = Map1.Left / Screen.TwipsPerPixelX
ScaleBar1.PageExtent.MinY = Map1.Top / Screen.TwipsPerPixelY
ScaleBar1.PageExtent.MaxX = (Map1.Left + Map1.Width) / Screen.TwipsPerPixelX
ScaleBar1.PageExtent.MaxY = (Map1.Top + Map1.Height) / Screen.TwipsPerPixelY
ScaleBar1.Refresh
StatusBar1.Panels(1).Text = "比例 1：" & Format$(ScaleBar1.RFScale, "###,###,###,###")
End Sub
Private Sub Command1_Click()
Set Map1.Extent = Map1.FullExtent
End Sub
Private Sub Form_Load()
dc.Database = App.Path + "\..\" + "world"
layset
legend1.setMapSource Map1
legend1.LoadLegend True
Map1.Refresh
End Sub
Private Sub legend1_AfterSetLayerVisible(Index As Integer, isVisible As Boolean)
Map1.Refresh
End Sub
Private Sub Map1_AfterLayerDraw(ByVal Index As Integer, ByVal canceled As Boolean, ByVal hDC As stdole.OLE_HANDLE)
Call refreshscale
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Set Map1.Extent = Map1.TrackRectangle
ElseIf Button = vbRightButton Then
Map1.Pan
End If
End Sub
Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim pt As New Point
Set pt = Map1.ToMapPoint(X, Y)
StatusBar1.Panels(2).Text = "x=" & pt.X
StatusBar1.Panels(3).Text = "y=" & pt.Y
End Sub
Private Sub layset()
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("country")
layer.Symbol.Color = moOrange
layer.Name = "国家"
Map1.Layers.Add layer
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("rivers")
layer.Symbol.Color = moDarkGreen
layer.Symbol.Size = 2
layer.Name = "河流"
Map1.Layers.Add layer
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("cities")
layer.Symbol.Color = moBlue
layer.Symbol.Size = 4
layer.Name = "城市"
Map1.Layers.Add layer
Map1.Refresh
End Sub
3、地图打印
在MO上实现地图打印的功能非常简单，只要用printmap方法，不需要做太多的设置即可。printmap方法的语法为：object.PrintMap docName, outputFile, landscape，docName为在打印序列中的名称；outputFile为输出文件名；landscape为打印方向，true为横向打印，false为纵向打印。示例程序代码为：
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim r As MapObjects2.Rectangle
If Button = vbLeftButton Then
Set Map1.Extent = Map1.TrackRectangle
ElseIf Button = vbRightButton Then
Set r = Map1.Extent
r.ScaleRectangle 2
Map1.Extent = r
End If
End Sub
Private Sub Command1_Click()
On Error GoTo err1
'Map1.PrintMap "MyMap", "test1", Option1.Value
Map1.PrintMap "MyMap", "", Option1.Value
MsgBox "打印完成。"
Exit Sub
err1:
MsgBox Err.Description + "，程序停止。"
Unload Me
End Sub
Private Sub Command2_Click()
On Error GoTo err1
Printer.Print
Map1.OutputMap Printer.hdc
Printer.EndDoc
MsgBox "打印完成。"
Exit Sub
err1:
MsgBox Err.Description + "，程序停止。"
Unload Me
End Sub
Sub DrawLayer()
Dim dc As New DataConnection
Dim layer As MapLayer
dc.Database = App.Path + "\..\" + "
If Not dc.Connect Then
MsgBox "在指定的文件夹下没找到图层数据文件！"
End
End If
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("States")
layer.Symbol.Color = moYellow
Map1.Layers.Add layer
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("Rivers")
layer.Symbol.Color = moRed
Map1.Layers.Add layer
Map1.Refresh
Set layer = New MapLayer
Set layer.GeoDataset = dc.FindGeoDataset("Cities")
layer.Symbol.Color = moBlue
Map1.Layers.Add layer
End Sub
Private Sub Form_Load()
DrawLayer
Label1.Caption = "你使用的打印机是：" & Printer.DeviceName
End Sub
