copyfocusmap.frm

使用VB.NET在ArcGIS Engine下面开发的有关地图打印的程序

VERSION 5.00
Object = "{BA01FAC9-2AB7-4CC9-9732-938340408ACE}#1.0#0"; "PageLayoutControl.ocx"
Object = "{C552EA90-6FBB-11D5-A9C1-00104BB6FC1C}#1.0#0"; "MapControl.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         =   "Update MapControl's Map with PageLayoutControl's Focus Map "
   ClientHeight    =   8235
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   14370
   LinkTopic       =   "Form1"
   ScaleHeight     =   8235
   ScaleWidth      =   14370
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command7 
      Caption         =   "Rotate MapControl"
      Height          =   615
      Left            =   8520
      TabIndex        =   10
      Top             =   4920
      Width           =   2535
   End
   Begin VB.CommandButton Command6 
      Caption         =   "Rotate PageLayoutControl"
      Height          =   495
      Left            =   240
      TabIndex        =   9
      Top             =   4920
      Width           =   3135
   End
   Begin VB.CommandButton Command5 
      Caption         =   "Remove Paper Border"
      Height          =   495
      Left            =   240
      TabIndex        =   8
      Top             =   6165
      Width           =   3135
   End
   Begin VB.CommandButton Command4 
      Caption         =   "Remove Frame Border Around Map"
      Height          =   375
      Left            =   240
      TabIndex        =   7
      Top             =   5685
      Width           =   3135
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Extend Map To Whole Control"
      Height          =   495
      Left            =   240
      TabIndex        =   6
      Top             =   6765
      Width           =   3135
   End
   Begin VB.CommandButton Command2 
      Caption         =   "ZoomIn"
      Height          =   375
      Left            =   3645
      TabIndex        =   5
      Top             =   6840
      Width           =   3135
   End
   Begin VB.CommandButton Command1 
      Caption         =   "PutNorthArrow"
      Height          =   495
      Left            =   3735
      TabIndex        =   4
      Top             =   5670
      Width           =   2175
   End
   Begin esriLicenseControl.LicenseControl LicenseControl1 
      Left            =   630
      OleObjectBlob   =   "CopyFocusMap.frx":0000
      Top             =   7395
   End
   Begin VB.TextBox txbPath 
      Enabled         =   0   'False
      Height          =   285
      Left            =   4800
      TabIndex        =   3
      Top             =   285
      Width           =   5535
   End
   Begin VB.CommandButton cmdLoad 
      Caption         =   "Load Map Document"
      Height          =   375
      Left            =   2880
      TabIndex        =   2
      Top             =   240
      Width           =   1815
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   8640
      Top             =   9960
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin esriMapControl.MapControl MapControl1 
      Height          =   3735
      Left            =   8520
      OleObjectBlob   =   "CopyFocusMap.frx":0039
      TabIndex        =   1
      Top             =   960
      Width           =   5655
   End
   Begin esriPageLayoutControl.PageLayoutControl PageLayoutControl1 
      Height          =   3735
      Left            =   240
      OleObjectBlob   =   "CopyFocusMap.frx":63A9
      TabIndex        =   0
      Top             =   960
      Width           =   7575
   End
   Begin VB.Label Label1 
      Caption         =   "www.gisempire.com/bbs"
      Height          =   315
      Left            =   7005
      TabIndex        =   11
      Top             =   6870
      Width           =   6255
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'www.gisempire.com/bbs/index.asp
Dim m_bUpdateFocusMap As Boolean
Dim m_bReplacedPageLayout As Boolean

Dim m_pFeedbackEnv As INewEnvelopeFeedback
Dim m_pPoint As IPoint
Dim m_bIsMouseDown As Boolean

Dim mAngle As Double


Private Sub cboMaps_Click()
 'Get IMapFrame interface
 Dim pElement As IMapFrame
 Set pElement = PageLayoutControl1.FindElementByName(cboMaps.Text)
 'Set the FocusMap
 Set PageLayoutControl1.ActiveView.FocusMap = pElement.Map
End Sub

Private Sub cmdFullExtent_Click()
   m_bUpdateFocusMap = True
  'Zoom to the full extent of the data in the map
  MapControl1.Extent = MapControl1.FullExtent
End Sub
Private Sub cmdZoomPage_Click()

End Sub
Private Sub cmdLoad_Click()
    
  m_bIsMouseDown = False
    
  '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
  
  'If valid map document
  If PageLayoutControl1.CheckMxFile(sFilePath) Then
    'Set mouse pointers
    PageLayoutControl1.MousePointer = esriPointerHourglass
    MapControl1.MousePointer = esriPointerHourglass
    'Reset controls
    MapControl1.ActiveView.Clear
    MapControl1.ActiveView.GraphicsContainer.DeleteAllElements
    MapControl1.Refresh
    'cboMaps.Clear
    txbPath.Text = sFilePath
    'Load map document
    PageLayoutControl1.LoadMxFile sFilePath
    'Set mouse pointers
    PageLayoutControl1.MousePointer = esriPointerDefault
    MapControl1.MousePointer = esriPointerDefault
  Else
    MsgBox sFilePath & " is not a valid ArcMap document"
    Exit Sub
  End If
  
End Sub
Public Sub ListMaps()
  
   
  'Get IGraphicsContainer interface
  Dim pGraphicsContainer As IGraphicsContainer
  Set pGraphicsContainer = PageLayoutControl1.GraphicsContainer
  pGraphicsContainer.Reset
  
  'Query Interface for IElement interface
  Dim pElement As IElement
  Set pElement = pGraphicsContainer.Next
  
  Dim index As Integer
  index = 0
  'Loop through the elements
  Do While Not pElement Is Nothing
  
  'PageLayoutControl1.GraphicsContainer.FindFrame(
  
  
  If TypeOf pElement Is IMap Then
    MsgBox "Blah"
  End If
    'Query interface for IMapFrame interface
    If TypeOf pElement Is IMapFrame Then
      Dim pMapFrame As IMapFrame
      Set pMapFrame = pElement
      
      'Query interface for IElementProperties interface
      Dim pElementProperties As IElementProperties
      Set pElementProperties = pElement
      
      'Get the name of the Map in the MapFrame
      Dim sMapName As String
      sMapName = pMapFrame.Map.Name
      
      'Set the name of the MapFrame to the Map's name
      pElementProperties.Name = sMapName
      'Add the map name to the ComboBox
      'cboMaps.AddItem pMapFrame.Map.Name, index
      
      'If the Map is the FocusMap select the MapName in the ComboBox
      If sMapName = PageLayoutControl1.ActiveView.FocusMap.Name Then
        'cboMaps.ListIndex = index
      End If
      
      index = index + 1
    End If
    Set pElement = pGraphicsContainer.Next
  Loop

End Sub




Private Sub Command6_Click()
  mAngle = mAngle + 10
  Dim pActiveView As IActiveView
  Dim pDisplayTransform As IDisplayTransformation
  Set pActiveView = PageLayoutControl1.ActiveView.FocusMap
  pActiveView.ScreenDisplay.DisplayTransformation.Rotation = mAngle
  pActiveView.PartialRefresh esriViewGeography, Nothing, Nothing
End Sub

Private Sub Command7_Click()
    mAngle = mAngle + 10
    MapControl1.Rotation = mAngle
    MapControl1.Refresh
    
End Sub

Private Sub Form_Load()
  
  m_bUpdateFocusMap = False
  m_bReplacedPageLayout = False
  MapControl1.ShowScrollBars = False
  'PageLayoutControl1.PageLayout.
  
  
End Sub


Private Sub MapControl1_OnAfterScreenDraw(ByVal hdc As Long)
  
  'Set mouse pointers
  PageLayoutControl1.MousePointer = esriPointerDefault
  MapControl1.MousePointer = esriPointerDefault
  
  If m_bUpdateFocusMap = False Then Exit Sub

  'Get IActiveView interface
  Dim pActiveView As IActiveView
  Set pActiveView = PageLayoutControl1.ActiveView.FocusMap

  'Get IDisplayTransformation interface
  Dim pDisplayTransformation As IDisplayTransformation
  Set pDisplayTransformation = pActiveView.ScreenDisplay.DisplayTransformation

  'Set the visible extent of the focus map
  pDisplayTransformation.VisibleBounds = MapControl1.Extent
  'Refresh the focus map
  pActiveView.Refresh
  
  m_bUpdateFocusMap = False
  
End Sub
Private Sub MapControl1_OnBeforeScreenDraw(ByVal hdc As Long)
  
  'Set mouse pointers
  PageLayoutControl1.MousePointer = esriPointerHourglass
  MapControl1.MousePointer = esriPointerHourglass

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_bUpdateFocusMap = True
    
  If button = 1 Then
    MapControl1.Extent = MapControl1.TrackRectangle
  ElseIf button = 2 Then
    MapControl1.Pan
  End If
  
End Sub
Public Sub CopyAndOverwriteMap()
    
  'Get IObjectCopy interface
  Dim pObjectCopy As IObjectCopy
  Set pObjectCopy = New ObjectCopy

  'Get IUnknown interface (map to copy)
  Dim pToCopyMap As IUnknown
  Set pToCopyMap = PageLayoutControl1.ActiveView.FocusMap

  'Get IUnknown interface (copied map)
  Dim pCopiedMap As IUnknown
  Set pCopiedMap = pObjectCopy.Copy(pToCopyMap)

  'Get IUnknown interface (map to overwrite)
  Dim pToOverwriteMap As IUnknown
  Set pToOverwriteMap = MapControl1.Map
  
  'Overwrite the MapControl's map
  pObjectCopy.Overwrite pCopiedMap, pToOverwriteMap
 
  SetMapExtent

End Sub
Private Sub SetMapExtent()
          
  'Get IActiveView interface
  Dim pActiveView As IActiveView
  Set pActiveView = PageLayoutControl1.ActiveView.FocusMap
  
  'Set the control's extent
  MapControl1.Extent = pActiveView.Extent
  'Refresh the display
  MapControl1.Refresh
    
End Sub
Private Sub PageLayoutControl1_OnAfterScreenDraw(ByVal hdc As Long)
  
  'Set mouse pointers
  PageLayoutControl1.MousePointer = esriPointerDefault
  MapControl1.MousePointer = esriPointerDefault
  
  If m_bReplacedPageLayout = False Then Exit Sub

  CopyAndOverwriteMap
  m_bReplacedPageLayout = False

End Sub
Private Sub PageLayoutControl1_OnBeforeScreenDraw(ByVal hdc As Long)
    
  'Set mouse pointers
  PageLayoutControl1.MousePointer = esriPointerHourglass
  MapControl1.MousePointer = esriPointerHourglass
  
End Sub
Private Sub PageLayoutControl1_OnFocusMapChanged()
  
  CopyAndOverwriteMap

End Sub

Private Sub PageLayoutControl1_OnPageLayoutReplaced(ByVal newPageLayout As Variant)
  
  m_bReplacedPageLayout = True
  ListMaps

End Sub


Private Sub Command1_Click()
    
    Dim pEnv As IEnvelope
    Set pEnv = New Envelope