TDGG周刊

我们一直在进步......

« 关于他怀念 »

基于VB+MO的GIS二次开发

作者:施甸分公司——陈永福

         基于我四年的对GIS二次开发的学习,特写该篇文章对GIS开发做一个简单的介绍。
        下面我主要介绍基于Mapobjects控键的GIS开发:
        首先我们来了解一下什么是Mapobjects?简单一点Mapobjects是一套制图软件集,它使程序员能够把地图加到应用程序中去,通过Mapobjects可灵活地建立适合用户的地图接口,在小内存空间中能用多种工业标准程序环境之一去建立应用程序,能够联合使用Mapobjects与其他软件去实现地图与用户信息的联系。Mapobjects是ESRI公司产品的一部分。

Mapobjects的主要功能有:
1.                可以显示的地科数据格式:Arcview的Shape,Arc/info的coverage,SDE图层,以及栅格数据的显示;
2.                对地图的常用操作:放大、缩小、漫游等;
3.                图层控制:增加、移走、设置当前层;
4.                属性数据绑定;
5.                地图信息查询方式:通过鼠标选取特征、通过SQL语句查找特征、通过空间操作选取特征;
6.                专题地图制作:功能较弱;
7.                可以进行地图标注;
8.                地图符号化:唯一着色、点密度着色、分色着色、图表着色、组合着色、事件着色、高程着色;
9.                地图的输出与打印。
基于以上功能,我下面就以一个简单的例子给大家讲述一下利用Mapobjects开发的过程:
        程序界面如下:
 
该程序实现了Shape格式数据的添加、保存;图层的显示、清除;地图的放大、缩小、漫游、全图显以及鹰影功能的实现。
在程序中我们用到了Map控键,Toolbar控键,Legend控键,Imaglist控键以及CommonDialog控键。
我们要用Mapobjects进行开发,就应先安装其安装程序,安装成功后我们就可以在VB中进行调用,这些细节我在这里就不过多讲解。
程序代码如下:
'设置MAP2的背景颜色
Private Sub Form_Load()
Map2.BackColor = moWhite
End Sub
'清除图层
Private Sub clearlayer_Click()
Map1.Layers.Clear
Map1.Extent = Map1.FullExtent
Map1.Refresh
Map2.Layers.Clear
Map2.Extent = Map2.FullExtent
Map2.Refresh
legend1.RemoveAll
End Sub
'结束窗口
Private Sub close_Click()
End
End Sub
'添加数据
Private Sub open_Click()
Dim dc As New DataConnection
Dim godt As GeoDataset
Dim sname As String
Dim layer As MapObjects2.MapLayer
CommonDialog1.Filter = "ESRI Shapefiles(*.shp)|*.shp"
CommonDialog1.ShowOpen
If Len(CommonDialog1.FileName) = 0 Then Exit Sub
dc.Database = CurDir
 
If Not dc.Connect Then Exit Sub
 
sname = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4)
Set godt = dc.FindGeoDataset(sname)
If godt Is Nothing Then Exit Sub
 
Set layer = New MapLayer
layer.GeoDataset = godt
Map1.Layers.Add layer
legend1.setMapSource Map1
legend1.LoadLegend True
Map1.Refresh
Map2.Layers.Add layer
Map2.Refresh
End Sub
'放大,缩小,漫游
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim r As New Rectangle
If Toolbar1.Buttons(1).Value = 1 Then
Map1.Extent = Map1.TrackRectangle
ElseIf Toolbar1.Buttons(2).Value = 1 Then
Set r = Map1.Extent
r.ScaleRectangle 1.5
Map1.Extent = r
ElseIf Toolbar1.Buttons(3).Value = 1 Then
Map1.Pan
'ElseIf Toolbar1.Buttons(4).Value = 1 Then
'Map1.Extent = Map1.FullExtent
End If
End Sub
'保存数据
Private Sub save_Click()
Dim desc As New TableDesc
Dim gds As MapObjects2.GeoDataset
Dim sname As String
Dim dc As New DataConnection
Dim lyr As New MapObjects2.MapLayer
Dim ipoly As Long
Dim mopolygons As New Collection
With CommonDialog1
 .Filter = "ESRI Shapefiles(*.shp)|*.shp"
 .DefaultExt = ".shp"
 .ShowSave
 If Len(.FileName) = 0 Then Exit Sub
 dc.Database = CurDir
 If Not dc.Connect Then Exit Sub
 sname = Left(.FileTitle, Len(.FileTitle) - 4)
 End With
 
On Error GoTo err
With desc
 .FieldCount = 5
 .FieldName(0) = "name"
 .FieldName(1) = "area"
 .FieldName(2) = "perimeter"
 .FieldName(3) = "xzh"
 .FieldName(4) = "bzh"
 .FieldType(0) = moString
 .FieldType(1) = moDouble
 .FieldType(2) = moDouble
 .FieldType(3) = moString
 .FieldType(4) = moString
 
 .FieldLength(0) = 16
 .FieldPrecision(1) = 15
 .FieldScale(1) = 3
 .FieldPrecision(2) = 15
 .FieldScale(2) = 3
 .FieldLength(3) = 16
 .FieldLength(4) = 16
 End With
 Set gds = dc.AddGeoDataset(sname, moPolygon, desc)
 Set lyr.GeoDataset = gds
 Map1.Layers.Add lyr
 Map1.Refresh
 
 For ipoly = 1 To mopolygons.Count
 With lyr.Records
 .AddNew
 .Fields("shape").Value = mopolygons(ipoly)
 .Fields("name").Value = "name" & ipoly
 .Fields("area").Value = mopolygons(ipoly).Area
 .Fields("perimeter").Value = mopolygons(ipoly).Perimeter
 .Update
 End With
 Next
 lyr.Records.StopEditing
err: Exit Sub
  
   End Sub
 
'地图上鼠标显示类型
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
If Toolbar1.Buttons(1).Value = 1 Then
Map1.MousePointer = moZoomIn
ElseIf Toolbar1.Buttons(2).Value = 1 Then
Map1.MousePointer = moZoomOut
ElseIf Toolbar1.Buttons(3).Value = 1 Then
Map1.MousePointer = moPan
ElseIf Toolbar1.Buttons(4).Value = 1 Then
Map1.Extent = Map1.FullExtent
Map1.MousePointer = moDefault
ElseIf Toolbar1.Buttons(5).Value = 1 Then
Map2.Visible = True
Map1.MousePointer = moDefault
Map2.BackColor = moBlack
End If
End Sub
Private Sub legend1_AfterSetLayerVisible(index As Integer, isVisible As Boolean)
Map1.Refresh
End Sub
 
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)
legend1.EnableDragDrop = False
End Sub
 
'实现两个地图控键的联动,相当于鹰影功能的实现
Private Sub Map1_AfterLayerDraw(ByVal index As Integer, ByVal canceled As Boolean, ByVal hDC As stdole.OLE_HANDLE)
If index = 0 Then
Map2.TrackingLayer.Refresh True
End If
End Sub
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
End Sub
'点击MAP2时,MAP1显示矩形框内的相应位置
Private Sub Map2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim currectangle As MapObjects2.Rectangle
Dim pt As New MapObjects2.Point
Set currectangle = Map2.TrackRectangle
Set Map1.Extent = currectangle
Set pt = Map2.ToMapPoint(X, Y)
Map1.CenterAt pt.X, pt.Y
End Sub
运行程序后我们把云南省的Shape格式的线状界线添加后如下显示:
 
放大:
 
 
我在这里就不一一截图了,具体给大家讲一下吧:
如界面如示:
文件菜单下有打开、保存和关闭三个按钮:
1. 打开:打开任意电脑中的Shape格式的数据;
2. 保存地图中显示的数据为Shape格式的数据;
3. 关闭:关闭应用程序。
图层管理菜单下有一个清除图层按钮,主要用于清除打开的Shape数据;
工具栏中有放大、缩小、漫游、全图显示四个图标,分别实现相应的功能;
显示图层名的这个框为Mapobjects中自带的专门显示图层的控键Legend;
大的显示框为地图显示区,小的显示框为鹰影功能是实现,该两个显示框是联动的,当其中一个框中的地图发生的变化,如:放大、缩小、漫游、全图显示,另一个框中相应的同步变化显示地图。
GIS二次开发的工具很多,如Arcgis中的VBA开发、Arcobjects、ArcGISEngine等,不管用哪种方法,只要能满足用户的需求,我们都可以使用。
好了,就介绍到这里吧,等有空了给大家介绍更深层次的操作吧!

 

 

 

 

发表评论:

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

日历

最新评论及回复

相关文章111

Powered By Z-Blog 1.8 Arwen Build 81206 theme by 博客主题网

Copyright 昆明土地公公科技有限公司. Some Rights Reserved.