地理信息系统编程设计报告.docx
- 文档编号:12673630
- 上传时间:2023-06-07
- 格式:DOCX
- 页数:76
- 大小:748.98KB
地理信息系统编程设计报告.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
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 地理信息系统 编程 设计 报告