空间查询实验报告.doc

. . . . .本科学生实验报告学号 姓名 学院 专业、班级 实验课程名称 教师及职称 开课学期 至 学年 学期填报时间 年 月 日云南师范大学教务处编印实验序号实验名称空间查询实验时间2014年5月8日实验室GIS实验室一实验预习1实验目的通过绘制图形实现对shapfile文件的查询2实验原理、实验流程或装置示意图（试验浓缩版步骤或者流程图） 借助VB工具和MO模块实现画点、线、面、多边形，shapfile文件的查询。3实验设备及材料 计算机，VB6.0软件， MO组件。（1） 实验方法步骤及注意事项一：利用VB工具制作界面（添加按钮，图像显示框，图像目录框架）；首先在部件里面加载：ESRI MapObjects2.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.LineDim pRectangle As MapObjects2.RectangleDim pPolygon 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.Symbol Dim pSym As New MapObjects2.Symbol If Not pt Is Nothing Then pSym.Color = moBlue Map1.DrawShape pt, pSym End If If Not pLine Is Nothing Then pSym.Color = moBlue Map1.DrawShape pLine, pSym End If If Not pRectangle Is Nothing Then pSym.SymbolType = moFillSymbol pSym.Style = moTransparentFill pSym.Color = moBlue pSym.OutlineColor = moBlue Map1.DrawShape pRectangle, pSym End If If Not pPolygon Is Nothing Then pSym.OutlineColor = moBlue pSym.SymbolType = moFillSymbol pSym.Style = moTransparentFill Map1.DrawShape pPolygon, pSym End If If Not pSel Is Nothing Then pSymSel.Color = moYellow Map1.DrawShape pSel, pSymSel End IfEnd SubPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If frmAdSpatialSel.Toolbar1.Buttons(Points).Value = 1 Then Set pt = Map1.ToMapPoint(X, Y) Set pShape = pt ExecuteSearch DisplaySelFeature ElseIf frmAdSpatialSel.Toolbar1.Buttons(Lines).Value = 1 Then Set pLine = Map1.TrackLine Set pShape = pLine ExecuteSearch DisplaySelFeature ElseIf frmAdSpatialSel.Toolbar1.Buttons(Rectangles).Value = 1 Then Set pRectangle = Map1.TrackRectangle Set pShape = pRectangle ExecuteSearch DisplaySelFeature ElseIf frmAdSpatialSel.Toolbar1.Buttons(Polygons).Value = 1 Then Set pPolygon = Map1.TrackPolygon Set pShape = pPolygon ExecuteSearch DisplaySelFeature ElseIf frmAdSpatialSel.Toolbar1.Buttons(sel).Value = 1 Then Dim theTol As Single theTol = 0.01 Dim pts As MapObjects2.Point Set pts = Map1.ToMapPoint(X, Y) Set recs = Map1.Layers(frmAdSpatialSel.cboLayer.ListIndex).SearchByDistance(pts, theTol, ) If recs.EOF = False Then Set pShape = recs(Shape).Value ExecuteSearch DisplaySelFeature Else End If End If Map1.RefreshEnd SubSub ExecuteSearch() Set pSel = Nothing Set pSel = Map1.Layers(frmAdSpatialSel.cboLayer.ListIndex).SearchShape(pShape, frmAdSpatialSel.cboMethod.ListIndex, )End Sub用表显示选中图形 Sub DisplaySelFeature() If Not pSel Is Nothing Then Dim tDesc As MapObjects2.TableDesc Dim i As Integer Set tDesc = pSel.TableDesc Dim recscount As Integer * 以下代码用来填充msgflexgrid Dim m As Integer Dim n As Integer pSel.MoveFirst Do While Not pSel.EOF pSel.MoveNext recscount = recscount + 1 Loop MsgBox recsCount frmAdSpatialSel.MSFlexGrid1.Cols = tDesc.FieldCount + 1 frmAdSpatialSel.MSFlexGrid1.Rows = recscount + 1 frmAdSpatialSel.MSFlexGrid1.AllowUserResizing = flexResizeColumns frmAdSpatialSel.MSFlexGrid1.Clear frmAdSpatialSel.MSFlexGrid1.CellAlignment = flexAlignLeftCenter For i = 1 To tDesc.FieldCount frmAdSpatialSel.MSFlexGrid1.ColWidth(i) = tDesc.FieldLength(i - 1) * 72 Next i to filled the fields name into grid frmAdSpatialSel.MSFlexGrid1.TextMatrix(0, 0) = 特征 ID For i = 1 To recscount frmAdSpatialSel.MSFlexGrid1.TextMatrix(i, 0) = i frmAdSpatialSel.MSFlexGrid1.CellAlignment = flexAlignLeftCenter Next i For i = 0 To tDesc.FieldCount - 1 frmAdSpatialSel.MSFlexGrid1.TextMatrix(0, i + 1) = tDesc.FieldName(i) frmAdSpatialSel.MSFlexGrid1.ColAlignment(i) = flexAlignLeftCenter frmAdSpatialSel.MSFlexGrid1.ColWidth(i) = 1200 Next i frmAdSpatialSel.MSFlexGrid1.ColAlignment(0) = flexAlignCenterCenter frmAdSpatialSel.MSFlexGrid1.ColWidth(0) = 680 pSel.MoveFirst For m = 1 To recscount For n = 0 To tDesc.FieldCount - 1 frmAdSpatialSel.MSFlexGrid1.TextMatrix(m, n + 1) = pSel.Fields(tDesc.FieldName(n).Value Next n pSel.MoveNext Next m pSel.MoveFirst frmAdSpatialSel.MSFlexGrid1.Refresh End IfEnd Sub窗体2代码如下：Private Sub cmdCenter_Click() On Error Resume Next Dim Rect As Rectangle, Rect2 As Rectangle Dim shapeX As Double, shapeY As Double Dim deltax As Double, deltay As Double Dim theShape As Object, pinPoint As MapObjects2.Point Dim recNo As Integer recNo = MSFlexGrid1.Row - 1 pSel.MoveFirst 记录指针移动到属性数据表选择中的记录上 For i = 0 To recNo - 1 pSel.MoveNext Next i Set theShape = pSel(shape).Value If pSel(shape).Type = moPoint Then Set Rect2 = Form1.Map1.Extent shapeX = pSel(shape).Value.X shapeY = pSel(shape).Value.Y deltax = shapeX - Rect2.Center.X deltay = shapeY - Rect2.Center.Y Rect2.Offset deltax, deltay Rect2.ScaleRectangle 0.1 Form1.Map1.Extent = Rect2 Else Set Rect = pSel(shape).Value.Extent Rect.ScaleRectangle 1.1 Form1.Map1.Extent = Rect End If Set Rect2 = Nothing Set theShape = NothingEnd SubPrivate Sub cmdFlash_Click() Call MovePoint Call flash_shapeEnd Sub*闪烁Private Sub flash_shape() On Error Resume Next Form1.Map1.FlashShape pSel(shape).Value, 3End Sub移动Private Sub MovePoint() On Error Resume Next Dim recNo As Integer Dim i As Integer recNo = MSFlexGrid1.Row - 1 pSel.MoveFirst 记录指针移动到属性数据表选择中的记录上 For i = 0 To recNo - 1 pSel.MoveNext Next iEnd Sub*Private Sub Form_Load() SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Dim layer As MapObjects2.MapLayer Set layer = New MapObjects2.MapLayer cboLayer.Clear For Each layer In Form1.Map1.Layers If layer.LayerType = 0 Then cboLayer.AddItem layer.Name i = i + 1 End If Next layer cboLayer.ListIndex = 0 初始化空间搜索方法 cboMethod.AddItem 重叠 cboMethod.AddItem 有一个公共点 cboMethod.AddItem 边缘相交 cboMethod.AddItem 有一条公共边 cboMethod.AddItem 有公共点或边缘相交 cboMethod.AddItem 有交集 cboMethod.AddItem 内交 cboMethod.AddItem 内交，但边缘不相交 cboMethod.AddItem 特征包含形 cboMethod.AddItem 形包含特征 cboMethod.AddItem 特征完全包含形 cboMethod.AddItem 形完全包含特征 cboMethod.AddItem 特征包含形的第一个点 cboMethod.AddItem 形包含特征的中心 cboMethod.AddItem 特征和形相同 cboMethod.ListIndex = 5End SubPrivate Sub MSFlexGrid1_Click() cmdCenter_ClickEnd SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button) 清除选中的图形 If Button.Key = Clean Then MSFlexGrid1.Clear If Not pt Is Nothing Then Set pt = Nothing If Not pLine Is Nothing Then Set pLine = Nothing If Not pRectangle Is Nothing Then Set pRectangle = Nothing If Not pPolygon Is Nothing Then Set pPolygon = Nothing If Not pSel Is Nothing Then Set pSel = Nothing MSFlexGrid1.Cols = 0 MSFlexGrid1.Rows = 0