? 程序说明
程序在类模块中实现Icommand接口来创建自己的按钮(Button) ? 代码
Option Explicit '实现Icommand接口 Implements ICommand
Dim m_pPicture as Picture
Dim m_pApplication As IApplication
Private Sub Class_Initialize()
'调入.RES文件中ID为101的BitMap作为该按钮的显示图片 Set m_pPicture = LoadResPicture(101, vbResBitmap) End Sub
Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE ICommand_Bitmap = m_pPicture End Property
Private Property Get ICommand_Caption() As String ICommand_Caption = \End Property
Private Property Get ICommand_Category() As String ICommand_Category = \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 = \End Property
Private Sub ICommand_OnClick()
'加入按下按钮时实现的功能代码。在这里，
'按钮按下时显示ArcMap的Document的Tittle Dim pDocument As IDocument
-11-
Set pDocument = m_pApplication.Document MsgBox pDocument.Title End Sub
Private Sub ICommand_OnCreate(ByVal hook As Object) '获取ArcMap的Application实例? Set m_pApplication = hook End Sub
Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = \End Property
1.2.2. 如何创建定制的Tool
本例要实现的是如何创建定制的Tool ? 要点
用户在类模块中实现Icommand（参见1.2.1）和ITool接口。ITool接口包括 mouse move, mouse button press/release, keyboard key press/release, double-click以及right click等事件、Cursor属性和Refresh方法。
Tool既具有Button的功能，又具有与ArcMAP界面交互的功能，Button的功能代码必须写在Icommand的OnClick事件中，而所有实现交互功能的代码必须写在Itool接口的各个事件中。Itool接口的各个事件,用户可以在其中写入相关代码，表示用户与ArcMAP界面交互时一旦触发某事件要实现的功能。 ? 程序说明
程序在类模块中实现Icommand和Itool接口来创建自己的Tool. ? 代码
Option Explicit
'实现Icommand和Itool接口 Implements ICommand Implements ITool
Dim m_pApplication As IApplication Dim m_pBitmap As IPictureDisp Dim m_pCursor As IpictureDisp
Private Sub Class_Initialize()
Set m_pBitmap = LoadResPicture(101, 0)
'从.RES文件中调入ID为102的图片作为按下Tool后的MouseCursor Set m_pCursor = LoadResPicture(102, 2) End Sub
Private Property Get ICommand_Bitmap() As esriCore.OLE_HANDLE ICommand_Bitmap = m_pBitmap
-12-
End Property
Private Property Get ICommand_Caption() As String ICommand_Caption = \End Property
Private Property Get ICommand_Category() As String ICommand_Category = \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 ICommand_Message = \End Property
Private Property Get ICommand_Name() As String ICommand_Name = \End Property
Private Sub ICommand_OnClick() '加入按下按钮时实现的功能代码 MsgBox \End Sub
Private Sub ICommand_OnCreate(ByVal hook As Object) '获取ArcMAP的Application实例 Set m_pApplication = hook End Sub
Private Property Get ICommand_Tooltip() As String ICommand_Tooltip = \End Property
Private Property Get ITool_Cursor() As esriCore.OLE_HANDLE ITool_Cursor = m_pCursor End Property
Private Function ITool_Deactivate() As Boolean
'如果ITool_Deactivate设为False，则Tool不可用 ITool_Deactivate = True End Function
-13-
Private Function ITool_OnContextMenu(ByVal X As Long, ByVal Y As Long) As Boolean '在这里可以加入用户代码，点击Mouse右键时显示一个定制的context menu End Function
Private Sub ITool_OnDblClick()
'在这里加入Mouse双击时的功能代码 End Sub
Private Sub ITool_OnKeyDown(ByVal keyCode As Long, ByVal Shift As Long) End Sub
Private Sub ITool_OnKeyUp(ByVal keyCode As Long, ByVal Shift As Long) End Sub
Private Sub ITool_OnMouseDown(ByVal Button As Long, ByVal Shift As Long, _
ByVal X As Long, ByVal Y As Long)
'加入Mouse单击时的功能代码 If Button = 1 Then
Dim pPoint As IPoint
Dim pMxApplication As IMxApplication Set pMxApplication = m_pApp
Set pPoint=pMxApplication.Display.DisplayTransformation.ToMapPoint(X, Y) m_pApplication.StatusBar.Message(0) = Str(pPoint.X) & \ End If End Sub
Private Sub ITool_OnMouseMove(ByVal Button As Long, ByVal Shift As Long, _
ByVal X As Long, ByVal Y As Long)
'加入Mouse移动时的功能代码
m_pApplication.StatusBar.Message(0) = \End Sub
Private Sub ITool_OnMouseUp(ByVal Button As Long, ByVal Shift As Long, _
ByVal X As Long, ByVal Y As Long)
'加入释放Mouse时的功能代码
m_pApplication.StatusBar.Message(0) = \End Sub
Private Sub ITool_Refresh(ByVal hDC As esriCore.OLE_HANDLE) End Sub
1.2.3. 如何创建定制的工具条(Tool Bar)
本例要实现的是如何创建定制的工具条(Tool Bar)。就必须在类模块中实现IToolBarDef接口。IToolBarDef接口包括 Caption、ItemCount及Name三个属性和GetItemInfo方法。 ? 要点
通过在类模块中实现IToolBarDef接口。IToolBarDef接口包括 Caption、
-14-
ItemCount及Name三个属性和GetItemInfo方法。
·ItemCount属性表示ToolBar显示的条目(Button、Tool或其它控件)数。 · GetItemInfo方法定义工具条上各条目的CLSID，其中，参数pos表示条目在ToolBar中的位置，itemDef 是定义相应位置的条目的IItemDef 对象。
·工具条条目的CLSID分为两种：
1、系统CLSID，代表ArcGIS的一个功能，其引用方式为\命令名称\，如\、\等。
2、用户定制CLSID，表示用户自己定义的功能。其引用方式为\工程名称.定制功能类名称\，如\ ToolBarDef.ClsBar \。必须注意，这里“定制功能类名称”是工程中实现的一个功能类名称，“工程名称”即为当前工程的名称（不是DLL文件名，也不是工具条的名称），每次新建一个工程时，系统默认的工程名在某些情况下无法使用（在中文版的VB中是一个乱字符），必须改名后方能用。 ? 程序说明
程序在类模块中实现IToolBarDef接口来创建自己的工具条(ToolBar)。 ? 代码
Option Explicit
Implements IToolBarDef
Private Property Get IToolBarDef_Caption() As String IToolBarDef_Caption = \End Property
Private Sub IToolBarDef_GetItemInfo(ByVal pos As Long, ByVal itemDef As _
esriCore.IItemDef)
'这里假设在当前工程(工程名称为ToolBarDef)中定义了一个类模块(名为ClsBar)， '它实现了Icommand接口(可参照1.2.1) Select Case pos Case 0
'用户自定义条目
itemDef.ID = \ itemDef.Group = False Case 1
'系统条目
itemDef.ID = \ itemDef.Group = False End Select End Sub
Private Property Get IToolBarDef_ItemCount() As Long
IToolBarDef_ItemCount = 2 End Property
-15-