form1.frm

有关ＶＢ在GIS空间分析方面的应用 深入详解代码大家在这方面多交流啊

VERSION 5.00
Object = "{C552EA90-6FBB-11D5-A9C1-00104BB6FC1C}#1.0#0"; "MapControl.ocx"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7440
   ClientLeft      =   255
   ClientTop       =   450
   ClientWidth     =   8565
   LinkTopic       =   "Form1"
   ScaleHeight     =   7440
   ScaleWidth      =   8565
   Begin VB.ComboBox CobSelect 
      Height          =   315
      Left            =   5760
      TabIndex        =   8
      Top             =   6960
      Width           =   2295
   End
   Begin VB.CommandButton ViewLayer 
      Caption         =   "显示该图层"
      Height          =   375
      Left            =   3960
      TabIndex        =   7
      Top             =   120
      Width           =   2055
   End
   Begin VB.CommandButton Select 
      Caption         =   "选择"
      Height          =   495
      Left            =   4440
      TabIndex        =   6
      Top             =   6840
      Width           =   1095
   End
   Begin VB.CommandButton Extend 
      Caption         =   "居中"
      Height          =   495
      Left            =   3120
      TabIndex        =   5
      Top             =   6840
      Width           =   1095
   End
   Begin VB.CommandButton Pan 
      Caption         =   "漫游"
      Height          =   495
      Left            =   1800
      TabIndex        =   4
      Top             =   6840
      Width           =   1095
   End
   Begin VB.CommandButton ZoomIn 
      Caption         =   "放大"
      Height          =   495
      Left            =   480
      TabIndex        =   3
      Top             =   6840
      Width           =   1095
   End
   Begin VB.ComboBox cboLayers 
      Height          =   315
      Left            =   1320
      TabIndex        =   1
      Top             =   120
      Width           =   2175
   End
   Begin esriMapControl.MapControl MapControl1 
      Height          =   6135
      Left            =   480
      OleObjectBlob   =   "Form1.frx":0000
      TabIndex        =   0
      Top             =   600
      Width           =   7815
   End
   Begin VB.Label Label1 
      Caption         =   "图层"
      Height          =   255
      Left            =   600
      TabIndex        =   2
      Top             =   120
      Width           =   615
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim col As ColumnHeader
Private m_pAoInitialize As IAoInitialize
Dim m_bZoomIn As Boolean
Dim m_bZoomOut As Boolean
Dim m_bSelect As Boolean
Dim m_S_point As Boolean
Dim m_S_line As Boolean
Dim m_S_rect As Boolean
Dim m_S_poly As Boolean
Dim envelope As IEnvelope           '用于矩形查询
Dim m_geoLine As IGeometry          '用于线查询
Dim m_geoPoly As IGeometry          '用于多边形查询

Private Sub cboLayers_Click()
'Dim pActiveView As IActiveView
'Set pActiveView = MapControl1.Map
'pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
MapControl1.Map.ClearSelection
Set m_pCurrentLayer = MapControl1.Layer(cboLayers.ListIndex)
Set m_pLayer = m_pCurrentLayer
End Sub

Private Sub CobSelect_Click()
Select Case CobSelect.ListIndex
Case 0
 m_S_point = True
 m_S_line = False
 m_S_rect = False
 m_S_poly = False
Case 1
 m_S_point = False
 m_S_line = True
 m_S_rect = False
 m_S_poly = False
 Case 2
 m_S_point = False
 m_S_line = False
 m_S_rect = True
 m_S_poly = False
 Case 3
 m_S_point = False
 m_S_line = False
 m_S_rect = False
 m_S_poly = True
End Select

End Sub

Private Sub Extend_Click()
 MapControl1.Extent = MapControl1.FullExtent

End Sub

Private Sub Form_Load()
' 赋值操作变量
 m_bZoomIn = False
 m_bZoomOut = False
 m_bSelect = False
 m_S_point = False
 m_S_line = False
 m_S_rect = False
 m_S_poly = False

 
Set m_pAoInitialize = New AoInitialize
  If m_pAoInitialize Is Nothing Then
    MsgBox "Unable to initialize. This application cannot run!"
    Unload Form1
    Exit Sub
  End If
''测定产品的可用性
'  If m_pAoInitialize.IsProductCodeAvailable(esriLicenseProductCodeEngine) = esriLicenseAvailable Then
'    If m_pAoInitialize.Initialize(esriLicenseProductCodeEngine) <> esriLicenseCheckedOut Then
'      MsgBox "The initialization failed. This application cannot run!"
'      Unload Form1
'      Exit Sub
'    End If
'  Else
'    MsgBox "The ArcGIS Engine product is unavailable. This application cannot run!"
'    Unload Form1
'    Exit Sub
'  End If
  
'向下拉图层combox中添加信息
  Dim i As Integer
  For i = 0 To MapControl1.LayerCount - 1
    cboLayers.AddItem MapControl1.Layer(i).Name, i
  Next i
  Set m_pMap = MapControl1.Map
'确定控制的第一个图层
  cboLayers.ListIndex = 0



End Sub

Private Sub ListFeature_DblClick()
  
End Sub

Private Sub MapControl1_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
m_pMap.ClearSelection


If m_bZoomIn Then
 MapControl1.Extent = MapControl1.TrackRectangle
ElseIf m_bZoomOut Then
 MapControl1.Pan
 
ElseIf m_S_rect Then
 'StartEditing

Set envelope = MapControl1.TrackRectangle
 SelectMouseTrackRectangle envelope
 Form2.Show

ElseIf m_S_point Then
 SelectMouseDown x, y
 Form2.Show
 
ElseIf m_S_line Then
Set m_geoLine = MapControl1.TrackLine
SelectMouseTrackLine m_geoLine
Form2.Show

ElseIf m_S_poly Then
Set m_geoPoly = MapControl1.TrackPolygon
SelectMouseTrackPoly m_geoPoly
Form2.Show

End If
End Sub
Private Sub SetControlStates()

End Sub

Private Sub Pan_Click()
m_bZoomOut = True
m_bSelect = False
m_bZoomIn = False
MapControl1.MousePointer = esriPointerPan
End Sub

Private Sub Select_Click()
CobSelect.Clear
m_bSelect = False
m_bZoomIn = False
m_bZoomOut = False
MapControl1.MousePointer = esriPointerCrosshair
CobSelect.AddItem "点选择 ", 0
CobSelect.AddItem "线选择 ", 1
CobSelect.AddItem "矩形选择 ", 2
CobSelect.AddItem "多边形选择 ", 3
CobSelect.ListIndex = 0

End Sub

Private Sub ViewLayer_Click()
Dim n As Long

'显示选择的图层
For n = 0 To MapControl1.LayerCount - 1
  If MapControl1.Layer(n).Name <> cboLayers.Text Then
    MapControl1.Map.Layer(n).Visible = False
  Else
    MapControl1.Map.Layer(n).Visible = True
  End If
Next n
MapControl1.Refresh

End Sub

Private Sub ZoomIn_Click()
m_bZoomIn = True
m_bZoomOut = False
m_bSelect = False
MapControl1.MousePointer = esriPointerArrow
End Sub

Private Sub ZoomOut_Click()

End Sub