如何实现TOC控件里的图层拖动

<P>用TOCControl控件绑定mapcontrol，想在TOCControl里实现图层的拖动，从而改变指定图层在图层组或图层间的位置。</P>
<P>我发现TOCControl控件本身好像没有这样的功能，程序写起来很复杂，总是出现很多问题。</P>
<P>想请教各位高手有没有这样的例子给予参考，请指教！谢谢!</P>

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

<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>

<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" />

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

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

<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>

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

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

<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" />