第3章 图层的基本功能开发

3.1 用程序加裁图层文件

加载的图层如果基本固定，一般放在Form_Load过程中。也可以动态加载或卸载图层，这时要在其它过程或函数中进行。

3.1.1在同一个文件夹下加载

如果你的程序和GIS图层文件（dbf、shp、shx等）在一个文件夹，图层为Mexico文件夹下的States和Rivers，加载程序如下：

（工程Chapter302一Form01）

Option Explicit

Private Sub Form_Load()

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\") Map1.Layers.Add layer

Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"Rivers\") Map1.Layers.Add layer

Map1.Refresh End Sub

加载图层后，要用Map1.Refresh进行刷新后一样显示。

3.1.2 在不同文件夹中加载

由于在实际的应用程序中，图层文件和程序文件都很多，为了方便管理，一般程序文件和图层文件不放在一个文件夹，推荐采用一个文件夹(如DATA)单独存放图层文件，而把各个程序文件和它并列放置。

例如应用程序文件夹路径为“D:\\MO”，程序在“D:\\MO\\VB1”文件夹下，图层文件放在“D:\\MO\\Mexico”文件夹下，这时要用+”\\..\\”返回上级文件夹； （工程Chapter301一Form02） Option Explicit

Private Sub Form_Load()

Dim dc As New DataConnection Dim layer As MapLayer

9

dc.Database = App.Path + \"\\..\\\" + \"Mexico\" If Not dc.Connect Then

MsgBox \"在指定的文件夹下没找到图层数据文件！\" End End If

Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"States\") Map1.Layers.Add layer Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"Rivers\") Map1.Layers.Add layer Map1.Refresh

End Sub

如果你的图层文件夹要向上返回2级，可以用以下2级返回语句： dc.Database = App.Path + \"\\..\\..\\\" + \"Mexico\"

3.1.3 图层的卸载和移动

用语句：

Map1.Layers.Remorve O

可以把第O层卸载。注意：卸载了一个图层后，其它图层的序号就发生了变化。

用语句：

Map1.Layers.Clear

可以一次卸载所有的图层。

可以用MoveTo方法来把图层从位置l移动到位置2，如原来图层cities在第2层，用以下语句可以把它移动到第0层：

Map1.Layers.MoveTo 2,0

3.1.4图层的选择和隐藏

用图层的索引号：

Set layer = Map1.Layers (0) 或图层名称：

Set layer = Map1.Layers (“States”) 来选择当前图层。

用语句：

layer.Visible = False 来隐藏当前的图层。

另外，还可以通过设置Mapl.Visible来隐藏或显示整个Map控件。

以下是一个完整的例子。其在Form上放置一个Map控件和6个Command控件，程序为如下。 （工程Chapter301一Form02） Option Explicit

Dim dc As New DataConnection Dim layer As MapLayer

Private Sub Command1_Click() „图层加载

10

LayerSet

Map1.Refresh End Sub

Private Sub Command2_Click() „图层卸载 Map1.Layers.Clear '清除Map1的所有图层。 End Sub

Private Sub Command3_Click() „图层0不可见

On Error GoTo err1 '如果Map1已经被清除，不进行操作。Set layer = Map1.Layers(0) layer.Visible = False Map1.Refresh Exit Sub

err1:

MsgBox \"没有图层！\"

End Sub

Private Sub Command4_Click() „图层0可见

On Error GoTo err1 '如果Map1已经被清除，不进行操作。Set layer = Map1.Layers(0) layer.Visible = True Map1.Refresh Exit Sub err1:

MsgBox \"没有图层！\" End Sub

Private Sub Command5_Click() „隐藏地图 Map1.Visible = False

End Sub

Private Sub Command6_Click() „显示地图 Map1.Visible = True

End Sub

Private Sub LayerSet() '图层设置模块

Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"States\") Map1.Layers.Add layer Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"Rivers\") Map1.Layers.Add layer End Sub

11

Private Sub Form_Load() dc.Database = App.Path

If Not dc.Connect Then

MsgBox \"在指定的文件夹下没找到图层数据文件！\" End End If

LayerSet Map1.Refresh

End Sub

程序界面如图3.1所示。

图3.1 图层隐藏示例

3.2 图层基本属性设置

面状图层基本属性包括图层颜色、区域界线宽度、区域界线样式、区域界线颜色等，线状图层的属性包括线宽度、线样式、线颜色等，点状图层属性包括点大小、点样式、点颜色等，另外，还有属性的标注等。

3.2.1设置图层颜色

调试前面的程序时，你会发现图层的颜色是随机出现的。设置Symbol对象的color属性，可以很容易地设置固定的图层颜色。 P16

（工程Chapter302－Form02） Set layer = New MapLayer

12

Set layer.GeoDataset = dc.FindGeoDataset(\"Rivers\")

layer.Symbol.Color = moRed „设本图层（河流）为红色

Map1.Layers.Add layer

其中moRed是MO的内设常数

MO中常用的颜色有moBlack、moRed、moGreen、moBlue、moMagenta、moCyan、moWhite、moLingtGray、moDarkGray、moGray、moPlaneYellow、moLigntYellow、moYellow、moLimeGreen、moTeal、moDarkGreen、moMaroon、moPurple、moOrange、moKhaki、moOlive、moBrown、moNavy等23个常数

也可以使用VB的颜色设置和RGB颜色设置，具体方法见附录C。

3.2.2 设置区域界线

当图层为面状图层时，用layer.Symbol.Size可以设置区域界线的宽度，layer.Symbol.Size = 1是较细的线型，layer.Symbol.Size = 2是较粗的线型。

还可以用layer.Symbol.Color设置区域界线的颜色，用layer.Symbol.Style设置线的样式，具体填充方式，具体方法参见附录D。

3.2.3设置线属性

当图层为线状图层时，用layer.Symbol.Size可以设置线的宽度，layer.Symbol.Size=1是较细的线型，layer.Symbol.Size =2是较粗的线型。

还可以用layer.Symbol.Color设置线的颜色，用layer.Symbol.Style设置线的样式，具体方法参见附录D。

3.2.4设置点属性

当图层为点状图层时,用layer.Symbol.Size可以设置点的大小，一般用3~6，3是较小的点，6是较大的点。

还可以用layer.Symbol.Color设置点的颜色，用layer.Symbol.Style设置点的样式，具体方法参见附录D。

3.2.5 属性设置的综合示例

下面例子为加载墨西哥地图的州（States）、河流（Rivers）和城市（Cities）3种不同的图层，再用不同的颜色和样式来设置。

（工程Chapter302一Form03） Option Explicit

Private Sub Form_Load()

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

13

layer.Symbol.Color = moOrange 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(\"Rivers\") layer.Symbol.Color = moDarkGreen layer.Symbol.Size = 2

layer.Symbol.Style = 1 '虚线 Map1.Layers.Add layer

Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"Cities\") layer.Symbol.Color = moRed layer.Symbol.Size = 5

layer.Symbol.Style = 2 '三角形符号 Map1.Layers.Add layer Map1.Refresh End Sub

其运行界面如图3.2所示。

图3.2 图层设置结果

14

3.3图层标注

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

3.3.1 属性标注

属性标注方法为：

Set Layer.Renderer=New LabelRenderer ‘设置标注对象 Layer.Renderer.Field=”Name” ‘指定要显示的字段 Layer.Renderer.AllowDuplicates=True ‘允许标注重复 其中”Name”是保存标注名称的字段。 标注语句要在图层添加语句： Map1.Layers.Add layer 的前面。

3.3.2设置图上字体

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

（工程Chapter302一Form04）

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

以上设置的字体是固定大小，不随着图形大小的改变而改变。也可以用以下方法设置字体的高度，使之随着图形的大小改变：

layer.Renderer.Symbol(0).Height = 5000 ‘设置高度 这时Height设置有优先权，Font.Size和Font.Bold设置不起作用。

3.4 图层控制

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

在使用时，往往要打开或关闭一些图层，这可以用Check控件来实现。但在图层较多时，利用Check控件来编写比较麻烦，可以利用MO提供的图层控制控件建立一个Legend，减少很多编程的工作量。

Legend英文原意是图例，但其主要作用是数字地图的控制面板，故以下我们还是用英文名表示。

3.4.1 使用Check控件控制图层的显示

在Form上添加Check1控件控制图层的显示 Check1.Caption=”城市”

Check1.Value=1 „（选中状态） 对图层0的控制程序：

15

Private Sub Check1_Click() Set layer=Map1.Layers(0) If Check1.Value=0 Then layer.Visible = False Else

Layer.Visible = True End If End Sub

3.4.2 作用Check控件控制图层的文字标注

用以上的方法，一个图层和它的文字标注在一起，只能同时被显示或隐藏。

在需要单独隐藏文字或图形时，可以用2个Check控件来控制它们，再用一个过程来重复调用设置Labe1Renderer对象的许多语句。以下是一个包含4个Check控件的程序，分别控制州界、河流、城市和城市名称。

在Form上添加1个Map1控件和4个Check控件，设置如下： Check1.Caption=”城市”

Check1.value=1 „（选中状态） Check2.Caption=”河流”

Check2.value=1 „（选中状态） Check3.Caption=”州界”

Check3.value=1 „（选中状态） Check4.Caption=”城市名称”

Check4.value=1 „（选中状态） 全部程序如下。

（工程Chapter302一Form05） Option Explicit

Dim dc As New DataConnection Dim layer As MapLayer

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 Check2_Click() Set layer = Map1.Layers(1) If Check2.Value = 0 Then layer.Visible = False Else

16

layer.Visible = True End If

Map1.Refresh End Sub

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 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) „重复设置Layer1Renderer对象的过程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

17

Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"Rivers\") 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 = App.Path + \"\\..\\\" + \"Mexico\"

If Not dc.Connect Then

MsgBox \"在指定的文件夹下没找到图层数据文件！\" End End If LayerSet

Map1.Refresh End Sub

程序的界面如图3.3所示。

图3.3 使用Check控件控制图层的显示

18

3.4.3 使用Legend控件

使用Legend组件，可以调用图层控制功能。

在［部件］中选择ArcExplore Legend组件，添加一个legend1控件。程序如下： （工程Chapter302一Form06） 在Form_Load中写入： legend1.setMapSource Map1

legend1.LoadLegend True

再添加legend1_AfterSetLayerVisible过程，可以在取消和添加图层后刷新： Private Sub legend1_AfterSetLayerVisible(index As Integer, isVisible As Boolean) Map1.Refresh

End Sub

运行程序，效果如图3.4所示。可以看见，Legend控件不仅可以自动标上图层名称，而且可以上下拖动，改变加载的顺序。

但有时你会担心用户上下拖动，给图层造成混乱，可以这样取消图层拖动的功能：

legend1.EnableDragDrop=False

还可以在Legend控件的属性框中设置Font(字体)、BackColor、ForeColor等。

3.4.4 在Legend上显示中文图层名

由于Legend控件的图层名称是自动加上的，所以一般不能显示图层的中文名称。要在Legend上显示中文名称，有以下2种方法：

(1)把所有图层文件改为中文，如把所有“Rivers”开头的文件全部变为“河流”。 (2)程序设定：

Set layer = Map1.Layers(1) layer.Name = “河流”

3.4.5在Legend上控制图层的标注

在Legend上不能控制图层的标注，但可以采用多加载一个显示标注的图层的迂回方法，就可以实现控制图层标注的目的。程序如下：

（工程Chapter302一Form07）

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(\"States\") layer.Symbol.Color = moYellow layer.Symbol.Size = 1

layer.Symbol.Style = 2

layer.Symbol.OutlineColor = moBrown

19

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.Name = \"城市名称\" layer.Symbol.Size = 0

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

Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"Cities\") layer.Symbol.Color = moRed layer.Symbol.Size = 3 layer.Symbol.Style = 0 layer.Name = \"城市\" Map1.Layers.Add layer End Sub

Private Sub Form_Load()

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

If Not dc.Connect Then

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

End If

LayerSet „调用设置图层过程

legend1.setMapSource Map1 legend1.LoadLegend True Map1.Refresh End Sub

20

3.4.6 MO图层基本功能开发的综合示例

在Form上添加Map1、ToolBar1、Imagelist1、Legend1、Command1、Command2，如图3.4放置和设置，全部程序如下：

（工程Chapter302一Form08）

Option Explicit

Dim dc As New DataConnection Dim layer As MapLayer Dim r As MapObjects2.Rectangle

Private Sub Command1_Click() End End Sub

Private Sub Command3_Click()

Dim Bs As String

Bs = \"选择工具栏，可以实现放大、缩小、移动和还原的功能。\" & vbCrLf & _ \"点击左边的图例控制面板，可以打开和关闭图层。\" & vbCrLf & vbCrLf & \"Xue Wei,2003/5/3\" MsgBox Bs, , \"墨西哥地图浏览系统帮助\" End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Toolbar1.Buttons(1).Value = 1 Then

Set Map1.Extent = Map1.TrackRectangle ElseIf Toolbar1.Buttons(3).Value = 1 Then Map1.Pan

ElseIf Toolbar1.Buttons(2).Value = 1 Then Set r = Map1.Extent r.ScaleRectangle 1.5 Map1.Extent = r End If End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) If Toolbar1.Buttons(1).Value = 1 Then Map1.MousePointer = moZoomIn ElseIf Toolbar1.Buttons(3).Value = 1 Then Map1.MousePointer = moPan ElseIf Toolbar1.Buttons(2).Value = 1 Then Map1.MousePointer = moZoomOut ElseIf Toolbar1.Buttons(4).Value = 1 Then Set Map1.Extent = Map1.FullExtent Map1.MousePointer = moDefault End If End Sub

21

Private Sub legend1_AfterSetLayerVisible(index As Integer, isVisible As Boolean) Map1.Refresh End Sub

Private Sub LayerSet() Dim Sline As Object

Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"States\") layer.Symbol.Color = moYellow

layer.Symbol.SymbolType = moLineSymbol layer.Symbol.Size = 1

layer.Symbol.OutlineColor = moBrown layer.Name = \"行政区\" Map1.Layers.Add layer

Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"Lakes\") layer.Symbol.Color = moNavy layer.Name = \"湖泊\"

Map1.Layers.Add layer

Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"Roads\") layer.Symbol.Color = moRed layer.Symbol.Size = 1 layer.Symbol.Style = 0 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.Name = \"城市名称\"

layer.Symbol.Size = 0

Set layer.Renderer = New LabelRenderer

layer.Renderer.Field = \"NAME\" '指定要显示的字段 layer.Renderer.Symbol(0).Font.Name = \"幼圆\"

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

22

layer.Renderer.Symbol(0).Color = moBlack layer.Renderer.Symbol(0).Font.Size = 9 layer.Renderer.AllowDuplicates = True Map1.Layers.Add layer

Set layer = New MapLayer

Set layer.GeoDataset = dc.FindGeoDataset(\"Cities\") layer.Symbol.Color = moRed layer.Symbol.Size = 3 layer.Symbol.Style = 0 layer.Name = \"城市\" Map1.Layers.Add layer End Sub

Private Sub Form_Load()

dc.Database = App.Path + \"\\..\\\" + \"Mexico\" If Not dc.Connect Then

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

End

End If

LayerSet

legend1.setMapSource Map1 legend1.LoadLegend True Map1.Refresh End Sub

运行时的界面如图3.4所示。

图3.4 图层基本功能开发的综合示例

23