spatial.frm

用于河南省主体功能区区划的一个小地理信息系统

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmSpatial 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "空间选择"
   ClientHeight    =   5925
   ClientLeft      =   15
   ClientTop       =   1380
   ClientWidth     =   4020
   Icon            =   "Spatial.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5925
   ScaleWidth      =   4020
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdExportShapefile 
      Caption         =   "将所选记录集转为shp文件"
      Height          =   375
      Left            =   480
      TabIndex        =   15
      Top             =   5400
      Width           =   3015
   End
   Begin VB.CheckBox chkDrawBuffer 
      Caption         =   "生成缓冲区"
      Height          =   255
      Left            =   1800
      TabIndex        =   14
      Top             =   3840
      Value           =   1  'Checked
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.PictureBox picSymbol 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   720
      ScaleHeight     =   345
      ScaleWidth      =   345
      TabIndex        =   13
      Top             =   1440
      Width           =   375
   End
   Begin VB.TextBox txtDistance 
      Height          =   285
      Left            =   1560
      TabIndex        =   12
      Top             =   3480
      Width           =   1695
   End
   Begin VB.CommandButton cmdApply 
      Caption         =   "应用选择"
      Height          =   315
      Left            =   480
      TabIndex        =   7
      Top             =   5040
      Width           =   1515
   End
   Begin VB.ComboBox cboMethod 
      Height          =   300
      ItemData        =   "Spatial.frx":0442
      Left            =   240
      List            =   "Spatial.frx":0444
      Style           =   2  'Dropdown List
      TabIndex        =   6
      Top             =   3000
      Width           =   3735
   End
   Begin VB.CommandButton cmdClearSelection 
      Caption         =   "清除选择"
      Height          =   315
      Left            =   2040
      TabIndex        =   5
      Top             =   5040
      Width           =   1455
   End
   Begin VB.ComboBox cboLayer 
      Height          =   300
      Left            =   240
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   1080
      Width           =   2655
   End
   Begin VB.ComboBox cboUsing 
      Height          =   300
      Left            =   240
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   2400
      Width           =   3735
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3480
      Top             =   960
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      FontSize        =   2.54016e-29
   End
   Begin VB.Label lblDistance 
      Caption         =   "4.请输入距离"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   11
      Top             =   3480
      Width           =   1335
   End
   Begin VB.Line Line2 
      X1              =   120
      X2              =   3960
      Y1              =   4200
      Y2              =   4200
   End
   Begin VB.Line Line1 
      X1              =   120
      X2              =   3960
      Y1              =   720
      Y2              =   720
   End
   Begin VB.Label lblClickOnSymbol 
      Caption         =   "改变所选对象的显示特征"
      ForeColor       =   &H00404040&
      Height          =   435
      Left            =   1200
      TabIndex        =   10
      Top             =   1440
      Width           =   1095
   End
   Begin VB.Label lblAction 
      Caption         =   "可通过在地图上鼠标画图形选择图层要素；也可通过点击“应用选择”按钮在不同图层间进行空间选择"
      Height          =   555
      Left            =   120
      TabIndex        =   9
      Top             =   4320
      Width           =   3555
   End
   Begin VB.Label lblDescription 
      Caption         =   "  可通过鼠标画图形或指定图层来选择对象，而且所作的选择是累积的，直到清除选择或退出"
      ForeColor       =   &H00000000&
      Height          =   615
      Left            =   180
      TabIndex        =   8
      Top             =   120
      Width           =   3675
   End
   Begin VB.Label lblWhere 
      Caption         =   "3.指定空间选择的方法"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   2760
      Width           =   3390
   End
   Begin VB.Label lblSelect 
      Caption         =   "1. 选择对象所在图层"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   840
      Width           =   3915
   End
   Begin VB.Label lblUsing 
      Caption         =   "2.以鼠标画图形选择，或引用已选对象选择其他图形特征"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   120
      TabIndex        =   1
      Top             =   1920
      Width           =   3750
   End
End
Attribute VB_Name = "frmSpatial"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' Results of spatial search
Private g_selectedFeatures As MapObjects2.Recordset

' Search shapes when using other features to search.
Private g_searchSet As MapObjects2.Recordset

' Search shape when using rubberbanded shape to search
Private g_searchShape As Object

Private g_selectedBounds As MapObjects2.Rectangle
Private g_searchBounds As MapObjects2.Rectangle
Private g_searchDistance As Double

Private Sub Form_Load()
  'Position to the right of the main form
  Me.Move frmmain.Left + frmmain.width, frmmain.Top
  If (Me.Left + Me.width) > Screen.width Then
    Me.Left = Screen.width - Me.width
  End If
  
  Set g_selectedFeatures = Nothing
  Set g_searchShape = Nothing
  Set g_searchSet = Nothing
  Set g_selectedBounds = Nothing
  Set g_searchBounds = Nothing
  
  cmdApply.Enabled = False
  TxtDistance.Visible = False
  lblDistance.Visible = False
  
  ' fill "Select:" layers combobox
  Dim layer As Object
  Dim i As Integer
  
  i = 0
  For Each layer In frmmain.Map1.Layers
    If layer.LayerType = 0 Then
      cboLayer.AddItem layer.name
      i = i + 1
    End If
  Next layer
  If i > 0 Then cboLayer.ListIndex = 0

  ' fill "Using:" layers combobox
  cboUsing.AddItem "鼠标画点"
  cboUsing.AddItem "鼠标画线"
  cboUsing.AddItem "鼠标画矩形"
  cboUsing.AddItem "鼠标画多边形"
  cboUsing.ListIndex = 0
  
  ' fill operations listbox
  cboMethod.AddItem "图形 与 图层要素 范围重叠"                   '0
  cboMethod.AddItem "图形 与 图层要素 至少具有一个公共点"      '1
  cboMethod.AddItem "图形 与 图层要素 相交"                   '2
  cboMethod.AddItem "图形 与 图层要素 至少具有一个公共线段"    '3
  cboMethod.AddItem "图形 与 图层要素 具有一个公共点或相交"    '4
  cboMethod.AddItem "图形 与 图层要素 接触，图形一般为矩形或多边形"  '5
  cboMethod.AddItem "图层要素 部分或全部包含 图形"  '6
  cboMethod.AddItem "图形要素 包含 图形，但不相交" '7
  cboMethod.AddItem "图层要素 包含 图形"               '8
  cboMethod.AddItem "图形 包含 图层要素"               '9
  cboMethod.AddItem "图层要素 完全包含 图形"           '10
  cboMethod.AddItem "图形 完全包含 图层要素"           '11
  cboMethod.AddItem "图层要素 包含 图形(点特征)"       '12
  cboMethod.AddItem "图形 包含 图层要素 的中心"        '13
  cboMethod.AddItem "图形 与 图层要素 具有相同的特征"   '14
  cboMethod.AddItem "图形在图层要素一定距离内"          '15
  cboMethod.ListIndex = 0
  
  ' Set initial selection color
  picSymbol.BackColor = moMagenta
End Sub

Private Sub Form_Terminate()
'  Call cmdClearSelection
  Set g_selectedFeatures = Nothing
  Set g_searchShape = Nothing
  Set g_searchSet = Nothing
  Set g_selectedBounds = Nothing
  Set g_searchBounds = Nothing
  frmmain.Map1.TrackingLayer.Refresh True
  frmmain.Toolbar1.Buttons("select").Value = tbrPressed
End Sub

Private Sub Form_Unload(cancel As Integer)
  Set g_selectedFeatures = Nothing
  Set g_searchShape = Nothing
  Set g_searchSet = Nothing
  Set g_selectedBounds = Nothing
  Set g_searchBounds = Nothing
  frmmain.Map1.TrackingLayer.Refresh True
  
End Sub

Public Sub DrawSelectedFeatures(ByVal hDC As stdole.OLE_HANDLE)
  
  'This is public because it is used by frmMain.mapDisp.AfterTrackingLayerDraw
  'to draw the selected features onto the map.
  
  If g_searchBounds Is Nothing And g_selectedBounds Is Nothing Then Exit Sub
  
  ' Either g_searchSet or g_searchShape will be valid.
  DrawSpatialRecordset g_selectedFeatures, picSymbol.BackColor, moSolidFill
  DrawSpatialRecordset g_searchSet, moYellow, moTransparentFill
  DrawSpatialShape g_searchShape, moYellow, moTransparentFill
End Sub

Public Sub SelectFeatures(Button As Integer, Shift As Integer, X As Single, Y As Single)
  
  ' This is public because it is called by frmMain.mapDisp_MouseDown
  
  ' If one of the shape select tools is active, get
  ' the search shape(s) and use them to select features.
  ' The search shape(s) can either be a simple shape
  ' (g_searchShape) rubberbanded by the user or a set
  ' of features (g_searchSet).
  Dim searchLayer As Integer
  searchLayer = cboUsing.ListIndex - 1
  
  If cboUsing.ListIndex = 0 Then