如何创建定制的按钮(Button)

       如何创建定制的按钮(Button)

       本例要实现的是如何创建定制的按钮(Button)。

       l 要点

       用户通过在类模块中实现ICommand接口来创建定制的按钮（COM command）。ICommand接口包括 caption、 name、 category、 bitmap、  message（StatusBarr的提示信息）、 tooltip（微帮助）、 help context id 、help file、enabled以及checked等十个属性和OnCreate、　　OnClick两个事件。从Icommand接口的OnCreate事件中获取的ArcMap的Application实例必须用一个公共变量保存，以便在其它事件中(或者其它接口的事件中甚至整个工程中)使用。

       ·OnCreate事件的参数hook传入的是一个Object，也就是ArcMAP的Application实例，可把它赋给一个IApplication接口的变量，便获得了ArcMAP的实例。

       ·在OnClick事件中写入相关代码，表示按下按钮时要实现的功能.

       l 程序说明

       程序在类模块中实现Icommand接口来创建自己的按钮(Button)

l       代码

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 = "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 pDocument As IDocument

    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 = " Create Button "

End Property

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