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 + "\..\" + "Mexico"

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