工具条

开发平台：
Visual Basic

Pan.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Pan"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' 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: contracts@esri.com
Option Explicit
Implements ICommand
Implements ITool
Private m_pMxDoc As IMxDocument
Private m_pAppDisplay As IAppDisplay
Private m_pFocusScreenDisplay As IScreenDisplay
Private m_InPanOperation As Boolean
Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE
  ICommand_Bitmap = frmResources.imlBitmaps.ListImages(3).Picture
End Property
Private Property Get ICommand_Caption() As String
  ICommand_Caption = "Pan"
End Property
Private Property Get ICommand_Category() As String
  ICommand_Category = "Developer Samples"
End Property
Private Property Get ICommand_Checked() As Boolean
  ICommand_Checked = False
End Property
Private Property Get ICommand_Enabled() As Boolean
  ICommand_Enabled = True
End Property
Private Property Get ICommand_HelpContextID() As Long
End Property
Private Property Get ICommand_HelpFile() As String
End Property
Private Property Get ICommand_Message() As String
  ICommand_Message = "Pan the display by user dragging map"
End Property
Private Property Get ICommand_Name() As String
  ICommand_Name = "Developer Samples_Pan"
End Property
Private Sub ICommand_OnClick()
  
End Sub
Private Sub ICommand_OnCreate(ByVal hook As Object)
  Dim pApp As IApplication
  Dim pMxApp As IMxApplication
  
  Set pApp = hook
  Set pMxApp = pApp
  
  Set m_pMxDoc = pApp.Document
  Set m_pAppDisplay = pMxApp.Display
End Sub
Private Property Get ICommand_Tooltip() As String
  ICommand_Tooltip = "Pan"
End Property
Private Property Get ITool_Cursor() As esriSystem.OLE_HANDLE
  If (Not m_InPanOperation) Then ' not in the middle of dragging
    ITool_Cursor = frmResources.imlIcons.ListImages(5).Picture
  Else
    ITool_Cursor = frmResources.imlIcons.ListImages(6).Picture
  End If
End Property
Private Function ITool_Deactivate() As Boolean
  ITool_Deactivate = True
End Function
Private Function ITool_OnContextMenu(ByVal x As Long, ByVal y As Long) As Boolean
End Function
Private Sub ITool_OnDblClick()
End Sub
Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long)
End Sub
Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long)
End Sub
Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
  If Not Button = 1 Then
    Exit Sub
  End If
  
  Dim pActiveView As IActiveView
  Set pActiveView = m_pMxDoc.ActiveView
  
  'If in PageLayout view, find the closest map
  If Not TypeOf pActiveView Is IMap Then
    Dim pPoint As IPoint
    Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
    Dim pHitMap As IMap
    Set pHitMap = pActiveView.HitTestMap(pPoint)
    
    'If no map is found, exit
    If pHitMap Is Nothing Then
      Exit Sub
    End If
    
    'Make sure the active view is the hit map
    If Not pHitMap Is m_pMxDoc.FocusMap Then
      Set pActiveView.FocusMap = pHitMap
    End If
  Else
  
  End If
  
  'Start the pan operation
  Set m_pFocusScreenDisplay = getFocusDisplay 'cache the ScreenDisplay
  m_pFocusScreenDisplay.PanStart m_pMxDoc.CurrentLocation
  m_InPanOperation = True
End Sub
Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
  If Not Button = 1 Then
    Exit Sub
  End If
  
  If (Not m_InPanOperation) Then Exit Sub
  
  Dim pPoint As IPoint
  Set pPoint = m_pFocusScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
  m_pFocusScreenDisplay.PanMoveTo pPoint
End Sub
Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
  If Not Button = 1 Then
    Exit Sub
  End If
 
  If (Not m_InPanOperation) Then Exit Sub
  
  Dim pEnv As IEnvelope
  Set pEnv = m_pFocusScreenDisplay.PanStop
  If (Not pEnv Is Nothing) Then
    m_pFocusScreenDisplay.DisplayTransformation.VisibleBounds = pEnv
    m_pFocusScreenDisplay.Invalidate Nothing, True, esriAllScreenCaches
  End If
  m_InPanOperation = False
End Sub
Private Sub ITool_Refresh(ByVal hDC As esriSystem.OLE_HANDLE)
End Sub
Private Function getFocusDisplay() As IScreenDisplay
  Dim pActiveView As IActiveView
  Set pActiveView = m_pMxDoc.ActiveView
  If TypeOf pActiveView Is IMap Then
    Set getFocusDisplay = m_pAppDisplay.FocusScreen
  Else
    Set pActiveView = m_pMxDoc.ActiveView.FocusMap
    Set getFocusDisplay = pActiveView.ScreenDisplay
  End If
End Function

						