MapObject学习笔记-第三讲 图层标注、图层控制和电子地图常用工具开发(添加经过修正与VS2005兼容的Legend控件下载)

第三讲 图层标注、图层控制和电子地图常用工具开发


一、图层标注

利用MO的标注对象LabelRenderer,可以自动添加图层上对象的标注。

1、属性标注

属性标注的方法为:

Set layer.Renderer = New LabelRenderer '设置标注对象

layer.Renderer.Field = "CNTRY_NAME" '指定要显示的字段

layer.Renderer.AllowDuplicates = True '允许标注重复

标注语句要加在图层添加语句:Map1.Layers.Add layer的前面。

几点说明:

RendererMapLayer的属性之一,用于设置或读取图层的着色对象。

着色对象有ClassBreaksRenderer对象,DotDensityRenderer对象,LabelRenderer对象和ValueMapRenderer对象。

其中,LabelRenderer对象描述一种表示地理特征的方法,即在一个地理特征上写字符。显示在地理特征的字符值来自一个字段的值,Field属性表示该字段的名字。AllowDuplicates属性是一个布尔值,表示是否允许在标注处多次标注同样的字符,True为允许,false为不允许。

2、设置图上字体

以上的标注是按照缺省的方式来设置的字体,还可以利用标注对象的Symbol数组,来自己动手设置更合适的字体属性。

layer.Renderer.Symbol(0).Font.Name = "隶书"

layer.Renderer.Symbol(0).Font.Bold = False

layer.Renderer.Symbol(0).Color = moRed

layer.Renderer.Symbol(0).Font.Size = 20

以上设置的字体是固定大小,不随着图形大小的改变而改变。

layer.Renderer.Symbol(0).Height = 10

这时Height设置有优先设置权,Font.BoldFont.Size将不起作用。

二、图层控制

1、利用check控件控制图层的显示和文字标注

用程序添加图层时,系统会自动设置图层对象的序号,最后添加的为图层0,其上为图层1,依次类推。

Option Explicit

Dim dc As New DataConnection

Dim layer As MapLayer

 

Private Sub Check3_Click()

  Set layer = Map1.Layers(2)

  If Check3.Value = 0 Then

    layer.Visible = False

  Else

    layer.Visible = True

  End If

  Map1.Refresh

End Sub

 

Private Sub Check2_Click()

  Set layer = Map1.Layers(1)

  If Check2.Value = 0 Then

    layer.Visible = False

  Else

    layer.Visible = True

  End If

  Map1.Refresh

End Sub

 

Private Sub Check1_Click()

  Set layer = Map1.Layers(0)

  If Check1.Value = 0 Then

    layer.Visible = False

  Else

    layer.Visible = True

  End If

  Map1.Refresh

End Sub

 

Private Sub Check4_Click()

  Set layer = Map1.Layers(0)

  Set layer.Renderer = New LabelRenderer

  If Check4.Value = 0 Then

    layer.Renderer.AllowDuplicates = False

  Else

    Call Layer0Render(layer)

  End If

  Map1.Refresh

End Sub

 

Private Sub Layer0Render(layer1 As MapLayer) '重复设置LabelRenderer对象的过程

  Set layer1.Renderer = New LabelRenderer

  layer1.Renderer.Field = "NAME"      '指定要显示的字段

  'layer1.Renderer.Symbol(0).Font.Name = "Times New Roman"

  layer1.Renderer.Symbol(0).Font.Bold = False     '缺省为True

  layer1.Renderer.Symbol(0).Color = moBlack

  layer1.Renderer.Symbol(0).Font.Size = 8

  layer1.Renderer.AllowDuplicates = True

End Sub

 

Private Sub LayerSet()

  Set layer = New MapLayer

  Set layer.GeoDataset = dc.FindGeoDataset("states")

  layer.Symbol.Color = moYellow

  layer.Symbol.Size = 1

  'layer.Symbol.Style = 2

  layer.Symbol.OutlineColor = moBrown

  Map1.Layers.Add layer

 

  Set layer = New MapLayer

  Set layer.GeoDataset = dc.FindGeoDataset("roads")

  layer.Symbol.Color = moDarkGreen

  layer.Symbol.Size = 2

  Map1.Layers.Add layer

 

  Set layer = New MapLayer

  Set layer.GeoDataset = dc.FindGeoDataset("Cities")

  layer.Symbol.Color = moRed

  layer.Symbol.Size = 4

  layer.Symbol.Style = 0

  Call Layer0Render(layer)

  Map1.Layers.Add layer

End Sub

 

Private Sub Form_Load()

  dc.Database = "F:\MO实验\USA"

  If Not dc.Connect Then

    MsgBox "在指定的文件夹下没找到图层数据文件!"

    End

  End If

  LayerSet

  Map1.Refresh

End Sub

几点说明:

Layers对象的属性只有一个,即count。这个值表示Layers集合当前具有多少个图层,如果这个值为-1,说明图层不确定。

Call 语句,将控制权转移到一个 Sub 过程,Function 过程。如:Call Layer0Render(layer),调用Layer0Render(layer)过程。

2、使用Legend控件

使用Legend组件,可以调用图层控制功能。添加Legend控件后Form_Load过程中写入:legend1.setMapSource Map1legend1.LoadLegend True,再添加AfterSetLayerVisible过程,Map1.Refresh,可以在取消和添加图层后刷新。

运行程序后,可以看见Legend控件不仅可以自动标上图层名称,而且可以上下拖动,改变加载的顺序。加上legend1.EnableDragDrop = False可以取消图层拖动的功能,还可以在Legend控件的属性框中设置字体,backcolorforecolor等。另外在Legend上不能控制图层的标注,但可以多加载一个显示标注的图层的迂回方法,就可以实现控制图层标注的目的。示例代码如下:

Option Explicit

Dim dc As New DataConnection

Dim layer As MapLayer

 

Private Sub legend1_AfterSetLayerVisible(index As Integer, isVisible As Boolean)

  Map1.Refresh

End Sub

 

Private Sub LayerSet()

  Set layer = New MapLayer

  Set layer.GeoDataset = dc.FindGeoDataset("区县")

  layer.Symbol.Color = moOrange

  layer.Symbol.Size = 1

  layer.Symbol.Style = 9

  layer.Symbol.OutlineColor = moBrown

  layer.Name = "行政区"

  Map1.Layers.Add layer

 

  Set layer = New MapLayer

  Set layer.GeoDataset = dc.FindGeoDataset("河流1")

  layer.Symbol.Color = moDarkGreen

  layer.Symbol.Size = 2

  layer.Name = "河流"

  Map1.Layers.Add layer

 

  Set layer = New MapLayer

  Set layer.GeoDataset = dc.FindGeoDataset("测站")

  layer.Symbol.Color = moRed

  layer.Symbol.Size = 3

  layer.Symbol.Style = 0

  layer.Name = "测站"

 

  Set layer.Renderer = New LabelRenderer

  layer.Renderer.Field = "NAME"      '指定要显示的字段

  'layer.Renderer.Symbol(0).Font.Name = "幼圆"

  'layer.Renderer.Symbol(0).Font.Bold = False     '缺省为True

  layer.Renderer.Symbol(0).Color = moBlack

  layer.Renderer.Symbol(0).Font.Size = 8

  layer.Renderer.AllowDuplicates = True

  Map1.Layers.Add layer

End Sub

 

Private Sub Form_Load()

  dc.Database = App.Path + "\..\" + "beijing"

  If Not dc.Connect Then

    MsgBox "在指定的文件夹下没找到图层数据文件!"

    End

  End If

  LayerSet

 

  legend1.setMapSource Map1

  legend1.LoadLegend True

  Map1.Refresh

End Sub

三、电子地图常用工具开发

电子地图常用工具开发和方法包括指示图(locator map)、比例尺(scalebar)和状态栏(statusbar)、打印功能的设置、鼠标提示(tip text)的设置以及查看属性设置等。

1、使用指示图(即鹰眼功能)之添加指示窗口

一般电子地图系统在主窗口的附近有一个指示图,指示图用显著颜色的方框显示目前主窗口在全图的位置,并可以拖动方框或其他方式,在全图中迅速定位。

 

示例代码如下:

Option Explicit

Dim dc As New DataConnection

Dim layer As MapLayer

 

Private Sub Form_Load()

  dc.Database = App.Path + "\..\" + "world"

  Set layer = New MapLayer

  Set layer.GeoDataset = dc.FindGeoDataset("country")

  layer.Symbol.Color = moYellow

  layer.Symbol.Size = 1

  'layer.Symbol.Style = 2

  layer.Symbol.OutlineColor = moBrown

  Map1.Layers.Add layer

  Set layer = New MapLayer

  Set layer.GeoDataset = dc.FindGeoDataset("Cities")

  layer.Symbol.Color = moRed

  layer.Symbol.Size = 4

  layer.Symbol.Style = 0

  Map1.Layers.Add layer

  Set layer = New MapLayer

  Set layer.GeoDataset = dc.FindGeoDataset("country")

  layer.Symbol.Color = moPaleYellow

  Map2.Layers.Add layer

  Map2.Refresh

End Sub

'使Map1Map2联动,利用AfterLayerDraw事件函数来实现,此方法表示当Map1画完开始执行的事件代码。

Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hDC As stdole.OLE_HANDLE)

If index = 1 Then     '代表加载的图层索引号

Map2.TrackingLayer.Refresh True  ' TrackingLayer对象是Map控件中的一个特殊层,它描绘位置可以动态改变的地理目标。Refresh是其的一个函数,用来强制刷新新的TrackingLayer对象,此值是一个布尔值。

End If

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

 

'Map2上画红色指示框。此处使用Map控件的AfterTrackingLayerDraw事件,表示当控件完成所有TrackingLayer的地理图层对象的更新后自动进入的函数代码。

Private Sub Map2_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)

Dim sym As New Symbol

sym.OutlineColor = moRed

sym.Size = 2

sym.Style = moTransparentFill

Map2.DrawShape Map1.Extent, sym  '在图上画图形特征,这个函数只是在图形刷新事件中调用(例如AfterTrackingLayerDrawAfterLayerDraw),语法为object.DrawShape shape, symbol),shape表示一个几何形状或图形特征选集(Point, Points, Line, Rectangle, Polygon or Ellipse)symbol表示一个符号对象变量。

 

End Sub

 

 

 

 

经过修正与VS2005兼容的Legend控件下载

经过修正与VS2005兼容的Legend控件下载

posted on 2007-05-22 16:35  GIS云中飞鹏  阅读(5452)  评论(54编辑  收藏  举报

导航