clspan.cls

arcEngine开发地图放大缩小漫游控件,fr

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 1  'Persistable
  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 2006 ESRI
' 							  
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See use restrictions at /arcgis/developerkit/userestrictions.

Option Explicit

'Windows API functions to capture mouse and keyboard
'input to a window when the mouse is outside the window
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetCapture Lib "user32" () As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private m_pHookHelper As IHookHelper
Private m_pPoint As esriGeometry.IPoint
Private m_bInUse As Boolean
Private m_pBitmap As IPictureDisp
Private m_pCursor As IPictureDisp
Private m_pCursorMove As IPictureDisp

Implements ICommand
Implements ITool

'Constant used by the Error handler function - DO NOT REMOVE

Private Sub Class_Initialize()

  'Load resources
  Set m_pBitmap = LoadResPicture("Pan", vbResBitmap)
  Set m_pCursorMove = LoadResPicture("PanMove", vbResCursor)
  Set m_pCursor = LoadResPicture("Pan", vbResCursor)
  Set m_pHookHelper = New HookHelper

End Sub

Private Sub Class_Terminate()

  'Clear variables
  Set m_pHookHelper = Nothing
  Set m_pBitmap = Nothing
  Set m_pCursor = Nothing
  Set m_pCursorMove = Nothing

End Sub

Private Property Get ICommand_Enabled() As Boolean

  If (m_pHookHelper.FocusMap Is Nothing) Then Exit Property
  ICommand_Enabled = True

End Property
 
Private Property Get ICommand_Checked() As Boolean

  ICommand_Checked = False

End Property
 
Private Property Get ICommand_Name() As String

  ICommand_Name = "Sample_Pan/Zoom_Pan"

End Property

Private Property Get ICommand_Caption() As String

  ICommand_Caption = "Pan"

End Property
 
Private Property Get ICommand_Tooltip() As String

  ICommand_Tooltip = "Pan by Grab"

End Property
 
Private Property Get ICommand_Message() As String

  ICommand_Message = "Pans The Display By Grabbing"

End Property
 
Private Property Get ICommand_HelpFile() As String

  ' TODO: Add your implementation here

End Property
 
Private Property Get ICommand_HelpContextID() As Long

  ' TODO: Add your implementation here

End Property
 
Private Property Get ICommand_Bitmap() As esriSystem.OLE_HANDLE

  ICommand_Bitmap = m_pBitmap

End Property
 
Private Property Get ICommand_Category() As String

  ICommand_Category = "Sample_Pan/Zoom"

End Property
 
Private Sub ICommand_OnCreate(ByVal hook As Object)

  Set m_pHookHelper.hook = hook

End Sub
 
Private Sub ICommand_OnClick()

  ' TODO: Add your implementation here

End Sub

Private Property Get ITool_Cursor() As esriSystem.OLE_HANDLE

  If (m_bInUse) Then
    ITool_Cursor = m_pCursorMove
  Else
    ITool_Cursor = m_pCursor
  End If

End Property
 
Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)

  If (m_pHookHelper.ActiveView Is Nothing) Then Exit Sub

  'If the active view is a page layout
  If TypeOf m_pHookHelper.ActiveView Is IPageLayout Then
    'Create a point in map coordinates
    Dim pPoint As IPoint
    Set pPoint = m_pHookHelper.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)
    'Get the map if the point is within a data frame
    Dim pMap As IMap
    Set pMap = m_pHookHelper.ActiveView.HitTestMap(pPoint)
    If pMap Is Nothing Then Exit Sub
    'Set the map to be the page layout's focus map
    If Not pMap Is m_pHookHelper.FocusMap Then
      Set m_pHookHelper.ActiveView.FocusMap = pMap
      m_pHookHelper.ActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing
    End If
  End If

  'Create a point in map coordinates
  Dim pActiveView As esriCarto.IActiveView
  Set pActiveView = m_pHookHelper.FocusMap
  'Start the pan
  Set m_pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)
  pActiveView.ScreenDisplay.PanStart m_pPoint

  m_bInUse = True
  'Start capturing mouse events
  SetCapture m_pHookHelper.ActiveView.ScreenDisplay.hWnd

End Sub
 
Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)

  If (Not m_bInUse) Then Exit Sub
  
  'Get the focus map
  Dim pActiveView As esriCarto.IActiveView
  Set pActiveView = m_pHookHelper.FocusMap
  'Move the pan
  pActiveView.ScreenDisplay.PanMoveTo pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)

End Sub
 
Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)

  If (Not m_bInUse) Then Exit Sub
  
  'Stop capturing mouse events
  If GetCapture = m_pHookHelper.ActiveView.ScreenDisplay.hWnd Then
    ReleaseCapture
  End If
  
  'Get the focus map
  Dim pActiveView As esriCarto.IActiveView
  Set pActiveView = m_pHookHelper.FocusMap
  'Stop the pan
  Dim pEnvelope As esriGeometry.IEnvelope
  Set pEnvelope = pActiveView.ScreenDisplay.PanStop
  
  'Set the new extent
  pActiveView.Extent = pEnvelope
  'Refresh the active view
  pActiveView.Refresh
  m_bInUse = False

End Sub
 
Private Sub ITool_OnDblClick()

  ' TODO: Add your implementation here

End Sub
 
Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long)

  ' TODO: Add your implementation here
  
End Sub
 
Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long)

  ' TODO: Add your implementation here

End Sub
 
Private Function ITool_OnContextMenu(ByVal X As Long, ByVal Y As Long) As Boolean

  ' TODO: Add your implementation here

End Function
 
Private Sub ITool_Refresh(ByVal hDC As esriSystem.OLE_HANDLE)

  ' TODO: Add your implementation here

End Sub
 
Private Function ITool_Deactivate() As Boolean

  ITool_Deactivate = True

End Function