<P>  '~~ 使TOC事件可以拖曳圖層 ~~<BR>    '抓取要拖曳圖層<BR>    Private Sub AxTOCControl1_OnMouseDown(ByVal sender As Object, ByVal e As ESRI.ArcGIS.TOCControl.ITOCControlEvents_OnMouseDownEvent) Handles AxTOCControl1.OnMouseDown<BR>        If (e.button = 1) Then<BR>            Dim pMap As IMap = New MapClass<BR>            Dim pLayer As ILayer = New FeatureLayerClass<BR>            ' Dim pLegendGroup As ILegendGroup<BR>            Dim pLegendGroup As Object<BR>            Dim pItem As esriTOCControlItem = New esriTOCControlItem<BR>            Dim pIndex As Object<BR>            pSelSymLayer = Nothing</P>
<P>            '點選圖層或圖例<BR>            AxTOCControl1.HitTest(e.x, e.y, pItem, pMap, pLayer, pLegendGroup, pIndex)<BR>            If pLayer Is Nothing Then Exit Sub<BR>            If pItem = esriTOCControlItem.esriTOCControlItemLayer Then<BR>                '點中的是註記中的sublayer就退出<BR>                If TypeOf pLayer Is IAnnotationSublayer Then Exit Sub<BR>                pSelSymLayer = pLayer<BR>                'MsgBox(pSelSymLayer.Name)<BR>            ElseIf pItem = esriTOCControlItem.esriTOCControlItemLegendClass Then<BR>                '點中的是圖例<BR>                If TypeOf pLayer Is IFeatureLayer Then<BR>                End If<BR>            End If<BR>        End If<BR>    End Sub<BR>    '抓取放置位置<BR>    Private Sub AxTOCControl1_OnMouseMove(ByVal sender As Object, ByVal e As ESRI.ArcGIS.TOCControl.ITOCControlEvents_OnMouseMoveEvent) Handles AxTOCControl1.OnMouseMove<BR>        Dim pMap As IMap = New MapClass<BR>        Dim pLayer As ILayer = New FeatureLayerClass<BR>        Dim pLegendGroup As Object = Nothing<BR>        Dim pItem As esriTOCControlItem = New esriTOCControlItem<BR>        Dim pIndex As Object</P>
<P>        '實現調整圖層順序功能<BR>        If (e.button = 1) Then<BR>            AxTOCControl1.HitTest(e.x, e.y, pItem, pMap, pLayer, pLegendGroup, pIndex)<BR>        End If<BR>        If pItem <> esriTOCControlItem.esriTOCControlItemNone Then<BR>            Me.AxTOCControl1.MousePointer = esriControlsMousePointer.esriPointerPanning<BR>        End If</P>
<P>    End Sub<BR>    '執行放置圖層<BR>    Private Sub AxTOCControl1_OnMouseUp(ByVal sender As Object, ByVal e As ESRI.ArcGIS.TOCControl.ITOCControlEvents_OnMouseUpEvent) Handles AxTOCControl1.OnMouseUp<BR>        Dim pMap As IMap = New MapClass<BR>        Dim pLayer As ILayer = New FeatureLayerClass<BR>        Dim pLegendGroup As Object = Nothing<BR>        Dim pItem As esriTOCControlItem = New esriTOCControlItem<BR>        Dim pIndex As Object<BR>        Dim i As Integer, j As Integer<BR>        Dim bUpdataToc As Boolean<BR>        Me.AxTOCControl1.MousePointer = esriControlsMousePointer.esriPointerArrow</P>
<P>        '實現調整圖層順序功能<BR>        If (e.button = 1) Then<BR>            AxTOCControl1.HitTest(e.x, e.y, pItem, pMap, pLayer, pLegendGroup, pIndex)<BR>        End If</P>
<P>        If pItem = esriTOCControlItem.esriTOCControlItemLayer Or esriTOCControlItem.esriTOCControlItemLegendClass Then<BR>            If (pLayer Is Nothing) Or (pSelSymLayer Is Nothing) Or (pSelSymLayer Is pLayer) Then Exit Sub<BR>            If (e.button = 1) Then</P>
<P>                For i = 0 To AxMap_MapView.LayerCount - 1<BR>                    Dim pLayTmp As ILayer<BR>                    pLayTmp = AxMap_MapView.get_Layer(i)<BR>                    '得到點選當前的索引值<BR>                    If pLayer Is pLayTmp Then Exit For<BR>                Next i<BR>                '防止多次刷新<BR>                'TreeRedraw(Me.TOCLayer.hwnd, False)<BR>                On Error Resume Next<BR>                AxMap_MapView.Map.MoveLayer(pSelSymLayer, i)<BR>                On Error GoTo 0<BR>                'TreeRedraw(Me.TOCLayer.hwnd, True)<BR>            End If<BR>        End If<BR>    End Sub</P>
<P> <img src="images/post/smile/dvbbs/em01.gif" /></P>
<P><FONT color=#f70909>這是VB.NET版....不過請教各位高手.....是否可以在拖動圖層時...可以顯示...在那一個圖層上停住嗎?? 因為這樣可以比較知道在那一個圖層!!</FONT>  </P>

<DIV class=quote><B>以下是引用<I>waterblue</I>在2005-12-5 17:59:58的发言：</B><BR>
<P>Private Sub TOCLayer_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)<BR>    If button = 1 Then<BR>        Dim pMap As IMap<BR>        Dim pLayer As ILayer<BR>        <BR>        Dim pLegendGroup As ILegendGroup<BR>        Dim pItem As esriTOCControlItem<BR>        Dim pIndex As Variant<BR>        Set pSelSymLayer = Nothing<BR>        <BR>        '点击图层或者图例<BR>        TOCLayer.HitTest x, y, pItem, pMap, pLayer, pLegendGroup, pIndex<BR>        If pLayer Is Nothing Then Exit Sub<BR>        If pItem = esriTOCControlItemLayer Then<BR>            '点中的是注记中的sublayer就退出<BR>            If TypeOf pLayer Is IAnnotationSublayer Then Exit Sub<BR>            Set pSelSymLayer = pLayer<BR>            <BR>        ElseIf pItem = esriTOCControlItemLegendClass Then<BR>            '点中的是图例<BR>            If TypeOf pLayer Is IFeatureLayer Then     <BR>            ......<BR>                    <BR>    ElseIf button = 2 Then<BR>        '传出的参数pItem,pLayer, pLegendGroup, pIndex<BR>        m_pTocControl.HitTest x, y, pItem, pMap, pLayer, pLegendGroup, pIndex<BR>        m_pMapControl.CustomProperty = pLayer<BR>        '点中的是注记中的sublayer就退出<BR>        If pLayer Is Nothing Then GoTo err0<BR>        If TypeOf pLayer Is IAnnotationSublayer Then Exit Sub<BR>err0:<BR>        Set pSelSymLayer = pLayer<BR>        '弹出上下文菜单<BR>        ......<BR>End Sub<BR></P>
<P>Private Sub TOCLayer_OnMouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)<BR>    Dim pMap As IMap<BR>    Dim pLayer As ILayer<BR>    Dim pOther As IUnknown<BR>    Dim pItem As esriTOCControlItem<BR>    Dim pIndex As Variant<BR>    '实现调整图层顺序功能<BR>    If (button = vbLeftButton) Then<BR>        TOCLayer.HitTest x, y, pItem, pMap, pLayer, pOther, pIndex<BR>    End If<BR>    If pItem <> esriTOCControlItemNone Then<BR>        Set TOCLayer.MouseIcon = LoadResPicture("move", vbResCursor)<BR>        Me.TOCLayer.MousePointer = esriPointerCustom<BR>    End If<BR>End Sub</P>
<P>Private Sub TOCLayer_OnMouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)<BR>    Dim pMap As IMap<BR>    Dim pLayer As ILayer<BR>    Dim pOther As IUnknown<BR>    Dim pItem As esriTOCControlItem<BR>    Dim pIndex As Variant<BR>    Dim i As Integer, j As Integer<BR>    Dim bUpdataToc As Boolean<BR>    Me.TOCLayer.MousePointer = esriPointerArrow<BR>    <BR>    '实现调整图层顺序功能<BR>    If (button = vbLeftButton) Then<BR>        TOCLayer.HitTest x, y, pItem, pMap, pLayer, pOther, pIndex<BR>    End If<BR>    <BR>    If pItem = esriTOCControlItemLayer Or esriTOCControlItemLegendClass Then<BR>        If (pLayer Is Nothing) Or (pSelSymLayer Is Nothing) Or (pSelSymLayer Is pLayer) Then Exit Sub<BR>        If (button = vbLeftButton) Then<BR>            <BR>            For i = 0 To pActiveMap.LayerCount - 1<BR>                Dim pLayTmp As ILayer<BR>                Set pLayTmp = pActiveMap.Layer(i)<BR>                '得到点击当前的索引值<BR>               <FONT color=#ff0000><STRONG>If pLayer Is pLayTmp Then Exit For</STRONG></FONT><BR>            Next i<BR>           '防止多次刷新 <BR>           TreeRedraw Me.TOCLayer.hwnd, False<BR>            On Error Resume Next<BR>            <FONT color=#ff0000><STRONG>pActiveMap.MoveLayer pSelSymLayer, i</STRONG></FONT><BR>            On Error GoTo 0<BR>            TreeRedraw Me.TOCLayer.hwnd, True<BR>        End If<BR>    End If<BR>End Sub</P>
<P><STRONG><FONT color=#ff0000>pSelSymLayer为当前需要移动的图层</FONT></STRONG></P><BR></DIV>
<P>不错我正想问一下关于 TOCControl 的图层选中代码，真是不胜感激！</P><img src="images/post/smile/dvbbs/em08.gif" />

有谁做过Toccontrol中按住shift键后选择多个图层，请告诉一下方法，谢谢！

waterblue  辛苦了<img src="images/post/smile/dvbbs/em01.gif" />

<P>'控制对象是否重绘<BR>Public Sub TreeRedraw(ByVal lHWnd As Long, ByVal bRedraw As Boolean)<BR>    SendMessage lHWnd, WM_SETREDRAW, bRedraw, 0<BR>End Sub</P>
<P>调用这个函数！就可以防止刷新，很多地方都用的到的！</P>

<P>不要在mousemove中实现<FONT color=#000000>pActiveMap.MoveLayer pSelSymLayer, i<BR>定义i为全局变量，在mouseup中实现该语句，就可以防止刷新问题了。</FONT><BR></P>

非常感谢water blue，：）。但是出现一个问题，就是拖动图层的时候，刷新的特别厉害（不断的刷新），我看你那里用了一个TreeRedraw，不知道如何避免刷新的，请求赐教，谢谢！

<img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" /><img src="images/post/smile/dvbbs/em02.gif" />

<P>Private Sub TOCLayer_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)<br>    If button = 1 Then<br>        Dim pMap As IMap<br>        Dim pLayer As ILayer<br>        <br>        Dim pLegendGroup As ILegendGroup<br>        Dim pItem As esriTOCControlItem<br>        Dim pIndex As Variant<br>        Set pSelSymLayer = Nothing<br>        <br>        '点击图层或者图例<br>        TOCLayer.HitTest x, y, pItem, pMap, pLayer, pLegendGroup, pIndex<br>        If pLayer Is Nothing Then Exit Sub<br>        If pItem = esriTOCControlItemLayer Then<br>            '点中的是注记中的sublayer就退出<br>            If TypeOf pLayer Is IAnnotationSublayer Then Exit Sub<br>            Set pSelSymLayer = pLayer<br>            <br>        ElseIf pItem = esriTOCControlItemLegendClass Then<br>            '点中的是图例<br>            If TypeOf pLayer Is IFeatureLayer Then     <br>            ......<br>                    <br>    ElseIf button = 2 Then<br>        '传出的参数pItem,pLayer, pLegendGroup, pIndex<br>        m_pTocControl.HitTest x, y, pItem, pMap, pLayer, pLegendGroup, pIndex<br>        m_pMapControl.CustomProperty = pLayer<br>        '点中的是注记中的sublayer就退出<br>        If pLayer Is Nothing Then GoTo err0<br>        If TypeOf pLayer Is IAnnotationSublayer Then Exit Sub<br>err0:<br>        Set pSelSymLayer = pLayer<br>        '弹出上下文菜单<br>        ......<br>End Sub<br></P>
<P>Private Sub TOCLayer_OnMouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)<br>    Dim pMap As IMap<br>    Dim pLayer As ILayer<br>    Dim pOther As IUnknown<br>    Dim pItem As esriTOCControlItem<br>    Dim pIndex As Variant<br>    '实现调整图层顺序功能<br>    If (button = vbLeftButton) Then<br>        TOCLayer.HitTest x, y, pItem, pMap, pLayer, pOther, pIndex<br>    End If<br>    If pItem <> esriTOCControlItemNone Then<br>        Set TOCLayer.MouseIcon = LoadResPicture("move", vbResCursor)<br>        Me.TOCLayer.MousePointer = esriPointerCustom<br>    End If<br>End Sub</P>
<P>Private Sub TOCLayer_OnMouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)<br>    Dim pMap As IMap<br>    Dim pLayer As ILayer<br>    Dim pOther As IUnknown<br>    Dim pItem As esriTOCControlItem<br>    Dim pIndex As Variant<br>    Dim i As Integer, j As Integer<br>    Dim bUpdataToc As Boolean<br>    Me.TOCLayer.MousePointer = esriPointerArrow<br>    <br>    '实现调整图层顺序功能<br>    If (button = vbLeftButton) Then<br>        TOCLayer.HitTest x, y, pItem, pMap, pLayer, pOther, pIndex<br>    End If<br>    <br>    If pItem = esriTOCControlItemLayer Or esriTOCControlItemLegendClass Then<br>        If (pLayer Is Nothing) Or (pSelSymLayer Is Nothing) Or (pSelSymLayer Is pLayer) Then Exit Sub<br>        If (button = vbLeftButton) Then<br>            <br>            For i = 0 To pActiveMap.LayerCount - 1<br>                Dim pLayTmp As ILayer<br>                Set pLayTmp = pActiveMap.Layer(i)<br>                '得到点击当前的索引值<br>               <FONT color=#ff0000><STRONG> If pLayer Is pLayTmp Then Exit For</STRONG></FONT><br>            Next i<br>           '防止多次刷新 <br>           TreeRedraw Me.TOCLayer.hwnd, False<br>            On Error Resume Next<br>            <FONT color=#ff0000><STRONG>pActiveMap.MoveLayer pSelSymLayer, i</STRONG></FONT><br>            On Error GoTo 0<br>            TreeRedraw Me.TOCLayer.hwnd, True<br>        End If<br>    End If<br>End Sub</P>
<P><STRONG><FONT color=#ff0000>pSelSymLayer为当前需要移动的图层</FONT></STRONG></P>

<P>哭。。怎么没有人回答我，请知道的高手指点一下，不胜感激</P>