geoevent.frm

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

VERSION 5.00
Object = "{C552EA90-6FBB-11D5-A9C1-00104BB6FC1C}#1.0#0"; "MapControl.ocx"
Begin VB.Form Form1 
   Caption         =   "On Her Majesty's Secret Service"
   ClientHeight    =   7710
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10200
   LinkTopic       =   "Form1"
   ScaleHeight     =   7710
   ScaleWidth      =   10200
   StartUpPosition =   3  'Windows Default
   Begin esriMapControl.MapControl MapControl1 
      Height          =   6975
      Left            =   120
      OleObjectBlob   =   "geoevent.frx":0000
      TabIndex        =   3
      Top             =   120
      Width           =   9975
   End
   Begin VB.CommandButton cmdFullExtent 
      Caption         =   "Zoom to Full Extent"
      Height          =   375
      Left            =   8280
      TabIndex        =   1
      Top             =   7200
      Width           =   1815
   End
   Begin VB.CheckBox chkTracking 
      Caption         =   "Enable GPS Tracking"
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   7320
      Width           =   2055
   End
   Begin VB.Timer Timer1 
      Left            =   7680
      Top             =   7200
   End
   Begin VB.Label Label1 
      Caption         =   "Use the left hand mouse button to zoom in. Use the other mouse buttons to click on an agent and change the symbology.  "
      Height          =   495
      Left            =   2160
      TabIndex        =   2
      Top             =   7200
      Width           =   5295
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Copyright 1995-2004 ESRI

' All rights reserved under the copyright laws of the United States.

' You may freely redistribute and use this sample code, with or without modification.

' Disclaimer: THE SAMPLE CODE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED
' WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
' FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ESRI OR
' CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
' OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
' SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
' INTERRUPTION) SUSTAINED BY YOU OR A THIRD PARTY, HOWEVER CAUSED AND ON ANY
' THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ARISING IN ANY
' WAY OUT OF THE USE OF THIS SAMPLE CODE, EVEN IF ADVISED OF THE POSSIBILITY OF
' SUCH DAMAGE.

' For additional information contact: Environmental Systems Research Institute, Inc.

' Attn: Contracts Dept.

' 380 New York Street

' Redlands, California, U.S.A. 92373

' Email: [e-mail]

Option Explicit

Private m_pAoInitialize As IAoInitialize
Private m_pGeographicCoordinateSystem As IGeographicCoordinateSystem
Private m_pProjectedCoordinateSystem As IProjectedCoordinateSystem
Private m_pGraphicsContainer As IGraphicsContainer

Private Type AGENT_IN_FIELD
  Latitude As Double
  Longitude As Double
  CodeNumber As String
  Located As Boolean
End Type
Private agentArray(20) As AGENT_IN_FIELD

Private Sub chkTracking_Click()
  
  'Turn the timer on or off
  Timer1.Interval = chkTracking.Value * 800

End Sub
Private Sub cmdFullExtent_Click()
  
  MapControl1.Extent = MapControl1.FullExtent

End Sub
Private Sub Form_Load()
  
  'Create a new AoInitialize object
  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
  'Determine if the product is available
  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
  
  'Find sample data
  Dim sFilePath As String
  sFilePath = "D:\arcgis\DeveloperKit\samples\data\world"
  
  'Add sample shapefile data
  MapControl1.AddShapeFile sFilePath, "world30"
  MapControl1.AddShapeFile sFilePath, "dissolveCntry"
  
  'Symbolize the data
  SymbolizeData MapControl1.Layer(0), 0.1, GetRGBColor(0, 0, 0), GetRGBColor(0, 128, 0)
  SymbolizeData MapControl1.Layer(1), 0.1, GetRGBColor(0, 0, 0), GetRGBColor(140, 196, 254)
  'Set up a global Geographic Coordinate System
  MakeCoordinateSystems
  
  'Get the MapControl's graphics container and get the IGraphicsContainer interface
  Set m_pGraphicsContainer = MapControl1.ActiveView.GraphicsContainer
    
  'Populate an array with agent id's and locations
  LoadAgentArray
    
  'Loop through the array and display each agent location
  Dim i As Integer
  For i = 0 To 19
    DisplayAgentLocation agentArray(i)
  Next i
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
  
  'Shut down the AoInitilaize object
  m_pAoInitialize.Shutdown

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)
  
  'If left mouse button then zoom in
  If button = 1 Then
    MapControl1.Extent = MapControl1.TrackRectangle
  Else
    'Create a point and get the IPoint interface
    Dim pPoint As IPoint
    Set pPoint = New Point
    'Set points coordinates
    pPoint.PutCoords mapX, mapY
    
    'QI for ITopologicalOperator interface through IPoint interface
    Dim pTopologicalOperator As ITopologicalOperator
    Set pTopologicalOperator = pPoint
    'Create a polygon by buffering the point and get the IPolygon interface
    Dim pPolygon As IPolygon
    Set pPolygon = pTopologicalOperator.Buffer(MapControl1.Extent.Width * 0.02)
    'QI for IRelationalOperator interface through IPolygon interface
    Dim pRelationalOperator As IRelationalOperator
    Set pRelationalOperator = pPolygon
    
    'Draw the polygon
    MapControl1.DrawShape pPolygon
    
    'Loop through the elements in the GraphicContainer and get the IElement interface
    m_pGraphicsContainer.Reset
    Dim pElement As IElement
    Set pElement = m_pGraphicsContainer.Next
    Do While Not pElement Is Nothing
      'If the polygon contains the point
      If (pRelationalOperator.Contains(pElement.Geometry) = True) Then
        'QI for IMarkerElement interface through IElement interface
        Dim pMarkerElement As IMarkerElement
        Set pMarkerElement = pElement
        pMarkerElement.Symbol = GetMarkerSymbol(True)
        'QI for the IElementProperties interface through IElement interface
        Dim pElementProperties As IElementProperties
        Set pElementProperties = pElement
        pElementProperties.Name = True
      End If
      Set pElement = m_pGraphicsContainer.Next
    Loop
    If chkTracking.Value = False Then
      'Refresh the graphics
      MapControl1.Refresh esriViewGraphics
    End If
  End If

End Sub
Private Sub Timer1_Timer()
  
  'Distance used in calculating the new point location
  Dim dMaxDistance As Double
  dMaxDistance = MapControl1.Extent.Width / 20
  
  'Loop through the elements in the GraphicContainer and get the IElement interface
  m_pGraphicsContainer.Reset
  Dim pElement As IElement
  Set pElement = m_pGraphicsContainer.Next
  
  Do While Not pElement Is Nothing
    'QI for IElementProperties interface from IElement interface
    Dim pElementProperties As IElementProperties
    Set pElementProperties = pElement
    'If agent has not been located
    If pElementProperties.Name = False Then
      'Get hold of the IPoint interface from the elements geometry