地理信息系统二次开发

课程设计报告课程名称：地理信息系统设计名称：MapObjects的二次开发院（系）：海洋科学与工程学院专业班级：100532姓名学号：指导教师：2013年1 月17 日一、设计目的：（1）、实习类型：课程设计；（2）、了解VB的软硬件环境、MapObjects数据类型；（3）、初步掌握该软件的基本操作技能；（4）、能够熟练的操作VB6.0软件，并能应用该软件简单的与MO进行开发（5）、掌握产品的输出设计。

（6）、培养利用GIS方法解决实际问题的能力。

二、设计主要仪器设备，器材，药品，软件等（1）软件准备：VB6.0（2）硬件准备：PC机500M内存，128M显卡（最低）（3）资料准备：MapObjects控件、USA等SHP文件三、设计原理和内容：（1）设计题目：MapObjects的二次开发（2）具体要求：应用VB软件与MO控件进行结合，实现MO的二次开发。

（3）功能描述：✓MapObjects是可以允许用户向应用程序中添加地图的制图软件控件集合。

✓MapObjects 可以在多种符合工业标准的开发环境下使用，比如Visual Basic，PowerBuilder，Visual C++等。

MapObjects 可以直接嵌入到这些开发环境中使用，允许用户快捷地创建应用程序。

✓MapObjects运行于Windows XP或Windows NT 4.0或更高版本。

✓MapObjects 包括一个ActiveX 控件(OCX) 也就是Map控件，还包括45个ActiveX 自动对象。

可用于符合IT行业标准的Windows编程环境。

✓MapObjects主要功能：显示一张包含多个图层的地图(道路，河流，边界)。

放大，缩小，漫游。

创建新的几何图形，如点，线，圆，多边形。

为图层添加注释。

识别地图上被选中的要素（点，线，面）。

可以通过线，矩形，多边形，圆来选择要素可以选取距某参照物一定距离范围内的要素。

可以通过SQL语句来选择要素。

对选择的要素进行统计。

查询与更新被选择的要素的属性数据制作专题地图。

根据字段的值标注图层要素。

显示从航片或卫星图片上获取的图像。

动态显示实时或时间系列数据。

通过输入地址在地图上定位。

将数据投影到不同的坐标系下✓MapObjects对象模型（具体见附录）数据通道对象组（Data Access Objects)地图显示对象组（Map Display Objects）几何图形对象组（Geometric Objects)地址匹配对象组（Address Match Objects）地理坐标对象组（Projection Objects）四、设计步骤1、下载MO与VB并安装，搭建开发环境安装MO：点击Mo22Setup.exe安装Mo，在VB6.0中加载MapObjects控件：2、系统功能设计打开文件、图层管理、地图放缩工具、右菜单、属性表信息、图层信息、动态图层实现、分析与查询、专题制图等3、系统界面设计4、系统功能实现4.1（1）对所要实现的功能进行菜单编辑，在窗体空白处点击右键，打开菜单编辑器，在菜单编辑器的标题框中输入菜单名称，名称框输中入对应的菜单名称，通过下方的方向键可以添加新菜单和二级、三级菜单，根据需要，我们设计了文件、图层、编辑和查询四个主菜单以及数个二级菜单。

如下图所示：结果如下：（2）添加图层显示窗口：在工具栏中双击Map工具，窗体中出现的一个白色图层即为图层显示窗口，根据需要调整窗口大小和位置。

我们添加一大一小两个显示窗口。

以同样的方法可添加用于显示图层名称的lstLayers窗口，用于显示比例尺的ScaleBar窗口以及用于显示时间的StatusBar窗口条，StatusBar工具条可右键打开属性页，在属性页中修改相应参数。

（3）添加按钮：双击工具栏中的CommandButton工具，窗体中会出现一个按钮，调整按钮的大小和位置，并在属性表中的Caption一栏修改按钮上显示的名称，我们添加了上移、下移、置顶和删除四个按钮。

如下图所示：（4）添加工具栏：先双击工具栏中的ImageList工具，右键打开该工具的属性页，选择图像->插入图片，选择需要的图片，如下图所示：（5）再在工具栏中双击ToolBar工具，右键打开属性页，在图像列表中选择ImageList1，再点击按钮->插入按钮，选择按钮样式和值，在图像输入框中输入之前在ImageList1中插入的图片的位所对应的数值，如图所示：（6）添加Timer工具和CommonDialog工具，这样就可以通过相应的代码显示时间和添加文件。

窗体布局如下：4.2主要程序及操作步骤（1）添加shape文件和栅格数据文件：添加、保存文件，添加文件并在窗体中显示图层信息：'添加shape文件Private Sub Add_shpFile_Click()On Error GoTo err2CommonDialog1.Filter = "ESRI Shapefiles (*.shp)|*.shp" '打开访问路径CommonDialog1.InitDir = App.Path + "\data"CommonDialog1.ShowOpenIf Len(CommonDialog1.FileName) = 0 Then Exit SubDim dc As New DataConnection '返回文件名字并打开文件dc.Database = CurDirIf Not dc.Connect Then Exit SubDim name As Stringname = Left(CommonDialog1.FileTitle, Len(CommonDialog1.FileTitle) - 4)Dim gs As GeoDatasetSet gs = dc.FindGeoDataset(name)If gs Is Nothing Then Exit SubSet g_layer = New MapLayer '加载图层monDialog1.ShowColorg_layer.Symbol.color = monDialog1.colorSet g_layer.GeoDataset = gsyers.Add g_layeryers.Add g_layeryers.Add g_layeryers.Add g_layerMe.legend1.setMapSource Map1 '显示标签legend1.LoadLegend TrueSet Rectsel = NothingIf dc.Connect Then '显示图层信息lstLayers.ClearFor Each lyr In yerslstLayers.AddItem Next lyrEnd IfIf lstLayers.ListCount > 0 ThenAdd_shpFile.Enabled = TruelstLayers.Selected(0) = TrueEnd Ifform1.Map1.Refresh '更新地图form1.Map2.RefreshMap1.MousePointer = moArrowExit Suberr2:MsgBox "对不起，打开出错！"End Sub'添加栅格数据文件Private Sub shange_Click()*******CommonDialog1.Filter = "Windows Bitmap (*.bmp)|*.bmp|TIFF Image(*.tif)|*.tif|JPG图片(*.jpg)|*.jpg"CommonDialog1.FilterIndex = 1CommonDialog1.InitDir = App.PathCommonDialog1.ShowOpenIf CommonDialog1.FileName <> "" TheniLayer.file = CommonDialog1.FileName' move the existing layer to the topIf yers.Add(iLayer) Thenyers.MoveToTop 1End If' Form12.Caption = CommonDialog1.FileNameEnd IfExit Suberr2:MsgBox "对不起，打开出错！"End Sub'保存图片Private Sub Save_bmp_Click() '保存图片CommonDialog1.InitDir = App.PathCommonDialog1.Filter = "Windows Bitmap (*.bmp)|*.bmp|TIFF Image(*.tif)|*.tif|JPG图片(*.jpg)|*.jpg|png图片(*.png)|*.png"CommonDialog1.DialogTitle = "Export Bitmap(*.bmp)|*.bmp|TIFF Image(*.tif)|*.tif|JPG图片(*.jpg)|*.jpg|png图片(*.png)|*.png" CommonDialog1.FileName = "untitled.bmp"CommonDialog1.ShowSaveIf Len(CommonDialog1.FileName) = 0 Then Exit Subform1.Map1.ExportMap moExportBMP, CommonDialog1.FileName, moAllSymbologyScaledEnd Sub（2）放大、缩小、漫游、全景等功能：Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)Dim Response As VariantIf Toolbar1.Buttons(1).Value = tbrPressed Then '放大If flag = 1 ThenResponse = MsgBox("地图处于绘制状态，是否继续进行放大操作", vbYesNo, "取消操作")If Response = vbYes ThenMap1.MousePointer = moZoomInElseMap1.MousePointer = moDefaultEnd IfElseMap1.MousePointer = moZoomInEnd IfElseIf Toolbar1.Buttons(2).Value = tbrPressed Then '缩小If flag = 1 ThenResponse = MsgBox("地图处于未完全绘制状态，是否继续进行缩小操作", vbYesNo, "取消操作")If Response = vbYes ThenMap1.MousePointer = moZoomOutElseMap1.MousePointer = moDefaultEnd IfEnd IfElseIf Toolbar1.Buttons(3).Value = tbrPressed Then '漫游If flag = 1 ThenResponse = MsgBox("地图处于未完全绘制状态，是否继续进行漫游操作", vbYesNo, "取消操作")If Response = vbYes ThenMap1.MousePointer = moPanElseMap1.MousePointer = moDefaultEnd IfEnd IfElseMap1.MousePointer = moArrowEnd IfEnd SubPrivate Sub Toolbar1_DblClick()Toolbar1.Visible = FalseEnd SubPrivate Sub Command1_Click() '全景显示Set Map1.Extent = Map1.FullExtentEnd Sub（3）图层操作，包括选定图层的上移、下移、置顶、删除以及所有图层清空Private Sub toplayer0() '图层至顶If lstLayers.ListIndex <> -1 Thenyers.MoveToTop lstLayers.ListIndexMap1.RefreshlstLayers.ClearFor Each lyr In yerslstLayers.AddItem Next lyrEnd IfEnd SubPrivate Sub uplayer0() '上移图层Dim i As IntegerIf lstLayers.ListIndex <> -1 And lstLayers.ListIndex > 0 Theni = lstLayers.ListIndex - 1yers.MoveTo lstLayers.ListIndex, iMap1.RefreshlstLayers.ClearFor Each lyr In yerslstLayers.AddItem Next lyrlstLayers.Selected(i) = TrueEnd IfEnd SubPrivate Sub downlayer0() '下移图层Dim i As IntegerIf lstLayers.ListIndex <> -1 And lstLayers.ListIndex < lstLayers.ListCount - 1 Theni = lstLayers.ListIndex + 1yers.MoveTo lstLayers.ListIndex, iMap1.RefreshlstLayers.ClearFor Each lyr In yerslstLayers.AddItem Next lyrlstLayers.Selected(i) = TrueEnd IfEnd SubPrivate Sub cancel_layer_Click() '删除图层Dim i As IntegerIf lstLayers.ListIndex <> -1 Theni = lstLayers.ListIndexyers.Remove iyers.Remove iMap1.RefreshMap1.RefreshlstLayers.ClearFor Each lyr In yerslstLayers.AddItem Next lyrEnd IfMe.legend1.setMapSource Map1 '删除标签legend1.LoadLegend FalseEnd SubPrivate Sub 清空_Click() '清空图层On Error GoTo err1 '如果map1和map2已经清除不操作yers.Clearyers.ClearlstLayers.ClearMe.legend1.setMapSource Map1 '删除标签legend1.LoadLegend Falseerr1:MsgBox "没有图层！"End Sub（4）右键功能实现Private Sub 放大_Click() '右键放大Set rt = Map1.Extentrt.ScaleRectangle (0.5)Set Map1.Extent = rtEnd SubPrivate Sub 缩小_Click() '右键缩小Set rt = Map1.Extentrt.ScaleRectangle (1.5)Set Map1.Extent = rtEnd SubPrivate Sub 显示各层信息_Click() '右键显示图层信息* * * * * *lyrCount = yers.CountForm4.MSFlexGrid1.Rows = 1Form4.MSFlexGrid1.Cols = 3Form4.MSFlexGrid1.Row = 0: Form4.MSFlexGrid1.Col = 0 Form4.MSFlexGrid1.Text = "图层序号"Form4.MSFlexGrid1.Col = 1: Form4.MSFlexGrid1.Text = "名称"Form4.MSFlexGrid1.Col = 2: Form4.MSFlexGrid1.Text = "类型"For i = 0 To lyrCount - 1Select Case yers.Item(i).shapeTypeCase moPointstrtype = "点图层"Case moLinestrtype = "线图层"Case moPolygonstrtype = "多边形图层"Case Elsestrtype = "？"End SelectForm4.MSFlexGrid1.AddItem Str$(i + 1) & Chr(9) & yers.Item(i).name & Chr(9) & strtype Next iForm4.Show vbModalEnd Sub（5）状态栏实现从状态栏属性添加文本“海技地信课设钱为陈瑞瑞吴运涛代长波”，并设置属性Private Sub Timer1_Timer() '显示当前时间Timer1.Interval = 1000 '时间以毫秒记Timer1.Enabled = TrueStatusBar1.Panels.Item(5).Text = "当前时间：" & Now()End SubPrivate Sub Form_Load() '显示登录时间Timer1.Interval = 1000Timer1.Enabled = TrueStatusBar1.Panels.Item(4).Text = "登陆时间：" & Now()************End SubPrivate Sub refreshScale() '状态栏信息ScaleBar1.MapExtent.MaxX = Map1.Extent.RightScaleBar1.MapExtent.MinX = Map1.Extent.LeftScaleBar1.MapExtent.MaxY = Map1.Extent.BottomScaleBar1.MapExtent.MinY = Map1.Extent.TopScaleBar1.PageExtent.MinX = Map1.Left / Screen.TwipsPerPixelXScaleBar1.PageExtent.MinY = Map1.Top / Screen.TwipsPerPixelYScaleBar1.PageExtent.MaxX = (Map1.Left + Map1.Width) / Screen.TwipsPerPixelXScaleBar1.PageExtent.MinY = (Map1.Top + Map1.Height) / Screen.TwipsPerPixelYScaleBar1.RefreshStatusBar1.Panels(6).Text = "比例1 ：" & Format$(ScaleBar1.RFScale, "###,###,###,###,###")End SubPrivate Sub Map1_AfterLayerDraw(ByVal Index As Integer, ByVal canceled As Boolean, ByVal hDC As stdole.OLE_HANDLE) ******Call refreshScale******End Sub（6）旋转，复位Private Sub xuanzhuan_Click() '右转Map1.RotationAngle = 90Map1.RefreshEnd SubPrivate Sub Command6_Click()Map1.RotationAngle = -90Map1.RefreshEnd SubPrivate Sub Command4_Click() '复位Map1.RotationAngle = 0Map1.RefreshEnd Sub（7）图层编辑Private Sub Map1_AfterLayerDraw(ByVal Index As Integer, ByVal canceled As Boolean, ByVal hDC As stdole.OLE_HANDLE) *********'设置点格式If Not Pts Is Nothing Thensym.color = moRedsym.SymbolType = moPointSymbolsym.Size = 5Map1.DrawShape Pts, symEnd If'设置线格式If Not g_line Is Nothing Thensym.color = moBlackMap1.DrawShape line_pts, symIf line_pts.Count > 1 Thensym.color = moRedsym.SymbolType = moLineSymbolsym.Size = 3Map1.DrawShape g_line, symEnd IfEnd If'设置面的格式If Not r Is Nothing Thensym.SymbolType = moFillSymbolsym.style = moDiagonalCrossFillsym.color = moBlueMap1.DrawShape r, symEnd IfIf Not elp Is Nothing Thensym.SymbolType = moFillSymbolsym.style = moDiagonalCrossFillsym.color = moRedMap1.DrawShape elp, symEnd IfIf Not ply Is Nothing Thensym.SymbolType = moFillSymbolsym.style = moDiagonalCrossFillsym.color = moGreenMap1.DrawShape ply, symEnd IfEnd SubPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim whichButton As MSComctlLib.Button************'画点If flagp = 1 ThenSet p = Map1.ToMapPoint(X, Y)Pts.Add pMap1.TrackingLayer.Refresh TrueEnd If'画线If flagl = 1 ThenIf g_line Is Nothing ThenSet g_line = New MapObjects2.LineEnd IfIf line_pts Is Nothing ThenSet line_pts = New PointsEnd IfSet p = Map1.ToMapPoint(X, Y)line_pts.Add pIf line_pts.Count = 1 Theng_line.Parts.Add line_ptsSet line_pts = g_line.Parts(0)End IfMap1.TrackingLayer.Refresh TrueMap1.RefreshEnd If'画面If flagpl = 1 ThenIf opt = 1 ThenSet ply = Map1.TrackPolygon ElseIf opt = 2 ThenSet r = Map1.TrackRectangle ElseIf opt = 3 ThenSet elp = Map1.TrackCircleEnd IfMap1.TrackingLayer.Refresh True End IfMap1.Refresh*******End SubPrivate Sub Command5_Click() '画点flagp = 1flagl = 0flagpl = 0End SubPrivate Sub Command7_Click() '画线flagl = 1flagp = 0flagpl = 0End SubPrivate Sub Command8_Click() '画多边形flagpl = 1flagp = 0flagl = 0opt = 1End SubPrivate Sub Command9_Click() '画矩形flagpl = 1flagp = 0flagl = 0opt = 2End SubPrivate Sub Command10_Click() '画圆flagpl = 1flagp = 0flagl = 0opt = 3End Sub（8）动态图层实现Private Sub Command3_Click()If OP = 0 ThenOP = 1Command3.Caption = "停止"Else: OP = 1OP = 0Command3.Caption = "开始"End IfEnd SubPrivate Sub Command2_Click()Dim rx As SingleDim ry As SingleDim i As Integer, j As IntegerDim Ent As IntegerConst Dx = 1Const Dy = 1Ent = Map1.TrackingLayer.EventCountIf Ent = 0 ThenMsgBox "请点击地图！"Exit SubEnd IfFor i = 1 To 50For j = 1 To Entrx = 2 * Rnd - 1ry = 2 * Rnd - 1Map1.TrackingLayer.Event(j - 1).Move rx * Dx, ry * DyDelay (Int(100 / Ent))Map1.TrackingLayer.Refresh TrueNext jNext iEnd SubPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ********************If OP = 1 ThenDim oPoint As MapObjects2.PointSet oPoint = Map1.ToMapPoint(X, Y)Map1.TrackingLayer.Symbol(0).CharacterIndex = 101Map1.TrackingLayer.AddEvent oPoint, 0End IfEnd SubSub Delay(ss As Integer) '延时过程Dim start, checkstart = TimerDocheck = TimerLoop While check < start + ss * 0.001End Sub（9）鹰眼功能实现Private Sub Map2_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE) '缩略图******Map2.DrawShape Map1.Extent, symMap2.RefreshEnd SubPrivate Sub Map2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Set pt = Map2.ToMapPoint(X, Y)Map1.CenterAt pt.X, pt.YEnd Sub（10）查询与分析1>.空间关系查询与分析部分代码如下：Private Function GetRecordsetBounds(recs As MapObjects2.Recordset) As MapObjects2.Rectangle' Get the bounds of the recordsetSet GetRecordsetBounds = NothingIf Not recs Is Nothing ThenDim bounds As MapObjects2.RectangleSet bounds = NothingSet Fld = recs("Shape")' For each feature in recordset...recs.MoveFirstDo While Not recs.EOF' get shape boundsDim shapeBounds As MapObjects2.RectangleIf Fld.Type = moPoint ThenDim pt As MapObjects2.PointSet pt = Fld.ValueDim ptBounds As New MapObjects2.RectangleptBounds.Left = pt.XptBounds.Top = pt.YptBounds.Right = pt.XptBounds.Bottom = pt.YSet shapeBounds = ptBoundsElseIf Fld.Type = moLine ThenDim l As MapObjects2.LineSet l = Fld.ValueSet shapeBounds = l.ExtentElseIf Fld.Type = moPolygon ThenDim p As MapObjects2.PolygonSet p = Fld.ValueSet shapeBounds = p.ExtentElseMsgBox "Invalid shape in GetRecordsetBounds!"End If' add shape bounds to totalIf bounds Is Nothing ThenSet bounds = shapeBoundsElsebounds.Union shapeBoundsEnd Ifrecs.MoveNextLoopSet GetRecordsetBounds = boundsEnd IfEnd Function***************Sub ExecuteSearch()On Error Resume Next' We're either searching with a single shape or a' record set. The search routines don't care so,' put the search shape(s) in a single variable' called shapes.Dim shapes As ObjectSet shapes = NothingIf Not g_searchShape Is Nothing Then Set shapes = g_searchShape If Not g_searchSet Is Nothing Then Set shapes = g_searchSetIf shapes Is Nothing Then Exit Sub' reset the selection and execute the searchScreen.MousePointer = 11Set g_selectedFeatures = NothingIf StrComp(List1.List(List1.ListIndex), "shape is within [Search Distance] of feature") = 0 Then ' Execute the SearchByDistance method on selected layerSet g_selectedFeatures = yers(Combo2.ListIndex).SearchByDistance(shapes, Text1.Text, "") Else' Execute the selected SearchByShape method on selected layerSet g_selectedFeatures = yers(Combo2.ListIndex).SearchShape(shapes, List1.ListIndex, "") End IfSet g_selectedBounds = GetRecordsetBounds(g_selectedFeatures)Map1.TrackingLayer.Refresh TrueScreen.MousePointer = 0End Sub2>.空间对象属性查询部分代码如下：Private Sub Combo1_Click()List1.ClearSet Rect = yers(Combo1.Text).RecordsFor Each Fld In Rect.FieldsIf Fld.Type = moString Then'Combo2.AddItem List1.AddItem ElseIf Fld.Type < 21 Then' Combo2.AddItem List1.AddItem End IfEnd IfNext FldPrivate Sub Command1_Click()Text1.Text = ""End SubPrivate Sub Command2_Click()On Error Resume NextSet Rectsel = NothingSet Rectsel = yers(Combo1.Text).SearchExpression(Text1.Text) 'Form1.Map1.FlashShape Rectsel.Fields("Shape").Value, 4Set Symsel = New MapObjects2.SymbolSymsel.SymbolType = yers(0).Symbol.SymbolTypeSymsel.color = moRedform1.Map1.RefreshEnd SubPrivate Sub Command3_Click()Set Rectsel = NothingForm5.HideEnd SubPrivate Sub Command4_Click(Index As Integer)If mand4(0) ThenText1.Text = Text1.Text & mand4(0).CaptionElseIf mand4(1) Then********End IfEnd SubPrivate Sub Form_Load()Combo1.ClearFor Each l In yersCombo1.AddItem NextCombo1.Text = Combo1.List(0)End SubPrivate Sub Form_Unload(Cancel As Integer)Set Rectsel = Nothingform1.Map1.RefreshEnd SubPrivate Sub List1_Click()Set Rect = yers(Combo1.Text).RecordsDo While Not Rect.EOFList2.AddItem Rect.Fields(List1.List(List1.ListIndex)).ValueAsString Rect.MoveNextLoopText1.Text = Trim(Text1.Text & Trim(List1.Text))End SubPrivate Sub List2_Click()Text1.Text = Trim(Text1.Text & " '" & Trim(List2.Text) & " ' ")End Sub2>.空间对象属性查询代码如下：Private Sub Combo1_Click()List1.ClearList2.ClearSet Rect = yers(Combo1.Text).RecordsFor Each Fld In Rect.FieldsList1.AddItem Next FldEnd SubPrivate Sub Command1_Click()Form6.HideEnd SubPrivate Sub Combo2_Change()Text1.Text = Text1.Text & Combo1.TextEnd SubPrivate Sub Form_Load()Combo1.ClearFor Each l In yersCombo1.AddItem NextCombo1.Text = Combo1.List(0)'Combo2.Text = Combo2.List(0)End SubPrivate Sub List1_Click()On Error Resume NextList2.ClearSet oSta = yers(Combo1.Text).Records.CalculateStatistics(List1.List(List1.ListIndex)) List2.AddItem "最大值: " & oSta.MaxList2.AddItem "最小值: " & oSta.MinList2.AddItem "平均值: " & oSta.MeanList2.AddItem "总计: " & oSta.SumList2.AddItem "数目: " & oSta.CountList2.AddItem "标准差: " & oSta.StdDevEnd Sub（11）属性表Private Sub Combo1_Click()List1.ClearListView1.ColumnHeaders.ClearListView1.ListItems.ClearDim K As IntegerSet Rect = yers(Combo1.Text).RecordsFor Each Fld In Rect.FieldsList1.AddItem Set Col = ListView1.ColumnHeaders.Add()Col.Text = Next FldDo While Not Rect.EOFSet Lisit = ListView1.ListItems.Add(, , Rect.Fields(List1.List(0)).ValueAsString)For K = 1 To List1.ListCount - 1Lisit.SubItems(K) = Rect.Fields(List1.List(K)).ValueAsStringNext KRect.MoveNextLoopEnd SubPrivate Sub Form_Load()Combo1.ClearFor Each l In yersCombo1.AddItem NextCombo1.Text = Combo1.List(0)End SubPrivate Sub Form_Unload(Cancel As Integer)Combo1.ClearListView1.ColumnHeaders.ClearListView1.ListItems.ClearEnd SubPrivate Sub List1_Click()ListView1.ColumnHeaders.ClearListView1.ListItems.ClearSet Col = ListView1.ColumnHeaders.Add()Col.Width = 3000Col.Text = List1.TextSet Rect = yers(Combo1.Text).RecordsDo While Not Rect.EOFSet Lisit = ListView1.ListItems.Add(, , Rect.Fields(List1.List(List1.ListIndex)).ValueAsString) Rect.MoveNextLoopEnd Sub（12）图层信息显示代码见右菜单实现处（13）专题制图此部分功能包括唯一值法、分类着色法、点密度法、图标渲染法、组合着色法和地图标注，部分代码如下：Private Sub wyzf_Click() '唯一值法*****Set lyr = yers.Item(0)Set recs = lyr.RecordsDo While Not recs.EOFstrings.Add recs("STATE_NAME").Value recs.MoveNextLoopSet lyr.Renderer = New ValueMapRenderer lyr.Renderer.Field = "STATE_NAME" lyr.Renderer.ValueCount = strings.Count For i = 0 To strings.Count - 1lyr.Renderer.Value(i) = strings(i)Next iMap1.RefreshEnd SubPrivate Sub flzsf_Click()********Set lyr = yers.Item(0) '分类着色Set lyr.Renderer = cbrWith cbr.Field = "pop1990".BreakCount = 3.Break(0) = 100000.Break(1) = 1000000.Break(2) = 10000000.Symbol(0).color = moRed.Symbol(1).color = moGreen.Symbol(2).color = moBlueEnd WithMap1.RefreshEnd SubPrivate Sub dmdf_Click() '点密度法******Set lyr = yers.Item(0)Set lyr.Renderer = ddrWith ddr.Field = "pop1990".DotV alue = 120000End WithMap1.RefreshEnd SubPrivate Sub tbxrf_Click() '图标渲染********Set lyr = yers.Item(0)Set lyr.Renderer = crWith cr.ChartType = moBar.FieldCount = 2.Field(0) = "white".color(0) = moRed.Field(1) = "black".color(1) = moGreenEnd WithMap1.RefreshEnd SubPrivate Sub zhzsf_Click() '组合着色********With cbr.Field = "pop1990".BreakCount = 3.Break(0) = 100000.Break(1) = 1000000.Break(2) = 10000000End WithWith cr.ChartType = moBar.FieldCount = 2.Field(0) = "white".Field(1) = "black"End Withgr.Add cbrgr.Add crSet lyr = yers.Item(0)Set lyr.Renderer = grMap1.RefreshEnd SubPrivate Sub dtbz_Click() '地图标注**************Set lyr = yers.Item(0)Set lyr.Renderer = lrlr.Field = "state_name"Map1.RefreshEnd Sub四、实验总结4.1、实验中遇到的困难1、在刚开始做实验的时候，由于文件的保存路径不一样，导致加载图层的时候出现错误2、在下面一个实验中，程序时的代码出错，导致程序无法运行3、在第三个实验中，无法加载图标或者加载按钮图像的时候，没有显示图像；在加载shape文件后按按钮进行放大、缩小的操作的时候，无法对图像进行放大缩小等操作。