clszoomin.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 = "ZoomIn"
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_pFeedback As esriDisplay.INewEnvelopeFeedback
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("ZoomIn", vbResBitmap)
  Set m_pCursor = LoadResPicture("ZoomIn", vbResCursor)
  Set m_pCursorMove = LoadResPicture("ZoomInMove", 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_Zoom In"

End Property

Private Property Get ICommand_Caption() As String

  ICommand_Caption = "Zoom In"

End Property
 
Private Property Get ICommand_Tooltip() As String

  ICommand_Tooltip = "Zoom In"

End Property
 
Private Property Get ICommand_Message() As String

  ICommand_Message = "Zooms the Display In By Rectangle Or Single Click"

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
  Set m_pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)

  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
  'Start an envelope feedback
  If (m_pFeedback Is Nothing) Then
    Set m_pFeedback = New NewEnvelopeFeedback
    Set m_pFeedback.Display = pActiveView.ScreenDisplay
    m_pFeedback.Start m_pPoint
  End If
  'Move the envelope feedback
  m_pFeedback.MoveTo 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
  'If an envelope has not been tracked
  Dim pEnvelope As esriGeometry.IEnvelope
  If (m_pFeedback Is Nothing) Then
    'Zoom in from the mouse click
    Set pEnvelope = pActiveView.Extent
    pEnvelope.Expand 0.5, 0.5, True
    pEnvelope.CenterAt m_pPoint
  Else
    'Stop the envelope feedback
    Set pEnvelope = m_pFeedback.Stop
    'Exit if the envelope height or width is 0
    If (pEnvelope.Width = 0) Or (pEnvelope.Height = 0) Then
      Set m_pFeedback = Nothing
      m_bInUse = False
      Exit Sub
    End If
  End If
  
  'Set the new extent
  pActiveView.Extent = pEnvelope
  'Refresh the active view
  pActiveView.Refresh
  Set m_pFeedback = Nothing
  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)

  If m_bInUse = True Then
    If keyCode = 27 Then  'ESC key
      ReleaseCapture
      Set m_pFeedback = Nothing
      m_bInUse = False
      m_pHookHelper.ActiveView.PartialRefresh esriViewForeground, Nothing, Nothing
    End If
  End If

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