GIS应用系统中图形的绘制.docx
- 文档编号:18099335
- 上传时间:2023-08-13
- 格式:DOCX
- 页数:31
- 大小:242.57KB
GIS应用系统中图形的绘制.docx
《GIS应用系统中图形的绘制.docx》由会员分享,可在线阅读,更多相关《GIS应用系统中图形的绘制.docx(31页珍藏版)》请在冰点文库上搜索。
GIS应用系统中图形的绘制
重庆交通大学
学生实验报告
实验课程名称地理信息系统软件二次开发
开课实验室空间数据处理实验室
学院河海学院年级2008专业班1
学生姓名学号08260117
开课时间2011至2012学年第1学期
总成绩
教师签名
目录
实验三GIS应用系统中图形的绘制3
一、实验内容3
二、实验要求3
三、实验步骤3
1、系统基本界面的完善;3
2、绘点12
3、绘线14
4、绘多边形17
5、绘矩形20
6、绘椭圆22
7、添加文本25
8、添加事件27
9、添加符号28
四、实验成果29
五、实验心得29
实验三GIS应用系统中图形的绘制
一、实验内容
1、学习运用代码在所编系统中绘制基本图形;
2、学习运用代码在所编系统中添加文本、事件及符号;
3、完善系统。
二、实验要求
1、实现系统界面的完善,实现在主窗体中调用多个窗体;
2、实现在系统中绘制点;
3、实现在系统中绘制线;
4、实现在系统中绘制多边形;
5、实现在系统中绘制矩形;
6、实现在系统中绘椭圆;
7、实现在系统中添加文本;
8、实现在系统中编辑事件;
9、实现在系统中绘制符号。
三、实验步骤
1、系统基本界面的完善;
修改工程名,修改窗体名,设置窗体图标,编辑菜单,编辑快捷键图标,添加内容窗口,设置鹰眼窗口,添加基本地图窗口,在代码窗口中进行基本界面的设置,
运行结果后,系统基本界面如图3-1
图3-1
由图,可发现系统中菜单选项变多,且添加了状态栏。
点击“图形绘制”菜单,可以看到新增加的图形绘制选项,如图3-2,
图3-2
添加数据后,如图3-3,
图3-3
可以发现内容窗口中显现了所添加数据的名称及其类型,在鹰眼窗口中可以观察到数据的局部情况。
其放大、缩小漫游功能较之前的实验也有所变化,如图3-4(图像的放大),图3-5(放大后的图像),图3-6(图像漫游),
图3-4(图形的放大)
图3-5(放大后的图像)
图3-6(图像漫游)
经过操作可以发现,放大、缩小、图像时,可以画矩形圈定放大/缩小的范围,平移时指针变成了“手掌”,可以按照“手掌”所到处平移图像。
修改后系统的代码为:
DimbooAsBoolean
'定义一个布尔型变量,主要是判断是否进行缩放或者平移
PrivateSubForm_Load()
FrmMain.WindowState=2
Map1.Width=Screen.Width-3400
Map1.Height=Screen.Height-2450
'调整MAP的界面
layercontrol.Width=Screen.Width-17300
Map2.Width=Screen.Width-17300
layercontrol.Height=Screen.Height-6000
Map2.Height=Screen.Height-8450
'调整内容窗口和鹰眼窗口的界面
FrmMain.WindowState=2
StatusBar1.Panels(4).Text="重庆交通大学地理信息系统"
EndSub
PrivateSubLayerControl_AfterSetLayerVisible(IndexAsInteger,isVisibleAsBoolean)
Map1.Refresh
EndSub
PrivateSubMap1_Click()
DimrAsMapObjects2.Rectangle'表示声明一个MO的矩形变量r
Setr=Map1.Extent'设置r的矩形范围是当前显示范围的矩形框
r.ScaleRectangle1.5'设置显示框的放大倍数为2
Map1.Extent=r'重新按照缩小值进行显示
EndSub
PrivateSubMap1_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
IfbooThen
'放大状态
DimtmpExtentAsMapObjects2.Rectangle
'跟踪用户输入的矩形显示范围
SettmpExtent=Map1.TrackRectangle
IfNottmpExtentIsNothingThen
'设置MapControl的当前显示范围为用户输入的矩形
SetMap1.Extent=tmpExtent
EndIf
Else
'进入平移漫游状态,跟踪鼠标动作
Map1.Pan
EndIf
EndSub
PrivateSubMap1_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
'及时获取图面上点的坐标
'======================================================================================
DimmoPt2AsNewMapObjects2.Point
SetmoPt2=Map1.ToMapPoint(X,Y)
StatusBar1.Panels
(1).Text="地图:
X="+Format(moPt2.X,"#.00")+"Y="+Format(moPt2.Y,"#.00")
StatusBar1.Panels
(2).Text="控件:
X="+Format(X,"#.00")+"Y="+Format(Y,"#.00")
'Map1.MousePointer=moArrowQuestion
'=====================================================================================
EndSub
PrivateSubMnuDrawGraphicEli_Click()
Frmellipse.Show
EndSub
PrivateSubMnuDrawGraphicEvent_Click()
Frmaddevent.Show
EndSub
PrivateSubMnuDrawGraphicLine_Click()
'frmaddline.Show
Frmline.Show
EndSub
PrivateSubMnuDrawGraphicPoint_Click()
'frmaddpoint.Show
Frmpoint.Show
EndSub
PrivateSubMnuDrawGraphicPoly_Click()
Frmpoly.Show
EndSub
PrivateSubMnuDrawGraphicRec_Click()
Frmrectangle.Show
EndSub
PrivateSubMnuDrawGraphicSym_Click()
Frmsymbol.Show
EndSub
PrivateSubMnuDrawGraphicText_Click()
Frmtext.Show
EndSub
PrivateSubMnuFileOpen_Click(IndexAsInteger)
'添加文件
'第一步,定义一个新的MO对象组的DataConnection对象
DimdconnAsNewMapObjects2.DataConnection
'第二步,定义一个新的MO对象组的MapLayer对象
DimshplayerAsNewMapObjects2.MapLayer
'设置对话框过滤器
CommonDialog1.Filter="ESRIShapefiles(*.shp)|*.shp"
'对话框显示为打开类型的对话框
CommonDialog1.ShowOpen
IfLen(CommonDialog1.FileName)=0ThenExitSub
'设置DataConnection对象的方法Connection连接到当前目录
dconn.Database=CurDir
IfNotdconn.ConnectThenExitSub
FileName=Left(CommonDialog1.FileTitle,Len(CommonDialog1.FileTitle))'为什么此处不减四
dconn.Connect
Setshplayer.GeoDataset=dconn.FindGeoDataset(FileName)'此处不加引号且不能添加固定文件
Map1.Layers.Addshplayer
'============================================================================
'设置图层控制控件的图源是Map1的图源
layercontrol.setMapSourceMap1
'让图层控制控件的作用生效
layercontrol.LoadLegendTrue
'============================================================================
'鹰眼窗口
Map2.Layers.Addshplayer
Map2.Refresh
EndSub
PrivateSubMnuViewAll_Click()
Map1.Extent=Map1.FullExtent
EndSub
PrivateSubMnuViewPan_Click()
'DimbuttonAsInteger,shiftAsInteger,xAsSingle,yAsSingle
boo=False
Map1.MousePointer=moPan
'此处有待改进
EndSub
PrivateSubMnuViewZoomIn_Click()
'标志放大状态为真
boo=True
'设置鼠标指针
'DimrAsMapObjects2.Rectangle
'Setr=Map1.Extent
'r.ScaleRectangle0.5
'Map1.Extent=r
Map1.MousePointer=moZoomIn
EndSub
PrivateSubMnuViewZoomOut_Click()
Map1.MousePointer=moZoomOut
'DimrAsMapObjects2.Rectangle
'Setr=Map1.Extent
'r.ScaleRectangle1.5
'Map1.Extent=r
'此为机械缩小
'设置鼠标指针
EndSub
PrivateSubToolbar1_ButtonClick(ByValButtonAsMSComctlLib.Button)
OnErrorResumeNext
SelectCaseButton.Key
Case"打开"
CallMnuFileOpen_Click
(1)'为什么此处必选1
Case"整个视图"
CallMnuViewAll_Click
Case"放大"
CallMnuViewZoomIn_Click
Case"缩小"
CallMnuViewZoomOut_Click
Case"漫游"
CallMnuViewPan_Click'为什么此处不添加索引号也行为什么
EndSelect
EndSub
2、绘点
由于学生水平局限,不能够在一个窗体中完成所有功能的,因此此实验在多个窗体中实现,添加名为“Frmpoint”的窗口,设置其界面,在代码窗口中写入以下代码:
DimbooAsBoolean
'定义一个布尔型变量,主要是判断是否进行缩放或者平移
DimptsAsMapObjects2.Points'定义一个点集对象
DimpAsPoint'定义一个点变量
DimsymAsNewSymbol'定义一个符号变量
PrivateSubForm_Load()
Frmpoint.WindowState=2
Map1.Width=Screen.Width-3400
Map1.Height=Screen.Height-2450
'调整MAP的界面
layercontrol.Width=Screen.Width-17300
Map2.Width=Screen.Width-17300
layercontrol.Height=Screen.Height-6000
Map2.Height=Screen.Height-8450
'调整内容窗口和鹰眼窗口的界面
FrmMain.WindowState=2
StatusBar1.Panels(4).Text="重庆交通大学地理信息系统"
EndSub
PrivateSubMap1_AfterTrackingLayerDraw(ByValhDCAsstdole.OLE_HANDLE)
sym.Color=moBlue'设置点的颜色
sym.SymbolType=moPointSymbol'设置点的类型
sym.Size=5'设置点的大小
IfNotptsIsNothingThen
Map1.DrawShapepts,sym
EndIf
EndSub
PrivateSubMap1_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
Setpts=NewMapObjects2.Points
Setp=Map1.ToMapPoint(X,Y)
pts.Addp
Map1.TrackingLayer.RefreshTrue
'Map2.Layers.Addp
'Map2.Refresh
EndSub
PrivateSubMap1_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
'及时获取图面上点的坐标
'======================================================================================
DimmoPt2AsNewMapObjects2.Point
SetmoPt2=Map1.ToMapPoint(X,Y)
StatusBar1.Panels
(1).Text="地图:
X="+Format(moPt2.X,"#.00")+"Y="+Format(moPt2.Y,"#.00")
StatusBar1.Panels
(2).Text="控件:
X="+Format(X,"#.00")+"Y="+Format(Y,"#.00")
'Map1.MousePointer=moArrowQuestion
'======================================================================================
EndSub
PrivateSubMnuDrawGraphicLine_Click()
Frmline.Show
'FrmMain.Hide
EndSub
在主界面调用该窗体,应在主界面的代码中写入:
PrivateSubMnuDrawGraphicPoint_Click()
Frmpoint.Show
EndSub
运行,如图3-7
图3-7
3、绘线
添加名为“Frmline”的窗口,设置其界面,在代码窗口中写入以下代码:
DimbooAsBoolean
'定义一个布尔型变量,主要是判断是否进行缩放或者平移
Dimg_lineAsMapObjects2.Line'定义一个线对象
DimptsAsMapObjects2.Points'定义一个点集对象
PrivateSubForm_Load()
Frmline.WindowState=2
Map1.Width=Screen.Width-3400
Map1.Height=Screen.Height-2450
Map1.Refresh
Map1.Width=Screen.Width-3400
Map1.Height=Screen.Height-2450
'调整MAP的界面
layercontrol.Width=Screen.Width-17300
Map2.Width=Screen.Width-17300
layercontrol.Height=Screen.Height-6000
Map2.Height=Screen.Height-8450
'调整内容窗口和鹰眼窗口的界面
FrmMain.WindowState=2
StatusBar1.Panels(4).Text="重庆交通大学地理信息系统"
EndSub
'PrivateSubCommand1_Click()
'Setg_line=Nothing
'Setpts=Nothing
'Setg_line=NewMapObjects2.Line
'EndSub
PrivateSubMap1_AfterTrackingLayerDraw(ByValhDCAsstdole.OLE_HANDLE)
DimsymAsNewSymbol
IfNotg_lineIsNothingThen
sym.Color=moRed
Map1.DrawShapepts,sym
Ifpts.Count>1Then
sym.Color=moGreen
Map1.DrawShapeg_line,sym
EndIf
EndIf
EndSub
PrivateSubMap1_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
DimpAsPoint
IfButton=1Then
Ifg_lineIsNothingThen
Setg_line=NewMapObjects2.Line
EndIf
IfptsIsNothingThen
Setpts=NewMapObjects2.Points
EndIf
Setp=Map1.ToMapPoint(X,Y)'
pts.Addp
Ifpts.Count=1Then
g_line.Parts.Addpts
Setpts=g_line.Parts(0)
EndIf
Map1.TrackingLayer.RefreshTrue
Else
MsgBox"right"'有问题
EndIf
EndSub
PrivateSubMap1_MouseMove(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)
'及时获取图面上点的坐标
'======================================================================================
DimmoPt2AsNewMapObjects2.Point
SetmoPt2=Map1.ToMapPoint(X,Y)
StatusBar1.Panels
(1).Text="地图:
X="+Format(moPt2.X,"#.00")+"Y="+Format(moPt2.Y,"#.00")
StatusBar1.Panels
(2).Text="控件:
X="+Format(X,"#.00")+"Y="+Format(Y,"#.00")
'Map1.MousePointer=moArrowQuestion
'======================================================================================
EndSub
PrivateSubMnuDrawGraphicPoint_Click()
Frmpoint.Show
'FrmMain.Hide
EndSub
运行,如图3-8
图3-8
4、绘多边形
添加名为“Frmpoly”的窗口,设置其界面,在代码窗口中写入以下代码:
DimbooAsBoolean
'定义一个布尔型变量,主要是判断是否进行缩放或者平移
DimRectAsMapObjects2.Rectangle
DimEliAsMapObjects2.Ellipse
DimPolyAsMapObjects2.Polygon
PrivateSubMap1_AfterTrackingLayerDraw(ByValhDCAsstdole.OLE_HANDLE)
DimsymAsNewMapObjects2.Symbol
sym.SymbolType=moFillSymbol
sym.Style=moDiagonalCrossFill
IfNotRectIsNothingThen
sym.Color=moBlue
Map1.DrawShapeRect,sym
EndIf
IfNotEliIsNothingThen
sym.Color=moRed
Map1.DrawShapeEli,sym
EndIf
IfNotPolyIsNothingThen
sym.Color=moGreen
Map1.DrawShapePoly,sym
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- GIS 应用 系统 图形 绘制