clspandown.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 = "PanDown"
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

Private m_pHookHelper As IHookHelper
Private m_pBitmap As IPictureDisp

Implements ICommand

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

Private Sub Class_Initialize()

  'Load resources
  Set m_pBitmap = LoadResPicture("PanDown", vbResBitmap)
  Set m_pHookHelper = New HookHelper

End Sub

Private Sub Class_Terminate()

  'Clear variables
  Set m_pHookHelper = Nothing
  Set m_pBitmap = 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 Down"

End Property
 
Private Property Get ICommand_Caption() As String

  ICommand_Caption = "Pan Down"

End Property
 
Private Property Get ICommand_Tooltip() As String

  ICommand_Tooltip = "Pan Down"

End Property
 
Private Property Get ICommand_Message() As String

  ICommand_Message = "Pan display down by the pan factor percentage"

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()

  If (m_pHookHelper.FocusMap Is Nothing) Then Exit Sub
  
  'Get the active view
  Dim pActiveView As esriCarto.IActiveView
  Set pActiveView = m_pHookHelper.FocusMap
  'Get the extent
  Dim pEnvelope As esriGeometry.IEnvelope
  Set pEnvelope = pActiveView.Extent
  
  'Create a point to pan to
  Dim pPoint As esriGeometry.IPoint
  Set pPoint = New Point
  pPoint.X = (pEnvelope.XMin + pEnvelope.XMax) / 2#
  pPoint.Y = ((pEnvelope.YMin + pEnvelope.YMax) / 2#) - (pEnvelope.Height / (100 / GetPanFactor()))
  
  'Center the envelope on the point
  pEnvelope.CenterAt pPoint
  'Set the new extent
  pActiveView.Extent = pEnvelope
  'Refresh the active view
  pActiveView.Refresh

End Sub

Private Function GetPanFactor() As Long

  GetPanFactor = 50

End Function