adddate.cls

ao开发指南的东西 源码 希望大家好好学习ao

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: [e-mail]

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