51CTO下载-VB+ArcGis Engine 开发零基础GIS程序框架教程

VB+ArcGis Engine 开发零基础GIS程序框架教程

本文由mianhuatang151贡献

VB+ArcGis Engine 开发零基础 GIS 程序框架教程
第一步 配置环境和设计界面 环境：ArcGisEngine 9.1 + Microsoft Visual Basic 6.0 使用 Engine 控件：ESRI ToolbarControl, ESRITOCControl 、 ESRILicenseControl、ESRIMapControl。 （按 Ctrl+T 调出部件面板，选中以下控件）

再从[工程]-[引用]添加一下引用：

界面布局（右侧大的 MapcControl 命名为 MapControl1，为显示地图主界面。左 下角的 MapcControl 命名为 MapControl2，作为地图鹰眼。在工具栏里添加如图 的几个按钮即可。其它再添加一个 CommonDialog1 和状态栏）：

在 ESRI ToccControl 和 ESRIToolbarControl 属性里绑定控件 EsriMapControl （buddy 选择 MapControl1）。 这样基本界面就布置好了。 第二步 加载地图 代码为： '打开地图文档 On Error Resume Next Dim sFileName As String With CommonDialog1 .DialogTitle = "Open Map Document" .Filter = "Map Documents (*.mxd;*.pmf)|*.mxd;*.pmf" .ShowOpen If .FileName = "" Then Exit Sub sFileName = .FileName End With If MapControl1.CheckMxFile(sFileName) Then MapControl1.LoadMxFile sFileName

MapControl1.Extent = MapControl1.FullExtent Else MsgBox sFileName & " is not a valid ArcMap document" Exit Sub End If StatusBar1.Panels(3).Text = sFileName ‘状态栏显示文件路径 第三步 让鹰眼地图跟 MapControl1 的地图互动 1.先在声明里定义几个变量： '地图鹰眼 Private m_pEnvelope As IEnvelope ' The envelope drawn on the MapControl Private m_pFillSymbol As ISimpleFillSymbol' The symbol used to draw the Private WithEvents m_pTransformEvents AsdisplayTransformation 2.定义如下函数： Private Sub CreateOverviewSymbol() '设置鹰眼图中的红线框 'Get the IRgbColor interface. DimpColor As IRgbColor SetpColor = New RgbColor 'Set the color properties. pColor.RGB = RGB(255, 0, 0) 'Get the ILine symbol interface. Dim pOutline As ILineSymbol SetpOutline = New SimpleLineSymbol 'Set the line symbol properties. pOutline.Width = 1.5 pOutline.Color = pColor 'Get the IFillSymbol interface. Setm_pFillSymbol = New SimpleFillSymbol 'Set the fill symbol properties. m_pFillSymbol.Outline = pOutline m_pFillSymbol.Style = esriSFSHollow End Sub Private Sub MapControl2_OnAfterDraw(ByValdisplay As Variant, ByVal viewDrawPhase As Long) Ifm_pEnvelope Is Nothing Then Exit Sub 'If the foreground phase has drawn DimpViewDrawPhase As esriViewDrawPhase pViewDrawPhase = viewDrawPhase IfpViewDrawPhase = esriViewForeground Then 'Draw the shape on the MapControl. MapControl2.DrawShape m_pEnvelope, m_pFillSymbol EndIf

End Sub Private Sub m_pTransformEvents_VisibleBoundsUpdated(ByValsender As esriDisplay.IDisplayTransformation, ByVal sizeChanged As Boolean) 'Set the extent to the new visible extent. Setm_pEnvelope = sender.VisibleBounds 'Refresh the MapControl's foreground phase. MapControl2.RefreshesriViewForeground End S

ub 3.在 Form_Load 事件中调用 CreateOverviewSymbol： Private Sub Form_Load() Call CreateOverview
Symbol End Sub 4.在 MapControl1 的 OnMapReplaced 中加入以下代码： Private Sub MapControl1_OnMapReplaced(ByValnewMap As Variant) '当主地图显示控件的地图改变时，鹰眼中的地图也跟随改变 'Get the IActiveView of the focus map in the PageLayoutControl. DimpActiveView As IActiveView SetpActiveView = MapControl1.ActiveView.FocusMap 'Trap the ITransformEvents of the PageLayoutControl's focus map. Setm_pTransformEvents = pActiveView.ScreenDisplay.displayTransformation 'Get the extent of the focus map. Setm_pEnvelope = pActiveView.Extent 'Load the same preauthored map document into the MapControl. MapControl2.LoadMxFile MapControl1.DocumentFilename 'Set the extent of the MapControl to the full extent of the data. MapControl2.Extent = MapControl2.FullExtent End Sub 5.当点击鹰眼中的某个地方时，主窗口的地图跟随着改变： Private Sub MapControl2_OnMouseDown(ByValbutton As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByValmapX As Double, ByVal mapY As Double) Dim pPt As IPoint Set pPt = New Point pPt.PutCoords mapX, mapY '改变主控件的视图范围 MapControl1.CenterAt pPt End Sub 这样地图鹰眼就做好了。

第四步 显示当前地图比例尺及自定义比例尺显示地图 Private SubMapControl1_OnExtentUpdated(ByVal displayTransformation As Variant, ByValsizeChanged As Boolean, ByVal newEnvelope As Variant) Label1.Caption = "1:" & MapControl1.MapScale '显示比例尺 Text1.Text = MapControl1.MapScale End Sub Private Sub Command4_Click() '设置地图显示比例尺 MapControl1.MapScale = Val(Text1.Text) MapControl1.Refresh End Sub 第五步 在状态栏上显示当前鼠标位置坐标： 首先需要当前地图所采用的坐标单位，需要在声明里定义变量 sMapUnits： Private sMapUnits As String '显示坐标用 然后在 MapControl1_OnMapReplaced 里增加代码： Dim pMapUnits As esriUnits pMapUnits = MapControl1.MapUnits IfpMapUnits = esriCentimeters Then sMapUnits = "Centimeters" ElseIf pMapUnits = esriDecimalDegrees Then sMapUnits = "Decimal Degrees" ElseIf pMapUnits = esriDecimeters Then sMapUnits = "Decimeters" ElseIf pMapUnits = esriFeet Then sMapUnits = "Feet" ElseIf pMapUnits = esriInches Then sMapUnits = "Inches" ElseIf pMapUnits = esriKilometers Then sMapUnits = "Kilometers" ElseIf pMapUnits = esriMeters Then sMapUnits = "Meters" ElseIf pMapUnits = esriMiles Then sMapUnits = "Miles" ElseIf pMapUnits = esriMillimeters Then sMapUnits = "Millimeters" ElseIf pMapUnits = esriNauticalMiles Then sMapUnits = "NauticalMiles" ElseIf pMapUnits = esriPoints Then sMapUnits = "Points" ElseIf pMapUnits = esriUnknownUnits Then

sMapUnits = "Unknown" ElseIf pMapUnits = esriYards Then sMapUnits = "Yards" EndIf 接下来只要在 MapControl1_OnMouseMove 里添加代码： Private Sub MapControl1_OnMouseMove(ByValbutton As Long, ByVal shift As Long, ByVal

x As Long, ByVal y As Long, ByValmapX As Double, ByVal mapY As Double) '状态栏上显示坐标 StatusBar1.P
anels(2).Text =Format(mapX, ".00") & " , " & Format(mapY, ".00") & " " &sMapUnits End Sub 第六步 将当前视图范围内的地图导出 Jpg 格式的图片 '把地图保存为图片 CommonDialog1.FileName = "" CommonDialog1.Filter = "JPG 图片(*.JPG)|*.jpg" CommonDialog1.ShowSave If CommonDialog1.FileName <> "" Then Dim lScrRes As Long lScrRes =Me.MapControl1.ActiveView.ScreenDisplay.displayTransformation.Resolu tion Dim pExporter As IExporter Set pExporter = New JpegExporter pExporter.ExportFileName = CommonDialog1.FileName pExporter.Resolution = lScrRes Dim deviceRECT As tagRECT deviceRECT =Me.MapControl1.ActiveView.ScreenDisplay.displayTransformation.Device Frame Dim pDriverBounds As IEnvelope Set pDriverBounds = New Envelope pDriverBounds.PutCoords deviceRECT.Left, deviceRECT.bottom,deviceRECT.Right, deviceRECT.Top pExporter.PixelBounds = pDriverBounds Dim pCancel As ITrackCancel

Set pCancel = New CancelTracker Me.MapControl1.ActiveView.Output pExporter.StartExporting, lScrRes,deviceRECT, Me.MapControl1.ActiveView.Extent, pCancel pExporter.FinishExporting End If 当时做这一步的时候出了点小问题，Set pDriverBounds = New Envelope 这句 老是编译出错，提示“无效使用 New 关键字”。后来通过 QQ 群的高手提醒，说 可能是引用有冲突，只要在 Envelope 前面加上 esriGeometry 就可以了，即： Dim pDriverBounds As esriGeometry.Envelope Set pDriverBounds = NewesriGeometry.Envelope 果然这样就好了。 运行界面：