clsmultitem.cls

这是一个非常全的VB+AO二次开发实例集

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsmultitem"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Implements IMultiItem
Private m_pApp As IApplication
'ArcMap的Document
Private m_pMxDoc As IMxDocument
'当前Focus Map
Private m_pMap As IMap
'Map中的层数
Private m_pLayerCnt As Long

Private Property Get IMultiItem_Caption() As String
    IMultiItem_Caption = "ZoomToLayers"
End Property

Private Property Get IMultiItem_HelpContextID() As Long
End Property

Private Property Get IMultiItem_HelpFile() As String
End Property

Private Property Get IMultiItem_ItemBitmap(ByVal Index As Long) As esriCore.OLE_HANDLE
End Property

Private Property Get IMultiItem_ItemCaption(ByVal Index As Long) As String
    Dim i As Integer
    ' 遍历每一个层
    For i = 0 To m_pLayerCnt - 1
        ' 如果层号与当前Item的Index相同，就设置该Item的Caption
        If Index = i Then
            IMultiItem_ItemCaption = "Zoom to " & m_pMap.Layer(i).Name
        End If
    Next
End Property

Private Property Get IMultiItem_ItemChecked(ByVal Index As Long) As Boolean
End Property

Private Property Get IMultiItem_ItemEnabled(ByVal Index As Long) As Boolean
    Dim i As Integer
    ' 遍历每一个层
    For i = 0 To m_pLayerCnt - 1
        '如果层号与当前Item的Index相同,则当前Item的Enable根据该层的Visible设置。
        If Index = i Then
            If m_pMap.Layer(i).Visible Then
                IMultiItem_ItemEnabled = True
            End If
        End If
    Next
End Property

Private Property Get IMultiItem_Message() As String
    IMultiItem_Message = "Zooms to the layer."
End Property

Private Property Get IMultiItem_Name() As String
    IMultiItem_Name = "ZoomMulti"
End Property

Private Sub IMultiItem_OnItemClick(ByVal Index As Long)
    Dim i As Integer
    Dim pEnv As IEnvelope
    Dim m_BookMark As IAOIBookmark
    ' 遍历每一个层
    For i = 0 To m_pLayerCnt - 1
        '如果层号与当前Item的Index相同,则以该层的AreaOfInterest 为范围执行Zoom
        If Index = i Then
            Set pEnv = m_pMap.Layer(i).AreaOfInterest
            Set m_BookMark = New AOIBookmark
            Set m_BookMark.Location = pEnv
            m_BookMark.ZoomTo m_pMap
            m_pMxDoc.ActiveView.Refresh
        End If
    Next
End Sub

Private Function IMultiItem_OnPopup(ByVal hook As Object) As Long
    Set m_pApp = hook
    ' 获取Map中的层数
    Set m_pMxDoc = m_pApp.Document
    Set m_pMap = m_pMxDoc.FocusMap
    m_pLayerCnt = m_pMap.LayerCount
    ' 显示的Item数等于层数
    IMultiItem_OnPopup = m_pLayerCnt
End Function