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

几点说明:

1Rectangle对象描述矩形的特征,即具有四条边和四个直角的几何形状。

2Point对象表示一个点的地理形状,可以通过PointX, Y属性修改得到它的地理位置坐标值。

3Map控件的几个用到的成员函数:CenterAt将当前的显示范围中心移动到指定的中心,语法为object.CenterAt x, yToMapPoint是将点的位置从以屏幕坐标表示转换为以地图坐标表示,语法为Set variable = object.ToMapPoint( xControl, yControl)

2、在指示窗口中拖动方框

要实现在指示窗口中拖动方框的功能,程序非常复杂,但是MO中提供了类模块DragFeedback,只要在工程中添加类模块DragFeedback就可以了。其中类模块DragFeedbackMO安装不全的情况下是不存在的,可以在程序中加入。

示例代码见附录。

、属性显示

在电子地图系统中,常常要查询地图上对象的属性,这时就需要属性显示的程序设计方法了。

1、显示一个区的属性

添加控件Map1ListView1,并且设置ListView1View属性为3。并添加如下代码实现区域属性的显示。

Option Explicit

Dim p As Point

Dim recs As Recordset

Dim fld As Field

Dim l As MapLayer

Private Sub Form_Load()

  ' 初始化ListView1ColumnHeaders属性

  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")

  ' ToMapPointMap控件的成员函数之一,表示将点的位置从以屏幕坐标转换为以地图坐标系坐标表示,语法为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, "") 

  ' EOFRecordset对象的属性,表示当前记录是否是记录集中的最后一个记录。

  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, landscapedocName为在打印序列中的名称;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

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值