overview.frm

电子地图鹰眼代码（ArcGis9版）

VERSION 5.00
Object = "{BA01FAC9-2AB7-4CC9-9732-938340408ACE}#1.0#0"; "PageLayoutControl.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{47FEE649-934B-4D92-8427-66F6C221B029}#1.0#0"; "LicenseControl.ocx"
Begin VB.Form Form1 
   Caption         =   "Overview"
   ClientHeight    =   5430
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5805
   LinkTopic       =   "Form1"
   ScaleHeight     =   5430
   ScaleWidth      =   5805
   StartUpPosition =   3  'Windows Default
   Begin esriLicenseControl.LicenseControl LicenseControl1 
      Left            =   480
      OleObjectBlob   =   "Overview.frx":0000
      Top             =   1080
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   4080
      Top             =   3000
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.TextBox txbMxPath 
      Enabled         =   0   'False
      Height          =   285
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   3735
   End
   Begin VB.CommandButton cmdLoadMxFile 
      Caption         =   "Load Mx File"
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Top             =   75
      Width           =   1695
   End
   Begin VB.CommandButton cmdZoomPage 
      Caption         =   "Zoom To Page"
      Height          =   375
      Left            =   3960
      TabIndex        =   2
      Top             =   4920
      Width           =   1695
   End
   Begin esriPageLayoutControl.PageLayoutControl PageLayoutControl1 
      Height          =   4695
      Left            =   120
      OleObjectBlob   =   "Overview.frx":0039
      TabIndex        =   1
      Top             =   600
      Width           =   3735
   End
   Begin esriPageLayoutControl.PageLayoutControl PageLayoutControl2 
      Height          =   2175
      Left            =   3960
      OleObjectBlob   =   "Overview.frx":0AF7
      TabIndex        =   0
      Top             =   600
      Width           =   1695
   End
   Begin VB.Label Label2 
      Caption         =   "Use the left mouse button to drag a rectangle and  the right mouse button to pan. "
      Height          =   855
      Left            =   3960
      TabIndex        =   5
      Top             =   3960
      Width           =   1815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Copyright 1995-2005 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 Sub cmdLoadMxFile_Click()
    
  'Open a file dialog for selecting map documents
  CommonDialog1.DialogTitle = "Browse Map Document"
  CommonDialog1.Filter = "Map Documents (*.mxd)|*.mxd"
  CommonDialog1.ShowOpen
  
  'Exit if no map document is selected
  Dim sFilePath As String
  sFilePath = CommonDialog1.FileName
  If sFilePath = "" Then Exit Sub
  
  'Validate and load the Mx document
  If PageLayoutControl1.CheckMxFile(sFilePath) Then
    txbMxPath.Text = sFilePath
    PageLayoutControl1.MousePointer = esriPointerHourglass
    PageLayoutControl1.LoadMxFile sFilePath
    PageLayoutControl1.MousePointer = esriPointerDefault
  Else
    MsgBox sFilePath & " is not a valid ArcMap document"
  End If
  
End Sub
Private Sub cmdZoomPage_Click()
  
  'Zoom to the whole page
  PageLayoutControl1.ZoomToWholePage
  
  'Get the IElement interface by finding an element by its name
  Dim pElement As IElement
  Set pElement = PageLayoutControl2.FindElementByName("ZoomExtent")
  If Not pElement Is Nothing Then
    'Delete the element
    PageLayoutControl2.GraphicsContainer.DeleteElement pElement
    'Refresh the graphics
    PageLayoutControl2.Refresh esriViewGraphics
  End If
  
End Sub
Private Sub Form_Load()
    
  'Set PageLayoutControl properties
  PageLayoutControl1.Enabled = True
  PageLayoutControl2.Enabled = False
  PageLayoutControl1.Appearance = esri3D
  PageLayoutControl2.Appearance = esriFlat
  PageLayoutControl1.BorderStyle = esriBorder
  PageLayoutControl2.BorderStyle = esriNoBorder
  
End Sub

Private Sub PageLayoutControl1_OnExtentUpdated(ByVal displayTransformation As Variant, ByVal sizeChanged As Boolean, ByVal newEnvelope As Variant)
  
  'QI for IEnvelope
  Dim pEnvelope As IEnvelope
  Set pEnvelope = newEnvelope
  
  'Get the IElement interface by finding an element by its name
  Dim pElement As IElement
  Set pElement = PageLayoutControl2.FindElementByName("ZoomExtent")
  If Not pElement Is Nothing Then
    'Delete the graphic
    PageLayoutControl2.GraphicsContainer.DeleteElement pElement
  End If
  Set pElement = New RectangleElement

  'Get the IRGBColor interface
  Dim pColor As IRgbColor
  Set pColor = New RgbColor
  'Set the color properties
  pColor.RGB = RGB(255, 0, 0)
  pColor.Transparency = 255

  'Get the ILine symbol interface
  Dim pOutline As ILineSymbol
  Set pOutline = New SimpleLineSymbol
  'Set the line symbol properties
  pOutline.Width = 10
  pOutline.Color = pColor

  'Set the color properties
  Set pColor = New RgbColor
  pColor.RGB = RGB(255, 0, 0)
  pColor.Transparency = 0

  'Get the IFillSymbol properties
  Dim pFillSymbol As IFillSymbol
  Set pFillSymbol = New SimpleFillSymbol
  'Set the fill symbol properties
  pFillSymbol.Color = pColor
  pFillSymbol.Outline = pOutline

  'QI for IFillShapeElement interface through the IElement interface
  Dim pFillShapeElement As IFillShapeElement
  Set pFillShapeElement = pElement
  'Set the symbol property
  pFillShapeElement.Symbol = pFillSymbol

  'Add the element
  PageLayoutControl2.AddElement pElement, newEnvelope, , "ZoomExtent"
  'REfresh the graphics
  PageLayoutControl2.Refresh esriViewGraphics

End Sub
Private Sub PageLayoutControl1_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal pageX As Double, ByVal pageY As Double)
  
  'Zoom in
  If button = 1 Then
    PageLayoutControl1.Extent = PageLayoutControl1.TrackRectangle
  'Pan
  ElseIf button = 2 Then
    PageLayoutControl1.Pan
  End If
  
End Sub
Private Sub PageLayoutControl1_OnPageLayoutReplaced(ByVal newPageLayout As Variant)
  
  'Get the file path
  Dim sFilePath As String
  sFilePath = txbMxPath.Text
  'Validate and load the Mx document
  If PageLayoutControl2.CheckMxFile(sFilePath) Then
    PageLayoutControl2.LoadMxFile (sFilePath)
  End If

End Sub