http://www.gissky.net- GIS空间站

我要投稿 投稿指南 RSS订阅 网站资讯通告:
搜索: 您现在的位置: GIS空间站 >> 技术专栏 >> ArcGIS >> ArcObjects开发 >> 正文

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

作者:gis    文章来源:GIS帝国    点击数:    更新时间:2007-9-22
摘要:

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

l 要点

需要实现IMultiItem接口,但不需要同时实现Icommand接口。IMultiItem接口包括Caption,itemCaption,ItemBitmap,ItemEnabled,ItemChecked, Message及Name等属性和OnItemClick, OnPopup事件。

·itemCaption,ItemBitmap,ItemEnabled,ItemChecked等属性的参数index表示当前Item的下标索引。

   ·OnPopup事件的参数hook同Icommand接口的OnCreate事件的参数hook一样,传入ArcGIS的Application实例,同时,该事件返回将要显示的Item数目。

·OnItemClick事件的参数Index表示用户当前点击的Item的索引,用户根据该索引分别定义点击各个Item时实现的功能。

l 程序说明

程序在类模块中实现IMultiItem接口来创建定制自己的MultiItem。

l 代码

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

Tags:ArcMap VBA  
责任编辑:wzj3sstudio
关于我们 - 联系我们 - 广告服务 - 友情链接 - 网站地图 - 中国地图