?? adddate.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 = "AddDateTool"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
' Copyright 1995-2004 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_pHookHelper As IHookHelper
Private m_pBitmap As IPictureDisp
Private Sub Class_Initialize()
'Load resources
Set m_pBitmap = LoadResPicture("Date", vbResBitmap)
'Create a HookHelper
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_Bitmap() As esriSystem.OLE_HANDLE
ICommand_Bitmap = m_pBitmap
End Property
Private Property Get ICommand_Caption() As String
ICommand_Caption = "Add Date"
End Property
Private Property Get ICommand_Category() As String
ICommand_Category = "CustomCommands"
End Property
Private Property Get ICommand_Checked() As Boolean
ICommand_Checked = False
End Property
Private Property Get ICommand_Enabled() As Boolean
If Not m_pHookHelper.ActiveView Is Nothing Then
ICommand_Enabled = True
Else
ICommand_Enabled = False
End If
End Property
Private Property Get ICommand_HelpContextID() As Long
'Not implemented
End Property
Private Property Get ICommand_HelpFile() As String
'Not implemented
End Property
Private Property Get ICommand_Message() As String
ICommand_Message = "Adds a date element to the page layout"
End Property
Private Property Get ICommand_Name() As String
ICommand_Name = "CustomCommands_Add Date"
End Property
Private Sub ICommand_OnClick()
'Not implemented
End Sub
Private Sub ICommand_OnCreate(ByVal Hook As Object)
Set m_pHookHelper.Hook = Hook
End Sub
Private Property Get ICommand_Tooltip() As String
ICommand_Tooltip = "Add date"
End Property
Private Property Get ITool_Cursor() As esriSystem.OLE_HANDLE
'Not implemented
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
'Not implemented
End Function
Private Sub ITool_OnDblClick()
'Not implemented
End Sub
Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal shift As Long)
'Not implemented
End Sub
Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal shift As Long)
'Not implemented
End Sub
Private Sub ITool_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
'Get the active view
Dim pActiveView As IActiveView
Set pActiveView = m_pHookHelper.ActiveView
'Create a new text element
Dim pTextElement As ITextElement
Set pTextElement = New TextElement
'Create a text symbol
Dim pTextSymbol As ITextSymbol
Set pTextSymbol = New TextSymbol
'Create a font
Dim pFont As stdole.StdFont
Set pFont = New stdole.StdFont
pFont.Name = "Arial"
pFont.Bold = True
pFont.Size = 25
'Set the symbol properties
pTextSymbol.Font = pFont
'Set the text element properties
pTextElement.Symbol = pTextSymbol
pTextElement.Text = Date
'QI for IElement
Dim pElement As IElement
Set pElement = pTextElement
'Create a page point
Dim pPoint As IPoint
Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
'Set the elements geometry
pElement.Geometry = pPoint
'Add the element to the graphics container
pActiveView.GraphicsContainer.AddElement pTextElement, 0
'Refresh the graphics
pActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing
End Sub
Private Sub ITool_OnMouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
'Not implemented
End Sub
Private Sub ITool_OnMouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
'Not implemented
End Sub
Private Sub ITool_Refresh(ByVal hdc As esriSystem.OLE_HANDLE)
'Not implemented
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -