空间查询实验报告

1、本科学生实验报告学号学院姓名专业、班级实验课程名称教师及职称开课学期至学年学期填报时间年月日_云南师范大学教务处编印实验序号实验名称空间查询实验时间2014 年 5 月 8 日实验室GIS 实验室一实验预习1实验目的通过绘制图形实现对shapfile 文件的查询2实验原理、实验流程或装置示意图（试验浓缩版步骤或者流程图）借助 VB 工具和 MO 模块实现画点、线、面、多边形，shapfile 文件的查询。3实验设备及材料计算机， VB6.0 软件， MO 组件。（ 1） 实验方法步骤及注意事项一：利用 VB 工具制作界面（添加按钮，图像显示框，图像目录框架）；首先在部件里面加载： ESRI M

2、apObjects2.2 ；ESRI MapObjects LegendControl;；Microsoft Common Dialog Controls 6.0；Microsoft Windows Common Controls6.0。等窗体 1 界面；精品资料_窗体二界面：二：在代码窗口编写代码窗体 1 代码如下：Option ExplicitDim pShape As ObjectDim pt As MapObjects2.PointDim pLine As MapObjects2.Line精品资料_Dim pRectangle As MapObjects2.RectangleDim p

3、Polygon As MapObjects2.PolygonDim recs As MapObjects2.RecordsetPrivate Sub Command1_Click()frmAdSpatialSel.ShowEnd SubPrivate Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole.OLE_HANDLE)Dim pSymSel As New MapObjects2.SymbolDim pSym As New MapObjects2.SymbolIf Not pt Is Nothing ThenpSym.Color = mo

4、BlueMap1.DrawShape pt, pSymEnd IfIf Not pLine Is Nothing ThenpSym.Color = moBlueMap1.DrawShape pLine, pSymEnd IfIf Not pRectangle Is Nothing Then精品资料_pSym.SymbolType = moFillSymbolpSym.Style = moTransparentFillpSym.Color = moBluepSym.OutlineColor = moBlueMap1.DrawShape pRectangle, pSymEnd IfIf Not p

5、Polygon Is Nothing ThenpSym.OutlineColor = moBluepSym.SymbolType = moFillSymbolpSym.Style = moTransparentFillMap1.DrawShape pPolygon, pSymEnd IfIf Not pSel Is Nothing ThenpSymSel.Color = moYellowMap1.DrawShape pSel, pSymSelEnd IfEnd SubPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer,

6、X As Single, YAs Single)精品资料_Set pt = Map1.ToMapPoint(X, Y)Set pShape = ptExecuteSearchDisplaySelFeatureSet pLine = Map1.TrackLineSet pShape = pLineExecuteSearchDisplaySelFeatureSet pRectangle = Map1.TrackRectangleSet pShape = pRectangleExecuteSearchDisplaySelFeatureSet pPolygon = Map1.TrackPolygonS

7、et pShape = pPolygonExecuteSearch精品资料_DisplaySelFeatureDim theTol As SingletheTol = 0.01Dim pts As MapObjects2.PointSet pts = Map1.ToMapPoint(X, Y)Setrecs=theTol,"")If recs.EOF = False ThenSet pShape = recs("Shape").ValueExecuteSearchDisplaySelFeatureElseEnd IfEnd IfMap1.RefreshE

8、nd SubSub ExecuteSearch()Set pSel = Nothing精品资料_SetpSel=End Sub'用表显示选中图形Sub DisplaySelFeature()If Not pSel Is Nothing ThenDim tDesc As MapObjects2.TableDescDim i As IntegerSet tDesc = pSel.TableDescDim recscount As Integer'*'以下代码用来填充msgflexgridDim m As IntegerDim n As IntegerpSel.MoveFir

9、stDo While Not pSel.EOFpSel.MoveNextrecscount = recscount + 1Loop精品资料_' MsgBox recsCountfrmAdSpatialSel.MSFlexGrid1.Cols = tDesc.FieldCount + 1frmAdSpatialSel.MSFlexGrid1.Rows = recscount + 1frmAdSpatialSel.MSFlexGrid1.AllowUserResizing = flexResizeColumnsfrmAdSpatialSel.MSFlexGrid1.ClearfrmAdSp

10、atialSel.MSFlexGrid1.CellAlignment = flexAlignLeftCenterFor i = 1 To tDesc.FieldCountfrmAdSpatialSel.MSFlexGrid1.ColWidth(i) = tDesc.FieldLength(i-1)*72Next i'to filled the fields name into grid特征 ID"For i = 1 To recscountNext iFor i = 0 To tDesc.FieldCount - 1i+1)=tDesc.FieldName(i)精品资料_Ne

11、xt ipSel.MoveFirstFor m = 1 To recscountFor n = 0 To tDesc.FieldCount - 1n+1)=pSel.Fields(tDesc.FieldName(n).ValueNext npSel.MoveNextNext mpSel.MoveFirstEnd IfEnd Sub窗体 2 代码如下：Private Sub cmdCenter_Click()' On Error Resume Next精品资料_Dim Rect As Rectangle, Rect2 As RectangleDim shapeX As Double, s

12、hapeY As DoubleDim deltax As Double, deltay As DoubleDim theShape As Object, pinPoint As MapObjects2.PointDim recNo As IntegerrecNo = MSFlexGrid1.Row - 1pSel.MoveFirst'记录指针移动到属性数据表选择中的记录上For i = 0 To recNo - 1pSel.MoveNextNext iSet theShape = pSel("shape").ValueIf pSel("shape"

13、;).Type = moPoint ThenshapeX = pSel("shape").Value.XshapeY = pSel("shape").Value.YRect2.Offset deltax, deltay精品资料_Rect2.ScaleRectangle 0.1ElseSet Rect = pSel("shape").Value.ExtentRect.ScaleRectangle 1.1End IfSet Rect2 = NothingSet theShape = NothingEnd SubPrivate Sub cm

14、dFlash_Click()Call MovePointCall flash_shapeEnd Sub'*'闪烁Private Sub flash_shape()'End Sub精品资料_'移动Private Sub MovePoint()' On Error Resume NextDim recNo As IntegerDim i As IntegerrecNo = MSFlexGrid1.Row - 1pSel.MoveFirst'记录指针移动到属性数据表选择中的记录上For i = 0 To recNo - 1pSel.MoveNextNe

15、xt iEnd Sub'*Private Sub Form_Load()SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE OrSWP_NOSIZE精品资料_Dim layer As MapObjects2.MapLayerSet layer = New MapObjects2.MapLayercboLayer.ClearIf layer.LayerType = 0 ThencboLayer.AddItem layer.Namei = i + 1End IfNext layercboLayer.ListIndex = 0

16、'初始化空间搜索方法cboMethod.AddItem " 重叠 "cboMethod.AddItem " 有一个公共点 "cboMethod.AddItem " 边缘相交 "cboMethod.AddItem " 有一条公共边 "cboMethod.AddItem " 有公共点或边缘相交 "cboMethod.AddItem " 有交集 "cboMethod.AddItem " 内交 "cboMethod.AddItem " 内交，但边

17、缘不相交 "cboMethod.AddItem " 特征包含形 "精品资料_cboMethod.AddItem " 形包含特征 "cboMethod.AddItem " 特征完全包含形 "cboMethod.AddItem " 形完全包含特征 "cboMethod.AddItem " 特征包含形的第一个点"cboMethod.AddItem " 形包含特征的中心 "cboMethod.AddItem " 特征和形相同 "cboMethod.Lis

18、tIndex = 5End SubPrivate Sub MSFlexGrid1_Click()cmdCenter_ClickEnd SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)'清除选中的图形If Button.Key = "Clean" ThenMSFlexGrid1.ClearIf Not pt Is Nothing Then Set pt = NothingIf Not pLine Is Nothing Then Set pLine = NothingIf Not pRectangle Is Nothing Then Set pRectangle = NothingIf Not pPolygon Is Nothing Then Set pPolygon = NothingIf Not pSel Is Nothing Then Set pSel = NothingMSFlexGrid1.Cols = 0精品资