clsfixedzoomin.cls

来自「arcEngine开发地图放大缩小漫游控件,fr」· CLS 代码 · 共 134 行

CLS
134
字号
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "FixedZoomIn"
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("FixedZoomIn", 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/FixedZoomIn"
  
End Property

Private Property Get ICommand_Caption() As String
  
  ICommand_Caption = "Fixed Zoom In"
  
End Property
 
Private Property Get ICommand_Tooltip() As String
  
  ICommand_Tooltip = "Fixed Zoom In"
  
End Property
 
Private Property Get ICommand_Message() As String
  
  ICommand_Message = "Zoom in on the center of the map"
  
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()
  
  'Get IActiveView interface
  Dim pActiveView As IActiveView
  Set pActiveView = m_pHookHelper.FocusMap
  'Get IEnvelope interface
  Dim pEnvelope As IEnvelope
  Set pEnvelope = pActiveView.Extent
  
  'Expand envelope and refresh the view
  pEnvelope.Expand 0.75, 0.75, True
  pActiveView.Extent = pEnvelope
  pActiveView.Refresh
  
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?