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

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 Sub

3.在Form_Load 事件中调用CreateOverviewSymbol：

Private Sub Form_Load()

Call CreateOverviewSymbol

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.Panels(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

果然这样就好了。

运行界面：