Creating a 'mouse over' effect on a VB TreeView node

问题

Nodes of a TreeView control do not have a 'mouse over' property to test for. I was hoping to "highlight" the node (to give the user feedback on which one is selected).

For example, when the MouseMove event fires on the TreeView control, I can set a node object to what "HitTest" returns:

Set nde = trvChoices.HitTest(x, y * 15)

I am looking for a way to have this node "highlighted" (or something) when the mouse is over it, in order to give the user feedback of which node in the TreeView is selected. Yes, I am using TreeView as a 'right-click' menu. I do not wish to use a different control, although I may have to...

回答1:

It was a no-brainer to get the node to be Bold on hover. However, setting the BackColor or ForeColor to any color e.g. wdYellow would just black out the entire node...

Posting example code in case anyone else runs into this:

    Private Sub trvChoices_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)

    If Not (trvChoices.HitTest(x, y * 15) Is Nothing) Then

        Dim nde As Node
        Set nde = trvChoices.HitTest(x, y * 15)

        'I have three nodes only, but the proper way would be to loop through the trvChoices and set      each node to Bold = False
        trvChoices.Nodes(1).Bold = False
        trvChoices.Nodes(2).Bold = False
        trvChoices.Nodes(3).Bold = False

        nde.Bold = True

        Set nde = Nothing
    End If

End Sub

回答2:

I've been trying to get OLEDragDrop to work with a Treeview and Listview and had run into an issue where the StartDrag tried to take across the item that was active in the Treeview before the user had started the StartDrag, rather than the item that they were trying to drag across. I had seen solutions elsewhere that required the user to click on an item before dragging, but this was counterintuitive. By modifying your code slightly I was able to set the item under the mouse as the active item which:
(a) gives feedback to the user and
(b) makes the OLEDragDrop work correctly.

Private Sub trvChoices_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)

  If Not (trvChoices.HitTest(x * 15, y * 15) Is Nothing) Then

    Dim nde As node
    Set nde = trvChoices.HitTest(x * 15, y * 15)

    nde.Selected = True

    Set nde = Nothing
  End If

End Sub

回答3:

The * 15 is for pixel/twip conversion. Unfortunately it doesn't work for all monitors as different monitors have a different rate between pixel and twips depending on monitor ratio. BUT 15 does comply to standard 4:3 monitors.

Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
  ByVal nIndex As Long) As Long

Const WU_LOGPIXELSX = 88
Const WU_LOGPIXELSY = 90

Use above to get this.

Additionally you need to check if you need to do the conversion at all as different versions use different output x,y values.

来源：https://stackoverflow.com/questions/5860529/creating-a-mouse-over-effect-on-a-vb-treeview-node

标签

vba

treeview

mouseover