|
|
|
|

本例要实现的是如何创建定制的Tool

本例要实现的是如何创建定制的Tool 要点 用户在类模块中实现Icommand(参见1.2.1)和ITool接口。ITool接口包括 mouse move, mouse button press/release, keyboard key press/release, double-click以及right click等事件、Cursor属性和Refresh方法。 ...

作者:gis来源:GIS帝国|2007年09月22日

本例要实现的是如何创建定制的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界面交互时一旦触发某事件要实现的功能。

l 程序说明

    程序在类模块中实现Icommand和Itool接口来创建自己的Tool.

l 代码

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
End Property

Private Property Get ICommand_Caption() As String
    ICommand_Caption = "MyTool"
End Property

Private Property Get ICommand_Category() As String
    ICommand_Category = "MyCustomTools"
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 = "This is my custom tool"
End Property

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

Private Sub ICommand_OnClick()
    '加入按下按钮时实现的功能代码
    MsgBox "Clicked on my command"
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 = "MyTool"
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

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) & "," & Str(pPoint.Y)
     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) = "ITool_OnMouseMove"
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) = "ITool_OnMouseUp"
End Sub

Private Sub ITool_Refresh(ByVal hDC As esriCore.OLE_HANDLE)
End Sub

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

Private Sub ICommand_OnClick()
    '加入按下按钮时实现的功能代码
    MsgBox "Clicked on my command"
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 = "MyTool"
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

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) & "," & Str(pPoint.Y)
     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) = "ITool_OnMouseMove"
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) = "ITool_OnMouseUp"
End Sub

Private Sub ITool_Refresh(ByVal hDC As esriCore.OLE_HANDLE)
End Sub

上一篇:如何创建定制的按钮(Button)

下一篇:如何创建定制的工具条(Tool Bar)