第4章 GI常用工具开发.docVIP

  • 5
  • 0
  • 约3.04万字
  • 约 25页
  • 2016-10-21 发布于贵州
  • 举报
第4章 GI常用工具开发

第4章 GIS常用工具开发 GIS常用工具和方法除了前面介绍的Legend以外,还有指示图(Locator map)、比例尺(ScaleBar)和状态栏(StatuBar)、打印功能的设置、鼠标提示(TipText)的设置以及查看属性设置等。 4.1使用指示图 一般地理信息系统在主窗口的附近都有一个指示图(Locator map)。指示图用显著颜色的方框显示目前主窗口在全图的位置,并可以拖动方框或其它方式,在全图中迅速定位。 4.1.1 添加指示窗口 以下实例可以在指示窗口中显示主窗口边界(红色边框),并使2个窗口连动。 在Form中添加Map1和Map2,用Form_Load、Mapl_AfterLayerDraw、Mapl_AfterLayerDraw过程来添加指示窗口,在Map1_MouseDown过程添加放大缩小功能,以检查指示窗口的连动功能。 添加程序如下: (工程Chapter401-Form01) ‘左键放大,右键缩小; Option Explicit Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Dim r As MapObject2.Rectangle If Button = vbLeftButton Then Set Map1.Extent = Map1.TrackRectangle ElseIf Button = vbRightButton Then Set r=Map1.Extent r.ScaleRectangle 1.5 Map1.Extent=r End If End Sub ‘使Map1和Map2连动; 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 ‘在Map2上画红色指示框 Private Sub Map2_AfterTrackingLayerDraw(ByVal hdc As stdole.OLE_HANDLE) Dim sym As New Symbol sym.OutlineColor = moRed sym.Style = moTransparentFill Map2.DrawShape Map1.Extent, sym End Sub 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) layer.Symbol.Color = moYellow Map1.Layers.Add layer Set layer = New MapLayer Set layer.GeoDataset = dc.FindGeoDataset(Rivers) layer.Symbol.Color = moRed layer.Symbol.Style = 1 Map1.Layers.Add layer Map1.Refresh Set layer = New MapLayer Set layer.GeoDataset = dc.FindGeoDataset(states) layer.Symbol.Color = moPaleYellow Map2.Layers.Add layer Map2.Refresh End Sub 示例的效果如图4.1所示。 4.1.2 在指示窗口中改变主窗口大小 添加以下程序,可以在小窗口中点击移动大窗口位置,还可以画方框改变大窗口的大小: (工程Chapter401-Form02) 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 MapObje

您可能关注的文档

文档评论(0)

1亿VIP精品文档

相关文档