[讨论](老大再麻烦你一下)AE编写专题地图的浏览

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