第4章 GIS常用工具开发

24第4章GIS常用工具开发GIS常用工具和方法除了前面介绍的Legend以外，还有指示图(Locatormap)、比例尺(ScaleBar)和状态栏(StatuBar)、打印功能的设置、鼠标提示(TipText)的设置以及查看属性设置等。4.1使用指示图一般地理信息系统在主窗口的附近都有一个指示图(Locatormap)。指示图用显著颜色的方框显示目前主窗口在全图的位置，并可以拖动方框或其它方式，在全图中迅速定位。4.1.1添加指示窗口以下实例可以在指示窗口中显示主窗口边界(红色边框)，并使2个窗口连动。在Form中添加Map1和Map2，用Form_Load、Mapl_AfterLayerDraw、Mapl_AfterLayerDraw过程来添加指示窗口，在Map1_MouseDown过程添加放大缩小功能，以检查指示窗口的连动功能。添加程序如下：（工程Chapter401－Form01）‘左键放大，右键缩小；OptionExplicitPrivateSubMap1_MouseDown(ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle)DimrAsMapObject2.RectangleIfButton=vbLeftButtonThenSetMap1.Extent=Map1.TrackRectangleElseIfButton=vbRightButtonThenSetr=Map1.Extentr.ScaleRectangle1.5Map1.Extent=rEndIfEndSub‘使Map1和Map2连动；PrivateSubMap1_AfterLayerDraw(ByValIndexAsInteger,ByValcanceledAsBoolean,ByValhdcAsstdole.OLE_HANDLE)IfIndex=0ThenMap2.TrackingLayer.RefreshTrueEndIfEndSub‘在Map2上画红色指示框PrivateSubMap2_AfterTrackingLayerDraw(ByValhdcAsstdole.OLE_HANDLE)25DimsymAsNewSymbolsym.OutlineColor=moRedsym.Style=moTransparentFillMap2.DrawShapeMap1.Extent,symEndSubPrivateSubForm_Load()DimdcAsNewDataConnectionDimlayerAsMapLayerdc.Database=App.Path+\..\+MexicoIfNotdc.ConnectThenMsgBox在指定的文件夹下没找到图层数据文件！EndEndIfSetlayer=NewMapLayerSetlayer.GeoDataset=dc.FindGeoDataset(States)layer.Symbol.Color=moYellowMap1.Layers.AddlayerSetlayer=NewMapLayerSetlayer.GeoDataset=dc.FindGeoDataset(Rivers)layer.Symbol.Color=moRedlayer.Symbol.Style=1Map1.Layers.AddlayerMap1.RefreshSetlayer=NewMapLayerSetlayer.GeoDataset=dc.FindGeoDataset(states)layer.Symbol.Color=moPaleYellowMap2.Layers.AddlayerMap2.RefreshEndSub示例的效果如图4.1所示。4.1.2在指示窗口中改变主窗口大小添加以下程序，可以在小窗口中点击移动大窗口位置，还可以画方框改变大窗口的大小：（工程Chapter401－Form02）PrivateSubMap2_MouseDown(ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle)DimcurRectangleAsMapObjects2.RectangleDimptAsNewMapObjects2.Point'画方框改变Map1窗口SetcurRectangle=Map2.TrackRectangleSetMap1.Extent=curRectangle26图4.1添加指示窗口'点击改变Map1位置Setpt=Map2.ToMapPoint(x,y)Map1.CenterAtpt.x,pt.yEndSub4.1.3在指示窗口中拖运方框要实现在指示窗口中拖动方框的功能，程序比较复杂，好在MO提供了类模块DragFeedback，只要在工程中添加类模块DragFeedback就可以了。在上面的程序中添加如下代码：（工程Chapter401－Form03）OptionExplicitDimg_feedbackAsDragFeedbackPrivateSubMap2_MouseDown(ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle)'将点击转换为Map2上的点对象；DimpAsPointSetp=Map2.ToMapPoint(x,y)'如果点击发生在方框内，开始拖动；IfMap1.Extent.IsPointIn(p)ThenSetg_feedback=NewDragFeedbackg_feedback.DragStartMap1.Extent,Map2,x,yEndIfEndSub'开始拖动方框PrivateSubMap2_MouseMove(ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle)IfNotg_feedbackIsNothingThen27g_feedback.DragMovex,yEndIfEndSub'拖动完成，并在Map1中显示新位置；PrivateSubMap2_MouseUp(ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle)IfNotg_feedbackIsNothingThenMap1.Extent=g_feedback.DragFinish(x,y)Setg_feedback=NothingEndIfEndSub'左键放大，右键缩小；PrivateSubMap1_MouseDown(ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle)DimrAsMapObjects2.RectangleIfButton=vbLeftButtonThenSetMap1.Extent=Map1.TrackRectangleElseIfButton=vbRightButtonThenSetr=Map1.Extentr.ScaleRectangle2Map1.Extent=rEndIfEndSub'使Map2和Map1联动；PrivateSubMap1_AfterLayerDraw(ByValIndexAsInteger,ByValcanceledAsBoolean,ByValhdcAsstdole.OLE_HANDLE)IfIndex=0ThenMap2.TrackingLayer.RefreshTrueEndIfEndSub'在Map2上画红色指示框；PrivateSubMap2_AfterTrackingLayerDraw(ByValhdcAsstdole.OLE_HANDLE)DimsymAsNewSymbolsym.OutlineColor=moRedsym.Size=2sym.Style=moTransparentFillMap2.DrawShapeMap1.Extent,symEndSubPrivateSubForm_Load()DimdcAsNewDataConnection28DimlayerAsMapLayerdc.Database=App.Path+\..\+MexicoIfNotdc.ConnectThenMsgBox在指定的文件夹下没找到图层数据文件！EndEndIfSetlayer=NewMapLayerSetlayer.GeoDataset=dc.FindGeoDataset(States)layer.Symbol.Color=moYellowMap1.Layers.AddlayerSetlayer=NewMapLayerSetlayer.GeoDataset=dc.FindGeoDataset(Rivers)layer.Symbol.Color=moRedMap1.Layers.AddlayerMap1.RefreshSetlayer=NewMapLayerSetlayer.GeoDataset=dc.FindGeoDataset(states)layer.Symbol.Color=moPaleYellowMap2.Layers.AddlayerMap2.RefreshEndSub4.2属性显示在地理信息系统中，常常要查询地图上对象的属性，这时就要用属性显示的程序设计方法了。4.2.1显示一个区域的属性先介绍简单的演示性的例子。在FORM上添加Mapl和ListView1(参见附录E.2)，程序如下：（工程Chapter401－Form04）OptionExplicitPrivateSubMap1_MouseDown(ButtonAsInteger,ShiftAsInteger,xAsSingle,yAsSingle)Dimly1AsMapObjects2.MapLayerDimfldAsMapObjects2.FieldDimnewItemAsObjectDimpAsMapObjects2.PointDimrecsAsMapObjects2.RecordsetSetly1=Map1.Layers(States)Setp=Map1.ToMapPoint(x,y)Setrecs=ly1.SearchShape(p,moPointInPolygon,)IfNotrecs.EOFThenListView1.ListItems.Clear29ForEachfldInrecs.Fields'iterateoverthefieldsSetnewItem=ListView1.ListItems.AddnewItem.text=fld.NamenewItem.SubItems(1)=fld.ValueAsString'getthevalueNextfldEndIfEndSubPrivateSubForm_Load()DimcolAsObjectDimdcAsNewDataConnectionDimlayerAsMapLayerdc.Database=App.Path+\..\+MexicoIfNotdc.ConnectThenMsgBox在指定的文件夹下没找到图层数据文件！EndEndIfSetlayer=NewMapLayerSetlayer.GeoDataset=dc.FindGeoDataset(States)layer.Symbol.Color=moYellowMap1.Layers.AddlayerSetlayer=NewMapLayerSetlayer.GeoDataset=dc.FindGeoDataset(Rivers)layer.Symbol.Color=moRedMap1.Layers.AddlayerMap1.RefreshSetcol=ListView1.ColumnHeaders.Add()col.text=属性名称Setcol=ListView1.ColumnHeaders.Add()col.text=属性值EndSub如果加一个Combo控件显示，