地理信息系统编程设计报告.docx
《地理信息系统编程设计报告.docx》由会员分享，可在线阅读，更多相关《地理信息系统编程设计报告.docx（76页珍藏版）》请在冰豆网上搜索。
地理信息系统编程设计报告
课程设计一ArcEngine地图显示与浏览
一．准备工作
1．打开VB，添加控件
2．添加控件到窗体
3．添加工具栏
效果如下
二．操作步骤
（1）通过设置MapControl和TOCControl控件的属性，完成对图层的加载和控制
1）使用属性向MapControl中添加图层；
效果如下
2）在TOCControl控件的属性中绑定MapControl控件。
效果如下：
（2）编程实现动态向MapControl中添加图层
PrivateSub打开文件_Click（）
DimpGxDialogAsIGxDialog
DimpGxFilterAsIGxObjectFilter
DimpEnumGxObjectsAsIEnumGxObject
DimpLayerAsIFeatureLayer
DimpGxDatasetAsIGxDataset
SetpGxDialog=NewGxDialog
'过滤非FeatureClasses类型的对象
SetpGxFilter=NewGxFilterFeatureClasses
WithpGxDialog
.AllowMultiSelect=True'允许选择多个文件
.Title="打开..."
.ButtonCaption="添加图层"
Set.ObjectFilter=pGxFilter
.DoModalOpenMe.hWnd,pEnumGxObjects
'=========================
'如果是保存
.Title="保存..."
'.DoModalSaveMe.hWnd
'=========================
EndWith
IfpEnumGxObjectsIsNothingThenExitSub
pEnumGxObjects.Reset'重置枚举器
'遍历所有在GxDialog对话框中选择的对象，并加载到MapControl
SetpGxDataset=pEnumGxObjects.Next
WhileNotpGxDatasetIsNothing
SetpLayer=NewFeatureLayer
SetpLayer.FeatureClass=pGxDataset.Dataset
pLayer.Name=pLayer.FeatureClass.AliasName
Me.MapControl1.AddLayerpLayer
'下一个
SetpGxDataset=pEnumGxObjects.Next
Wend
Me.TOCControl1.Update'刷新TocControl
CallSmallMap_UpDateData
Me.SmallMap.Refresh
DimpmapAsIMap
DimaAsInteger
'得到控件中地图
Setpmap=MapControl1.Map
'清空combo控件中文字
Combo1.Clear
'遍历所有图层将图层名称加入combo控件
Fora=0Topmap.LayerCount-1
Combo1.AddItempmap.Layer（a）.Name
Next
'初始显示最上层图层名称
Combo1.ListIndex=0
m_moveft=False
EndSub
运行效果：
（3）编程实现MapControl中图层的移动、隐藏和卸载
这三种功能均需要调用函数GetLayerByName
PrivateFunctionGetLayerByName（ByRefMapctrlAsMapControl,ByValstrNameAsString）AsILayer
Dimi,CountAsInteger
WithMapctrl
Count=.LayerCount
Fori=0ToCount-1
If（.Layer（i）.Name=strName）Then
SetGetLayerByName=.Layer（i）
ExitFunction
EndIf
Next
EndWith
EndFunction
1．移动图层
PrivateSub图层移动_Click（）
DimlyerAsILayer
OnErrorGoToErr
Setlyer=GetLayerByName（Form1.MapControl1,Combo1.Text）
Form1.MapControl1.Map.MoveLayerlyer,Int（Text1.Text）
Form1.MapControl1.Refresh
Form1.SmallMap.Refresh
ExitSub
Err:
MsgBox"输入图层不存在，请重新输入"
EndSub
运行效果：
Eg：
将办公楼图层移动到第0层
结果：
该图层到达第0层
2．图层的隐藏
PrivateSub图层隐藏_Click（）
OnErrorGoToErr
DimlyerAsILayer
Setlyer=GetLayerByName（Form1.MapControl1,Combo1.Text）
lyer.Visible=False
Form1.MapControl1.Refresh
Form1.SmallMap.Refresh
ExitSub
Err:
MsgBox"输入图层不存在，请重新输入"
EndSub
运行效果：
Eg：
隐藏道路1图层
隐藏前
隐藏后
在Mapcontrol中已经没有，但是TOCControl中依然存在，只是未被勾选
3．图层卸载
PrivateSub图层卸载_Click（）
DimlyerAsILayer
Setlyer=GetLayerByName（Form1.MapControl1,Combo1.Text）
Form1.MapControl1.Map.DeleteLayerlyer
Form1.MapControl1.Refresh
Form1.SmallMap.Refresh
EndSub
运行效果
Eg：
卸载跑道图层
卸载前：
卸载后：
可以看到Mapcontrol和TOCControl中都没有这个图层了。
（4）编程实现地图浏览操作，主要包括漫游、全图显示、放大缩小
PrivateSubMapControl1_OnMouseDown（ByValbuttonAsLong,ByValshiftAsLong,ByValXAsLong,ByValYAsLong,ByValmapXAsDouble,ByValmapYAsDouble）
SelectCaseMapOper
CasePan'如果是漫游操作
Me.MapControl1.Pan
CaseMapOperations.ZoomIn'如果是拉框放大
Me.MapControl1.Extent=Me.MapControl1.TrackRectangle
CaseMapOperations.ZoomOut'如果是拉框缩小
DimpRectangleAsIEnvelope
DimpEnvelopeAsIEnvelope
DimnewWidth,newHeightAsInteger
WithMe.MapControl1
SetpRectangle=.TrackRectangle
newWidth=.Extent.Width*（.Extent.Width/pRectangle.Width）
newHeight=.Extent.Height*（.Extent.Height/pRectangle.Height）
SetpEnvelope=NewEnvelope
pEnvelope.PutCoords.Extent.XMin-（（pRectangle.XMin-.Extent.XMin）*（.Extent.Width/pRectangle.Width））,_
.Extent.YMin-（（pRectangle.YMin-.Extent.YMin）*（.Extent.Height/pRectangle.Height））,_
（.Extent.XMin-（（pRectangle.XMin-.Extent.XMin）*（.Extent.Width/pRectangle.Width）））+newWidth,_
（.Extent.YMin-（（pRectangle.YMin-.Extent.YMin）*（.Extent.Height/pRectangle.Height）））+newHeight
.Extent=pEnvelope
EndWith
EndSelect
isExtentUpdated=True
EndSub
PrivateSub放大_Click（）
DimpCloneAsIClone
DimpEnvelopeAsIEnvelope
SetpClone=Me.MapControl1.Extent
SetpEnvelope=pClone.Clone'创建Me.MapControl1.Extent的副本
pEnvelope.Expand0.5,0.5,True'改变Envelope的大小
Me.MapControl1.Extent=pEnvelope
isExtentUpdated=True
EndSub
PrivateSub拉框放大_Click（）
MapOper=ZoomIn
Me.MapControl1.MousePointer=esriPointerZoomIn
EndSub
PrivateSub拉框缩小_Click（）
MapOper=ZoomOut
Me.MapControl1.MousePointer=esriPointerZoomOut
EndSub
PrivateSub漫游_Click（）
MapOper=Pan
Me.MapControl1.MousePointer=esriPointerPan
EndSub
PrivateSub全屏显示_Click（）
Me.MapControl1.Extent=Me.MapControl1.FullExtent
isExtentUpdated=True
EndSub
PrivateSub缩小_Click（）
DimpCloneAsIClone
DimpEnvelopeAsIEnvelope
SetpClone=Me.MapControl1.Extent'创建Me.MapControl1.Extent的副本
SetpEnvelope=pClone.Clone'改变Envelope的大小
pEnvelope.Expand2,2,True
Me.MapControl1.Extent=pEnvelope
isExtentUpdated=True
EndSub
（5）编程实现通过在图层控制面板上拖动图层改变图层的叠放顺序
PrivateSubTOCControl1_OnEndLabelEdit（ByValxAsLong,ByValyAsLong,ByValnewLabelAsString,CanEditAsBoolean）
IfLen（Trim（newLabel））<>0AndCanEdit=TrueThen
Else
CanEdit=False'把图层名称设置为原先的值
EndIf
'注意：
这里仅仅上修改MapControl中的图层名称，而不是数据库或文件
'中的图层名称
EndSub
PrivateSubTOCControl1_OnMouseDown（ByValbuttonAsLong,ByValshiftAsLong,ByValxAsLong,ByValyAsLong）
DimpLyrAsILayer
DimpIndexAsInteger
DimpMapAsIMap
DimpOtherAsIUnknown
DimpItemAsesriTOCControlItem
'调用HitTest方法
Ifbutton=vbLeftButtonThen
Me.TOCControl1.HitTestx,y,pItem,pMap,pLyr,pOther,pIndex
IfpItem=esriTOCControlItemLayerThen'如果点击的是图层才执行操作
IfpLyrIsNothingThenExitSub'如果没有点击到图层
IfTypeOfplyerIsIAnnotationSublayer_
ThenExitSub'如果点击的是注记层，则退出
SetpMovedLyr=pLyr'记录被点击的图层，用于拖动
EndIf
EndIf
'测试HitTest方法返回的参数值
'MsgBox"图层数：
"&pMap.LayerCount&",类型：
"&pItem&_
"，Index：
"&pIndex&"，图层名称：
"&pLyr.Name
EndSub
PrivateSubTOCControl1_OnMouseMove（ByValbuttonAsLong,ByValshiftAsLong,ByValxAsLong,ByValyAsLong）
DimpMapAsIMap
DimpLayerAsILayer
DimpOtherAsIUnknown
DimpItemAsesriTOCControlItem
DimpIndexAsVariant
'实现调整图层顺序功能
If（button=vbLeftButton）Then
Me.TOCControl1.HitTestx,y,pItem,pMap,pLayer,pOther,pIndex
'如果拖动的对象存在并且鼠标为系统光标样式，则更改为我们自定义的
'“拖动光标”
IfpItem<>esriTOCControlItemNoneAndMe.TOCControl1.MousePointer_
<>esriPointerCustomThen
Me.TOCControl1.MousePointer=esriPointerCustom
'SetMe.TOCControl1.MouseIcon=LoadResPicture（"MOVE",vbResCursor）
EndIf
EndIf
EndSub
PrivateSubTOCControl1_OnMouseUp（ByValbuttonAsLong,ByValshiftAsLong,ByValxAsLong,ByValyAsLong）
DimpLyrAsILayer
DimpIndexAsInteger
DimpMapAsIMap
DimpOtherAsIUnknown
DimpItemAsesriTOCControlItem
DimiAsInteger
DimcountAsInteger
'调用HitTest方法
Ifbutton=vbLeftButtonThen
Me.TOCControl1.HitTestx,y,pItem,pMap,pLyr,pOther,pIndex
IfpItem=esriTOCControlItemLayerThen'如果点击的是图层才执行操作
IfpLyrIsNothingThenExitSub'如果没有点击到图层
'如果点击的是注记层，则退出
IfTypeOfplyerIsIAnnotationSublayerThenExitSub
count=pMap.LayerCount
'查找Mouse_Up位置的图层的Index
Fori=0Tocount-1
IfpLyrIspMap.Layer（i）ThenExitFor'找到图层后退出
Next
pMap.MoveLayerpMovedLyr,i'移动被拖动的图层
Me.TOCControl1.Update'更新TocControl
EndIf
Me.TOCControl1.MousePointer=esriPointerDefault'恢复鼠标
EndIf
EndSub
（6）鹰眼系统开发
PrivateSubSmallMap_UpDateData（）
'当主地图装载、卸载了数据或当主地图的图层顺序改变时，
'调用次函数更新鹰眼图中的数据
DimiAsInteger
DimcountAsInteger
WithMe.MapControl1
count=.LayerCount
Fori=0Tocount-1
'这里注意，一定要保证两个地图控件中，图层顺序一致
Me.SmallMap.AddLayer.Layer（i）,i
Next
EndWith
Me.SmallMap.Extent=Me.SmallMap.FullExtent
EndSub
PrivateSubDrawViewRectInSmallMap（ByValpEnvAsIEnvelope）
'调用此方法在鹰眼中绘制一个红色的矩形方框，来标识视图在
'地图中的位置
DimpCurEnvAsIEnvelope
DimpGContainerAsIGraphicsContainer
DimpActViewAsIActiveView
DimpElementAsIElement
DimpFillElementAsIFillShapeElement
DimpColorAsIColor
DimpOutLineAsILineSymbol
DimpFillSymbolAsIFillSymbol
SetpCurEnv=pEnv'获得主地图的视图范围
SetpGContainer=Me.SmallMap.Map'设置GraphicsContainer
SetpActView=Me.SmallMap.ActiveView'获得视图对象，用于刷新
pGContainer.DeleteAllElements
SetpElement=NewRectangleElement'创建要绘制的Element
pElement.Geometry=pCurEnv
'设置矩形的的填充色[红色],即显示在鹰眼上的红色方框线的颜色
SetpColor=NewRgbColor
pColor.RGB=255'红色
'设置矩形的边框
SetpOutLine=NewSimpleLineSymbol
WithpOutLine
.Width=1
.Color=pColor
EndWith
'把矩形的填充色设置为透明
SetpColor=NewRgbColor
pColor.Transparency=0
'设置面填充的符号，用于填充矩形
SetpFillSymbol=NewSimpleFillSymbol
WithpFillSymbol
.Color=pColor
.Outline=pOutLine
EndWith
SetpFillElement=pElement
pFillElement.Symbol=pFillSymbol
'绘制矩形方框
pGContainer.AddElementpElement,0
pActView.PartialRefreshesriViewGraphics,Nothing,Nothing
EndSub
PrivateSubMapControl1_OnExtentUpdated（ByValdisplayTransformationAs_
Variant,ByValsizeChangedAsBoolean,ByValnewEnvelopeAsVariant）
CallDrawViewRectInSmallMap（newEnvelope）
EndSub
实现通过对SmallMap的操作实现对MapControl1的控制。
代码如下：
PrivateSubSmallMap_OnMouseDown（ByValbuttonAsLong,ByValshiftAsLong,ByValXAsLong,ByValYAsLong,ByValmapXAsDouble,ByValmapYAsDouble）
m_move=True
DimpPtAsIPoint
SetpPt=Newpoint
pPt.PutCoordsmapX,mapY'改变主地图视野范围
MapControl1.CenterAtpPt
EndSub
PrivateSubSmallMap_OnMouseMove（ByValbuttonAsLong,ByValshiftAsLong,ByValXAsLong,ByValYAsLong,ByValmapXAsDouble,ByValmapYAsDouble）
Ifm_move=TrueThen
DimpPtAsIPoint
SetpPt=Newpoint
pPt.PutCoordsmapX,mapY'改变主地图视野范围
MapControl1.Cen
升级会员 