1、wordYUNNAN NORMAL UNIVERSITY本科學生實驗報告學號某某學院專業、班級實驗課程名稱教師與職稱開課學期至學年學期填報時間年月日某某師X大學教務處編印實驗序號實驗名稱空間查詢0 / 12word實驗時間 2014年5月8日 實驗室 GIS實驗室一.實驗預習1 .實驗目的通過繪制圖形實現對 shap巾le文件的查詢2 .實驗原理、實驗流程或裝置示意圖試驗濃縮版步驟或者流程圖借助VB工具和MO模塊實現畫點、線、面、多邊形，shap刊e文件的查詢。3 .實驗設備與材料計算機，VB6.0軟件，MO組件。(1)實驗方法步驟與須知事項一：利用VB工具制作界面添加按鈕，圖像顯示框，圖像目

2、錄框架；首先在部件里面加載：ESRI MapObjects2.2； ESRI MapObjects LegendControl;Microsoft mon Dialog Controls 6.0; Microsoft Windows mon Controls6.0。窗體1界面;窗體二界面:1 / 12word二：在代碼窗口編寫代碼窗體1代碼如下：Option ExplicitDim pShape As ObjectPrivate Sub mand1_Click()End SubPrivate Sub Map1_AfterTrackingLayerDraw(ByVal hDC As stdole

3、.OLE_HANDLE)If Not pt Is Nothing Then pSym.Color = moBlue Map1.DrawShape pt, pSymEnd IfIf Not pLine Is Nothing Then pSym.Color = moBlue Map1.DrawShape pLine, pSymEnd IfIf Not pRectangle Is Nothing Then2 / 12wordpSym.SymbolType = moFillSymbol pSym.Style = moTransparentFill pSym.Color = moBlue pSym.Ou

4、tlineColor = moBlue Map1.DrawShape pRectangle, pSymEnd IfIf Not pPolygon Is Nothing Then pSym.OutlineColor = moBlue pSym.SymbolType = moFillSymbol pSym.Style = moTransparentFill Map1.DrawShape pPolygon, pSymEnd IfIf Not pSel Is Nothing Then pSymSel.Color = moYellow Map1.DrawShape pSel, pSymSel End I

5、fEnd SubPrivate Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If frmAdSpatialSel.Toolbar1.Buttons(Points).Value = 1 ThenSet pt = Map1.ToMapPoint(X, Y) Set pShape = pt ExecuteSearchDisplaySelFeatureElseIf frmAdSpatialSel.Toolbar1.Buttons(Lines).Value = 1 ThenSet pSh

6、ape = pLine ExecuteSearchDisplaySelFeatureElseIf frmAdSpatialSel.Toolbar1.Buttons(Rectangles).Value = 1 ThenSet pShape = pRectangle ExecuteSearchDisplaySelFeatureElseIf frmAdSpatialSel.Toolbar1.Buttons(Polygons).Value = 1 ThenSet pShape=pPolygon3 / 12wordExecuteSearchDisplaySelFeatureElself frmAdSpa

7、tialSel.Toolbar1.Buttons(sel).Value = 1 ThenDim theTol As SingleSet pts = Map1.ToMapPoint(X, Y)Setrecs=Map1.Layers(frmAdSpatialSel.cboLayer.ListIndex).SearchByDistance(pts, theTol,)If recs.EOF = False ThenSet pShape = recs(Shape).ValueExecuteSearchDisplaySelFeatureElseEnd IfEnd IfEnd SubSub ExecuteS

8、earch()Set pSel = NothingSet pSel = Map1.Layers(frmAdSpatialSel.cboLayer.ListIndex).SearchShape(pShape, frmAdSpatialSel.cboMethod.ListIndex,)End Sub用表顯示選中圖形Sub DisplaySelFeature()If Not pSel Is Nothing ThenDim i As IntegerDim recscount As Integer*以下代碼用來填充msgflexgridDim m As IntegerDim n As Integerre

9、cscount = recscount + 1 Loop4 / 12wordMsgBox recsCountfrmAdSpatialSel.MSFlexGrid1.Cols = tDesc.FieldCount + 1frmAdSpatialSel.MSFlexGrid1.Rows = recscount + 1frmAdSpatialSel.MSFlexGrid1.AllowUserResizing = flexResizeColumnsfrmAdSpatialSel.MSFlexGrid1.CellAlignment = flexAlignLeftCenterfrmAdSpatialSel

10、.MSFlexGrid1.ColWidth(i) = tDesc.FieldLength(i - 1) * 72 Next ito filled the fields name into gridfrmAdSpatialSel.MSFlexGrid1.TextMatrix(0, 0)=特征 IDFor i = 1 To recscountfrmAdSpatialSel.MSFlexGrid1.TextMatrix(i, 0) = ifrmAdSpatialSel.MSFlexGrid1.CellAlignment = flexAlignLeftCenterNext iFor i = 0 To

11、tDesc.FieldCount - 1frmAdSpatialSel.MSFlexGrid1.TextMatrix(0, i + 1) = tDesc.FieldName(i) frmAdSpatialSel.MSFlexGrid1.ColAlignment(i) = flexAlignLeftCenter frmAdSpatialSel.MSFlexGrid1.ColWidth(i) = 1200 Next ifrmAdSpatialSel.MSFlexGrid1.ColAlignment(0) = flexAlignCenterCenter frmAdSpatialSel.MSFlexG

12、rid1.ColWidth(0) = 680For m = 1 To recscountFor n = 0 To tDesc.FieldCount - 1frmAdSpatialSel.MSFlexGrid1.TextMatrix(m, n +1)pSel.Fields(tDesc.FieldName(n).ValueNext nNext mEnd IfEnd Sub窗體2代碼如下:Private Sub cmdCenter_Click() On Error Resume NextDim Rect As Rectangle,Rect2 As Rectangle5 / 12wordDim sha

13、peX As Double, shapeY As DoubleDim deltax As Double, deltay As DoubleDim reo As Integerreo = MSFlexGrid1.Row - 1記錄指針移動到屬性數據表選擇中的記錄上For i = 0 To reo - 1Next iSet theShape = pSel(shape).ValueIf pSel(shape).Type = moPoint ThenRect2.Offset deltax, deltayForm1.Map1.Extent = Rect2ElseForm1.Map1.Extent = R

14、ectEnd IfSet Rect2 = NothingSet theShape = NothingEnd SubPrivate Sub cmdFlash_Click()Call MovePointCall flash_shapeEnd Sub、*閃爍Private Sub flash_shape() On Error Resume NextForm1.Map1.FlashShape pSel(shape).Value, 3End Sub6 / 12word移動Private Sub MovePoint() On Error Resume NextDim reo As IntegerDim i

15、 As Integerreo = MSFlexGrid1.Row - 1記錄指針移動到屬性數據表選擇中的記錄上For i = 0 To reo - 1Next iEnd Sub*Private Sub Form_Load()SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZEIf layer.LayerType = 0 Theni = i + 1End If Next layer cboLayer.ListIndex = 0初始化空間搜索方法cboMethod.AddItem 重疊cboMethod.A

16、ddItem ”有一個公共點cboMethod.AddItem 邊緣相交cboMethod.AddItem ”有一條公共邊cboMethod.AddItem ”有公共點或邊緣相交 cboMethod.AddItem 有交集 cboMethod.AddItem 內交cboMethod.AddItem ”內交、 但邊緣不相交7 / 12wordcboMethod.AddItem 特征包含形cboMethod.AddItem ”形包含特征cboMethod.AddItem 特征完全包含形cboMethod.AddItem ”形完全包含特征cboMethod.AddItem 特征包含形的第一個點cbo

17、Method.AddItem ”形包含特征的中心”cboMethod.AddItem 特征和形一樣cboMethod.ListIndex = 5End SubPrivate Sub MSFlexGrid1_Click()cmdCenter_ClickEnd SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As ctlLib.Button)去除選中的圖形一If Button.Key = Clean ThenIf Not pt Is Nothing Then Set pt = NothingIf Not pLine Is Nothing Then

18、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 = 0MSFlexGrid1.Rows = 0Form1.Map1.TrackingLayer.Refresh TrueEnd IfEnd Sub模塊代碼如下：Option Explicit窗體總位于最上邊Public Declare Function SetWindowPos Lib user32 (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Lon