clsbar.cls

来自「这是一个非常全的VB+AO二次开发实例集」· CLS 代码 · 共 73 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClsBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'实现Icommand接口
Implements ICommand
Dim m_pPic As Picture
Dim m_pApp As IApplication

Private Sub Class_Initialize()
'调入.RES文件中ID为101的BitMap作为该按钮的显示图片
Set m_pPic = LoadResPicture(101, vbResBitmap)
End Sub

Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE
ICommand_Bitmap = m_pPic
End Property

Private Property Get ICommand_Caption() As String
ICommand_Caption = "Create Button"
End Property

Private Property Get ICommand_Category() As String
ICommand_Category = " Create Button "
End Property

Private Property Get ICommand_Checked() As Boolean
End Property

Private Property Get ICommand_Enabled() As Boolean
ICommand_Enabled = True
End Property

Private Property Get ICommand_HelpContextID() As Long
End Property

Private Property Get ICommand_HelpFile() As String
End Property

Private Property Get ICommand_Message() As String
End Property

Private Property Get ICommand_Name() As String
ICommand_Name = " CreateButton "
End Property

Private Sub ICommand_OnClick()
'加入按下按钮时实现的功能代码。在这里，按钮按下时显示ArcMap的Document的Tittle
Dim pDoc As IDocument
Set pDoc = m_pApp.Document
MsgBox pDoc.Title
End Sub

Private Sub ICommand_OnCreate(ByVal hook As Object)
'获取ArcMap的Application实例
Set m_pApp = hook
End Sub

Private Property Get ICommand_Tooltip() As String
ICommand_Tooltip = " Create Button "
End Property