Hi,

I have a TreeView on a userform and I would like to show some
information on a label based on the current node (not selected) over
which the mouse is moving.

I made many searches in googles and could not find a code snippet on
this.

Thanks for your help.

Regards,
Karim

Something like this?

Private Sub TreeView1_MouseMove(Button As Integer, _
Shift As Integer, x As Single, y As Single)

Dim nodHoover As Node

If Button = 0 Then
Set nodHoover = TreeView1.HitTest(x, y)
If Not nodHoover Is Nothing Then
Label1.Caption = nodHoover.Text
End If
End If

End Sub

Cheers
Andy

Karim Benabd wrote:
Hi,

I have a TreeView on a userform and I would like to show some
information on a label based on the current node (not selected) over
which the mouse is moving.

I made many searches in googles and could not find a code snippet on
this.

Thanks for your help.

Regards,
Karim


--

Andy Pope, Microsoft MVP - Excel
http://www.andypope.info

Hi Andy,

I got the following error when trying to run this code in Excel 2000
(Translation from French):

Compiler error:
The procedure declaration does not correspond to the event description
or to the event procedure with the same name.

When I made the event parameters as follows:
Private Sub TreeView1_MouseMove(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As
stdole.OLE_YPOS_PIXELS)
Dim nodHoover As Node
If Button = 0 Then
Set nodHoover = TreeView1.HitTest(X, Y)
If Not nodHoover Is Nothing Then
Label1.Caption = nodHoover.Text
End If
End If
End Sub

With this, the error disappeared but the code did not work as expected.
The Label1 shows only the root text.

Thanks for your help.
Karim

Hi Andy,

I used a conversion function published by Microsoft with which it is
possible to convert twips (Treeview output) into pixels used by the
MouseMove event.

However, the values given by the conversion function are not accurate.
Here is my code:

Here is the function:

================================================== =
Option Explicit:
'Declarations
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long
'Constants
Const WU_LOGPIXELSX = 88
Const WU_LOGPIXELSY = 90
'Function
Function ConvertTwipsToPixels(lngTwips As Long, lngDirection As Long)
As Long
'Handle to device
Dim lngDC As Long
Dim lngPixelsPerInch As Long
Const nTwipsPerInch = 1440
lngDC = GetDC(0)

If (lngDirection = 0) Then 'Horizontal
lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
Else 'Vertical
lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
End If
lngDC = ReleaseDC(0, lngDC)
ConvertTwipsToPixels = (lngTwips / nTwipsPerInch) * lngPixelsPerInch
End Function

Here is the code inside the userform with a TreeView and 3 Labels:

Private Sub TreeView1_MouseMove(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As
stdole.OLE_YPOS_PIXELS)
Dim nodHoover As Node
If Button = 0 Then
X_Pixels = ConvertTwipsToPixels(X, 0)
Y_Pixels = ConvertTwipsToPixels(Y, 1)
Set nodHoover = TreeView1.HitTest(X_Pixels, Y_Pixels)
Label2.Caption = X & " pix," & X_Pixels & " pix,"
Label3.Caption = Y & " pix," & Y_Pixels & " pix,"
If Not nodHoover Is Nothing Then
Label1.Caption = nodHoover.Text
End If
End If
End Sub

Private Sub UserForm_Initialize()
Dim NodX As Node
Dim L As Long
With TreeView1
..Nodes.Clear
Set NodX = .Nodes.Add(, , "Root", "I am Root")
NodX.Expanded = True
Set NodX = Nothing
Set NodX = .Nodes.Add("Root", tvwChild, "XX", "Item XX")
NodX.Expanded = True
Set NodX = Nothing
For L = 1 To 3
Set NodX = .Nodes.Add("XX", tvwChild, "X" & L, "Item X" & L)
NodX.Expanded = True
Set NodX = Nothing
Next
End With
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
Label1.Caption = "UserForm"
End Sub
================================================== =

Could you please help me?

Thanks,
Karim

It's the other way round. You need to take the pixel values in the vba
event and change them to twips which the HitTest function expects.

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long

Const HWND_DESKTOP As Long = 0
Const LOGPIXELSX As Long = 88
Const LOGPIXELSY As Long = 90

'--------------------------------------------------
Function TwipsPerPixelX() As Single
'--------------------------------------------------
'Returns the width of a pixel, in twips.
'--------------------------------------------------
Dim lngDC As Long
lngDC = GetDC(HWND_DESKTOP)
TwipsPerPixelX = 1440& / GetDeviceCaps(lngDC, LOGPIXELSX)
ReleaseDC HWND_DESKTOP, lngDC
End Function

'--------------------------------------------------
Function TwipsPerPixelY() As Single
'--------------------------------------------------
'Returns the height of a pixel, in twips.
'--------------------------------------------------
Dim lngDC As Long
lngDC = GetDC(HWND_DESKTOP)
TwipsPerPixelY = 1440& / GetDeviceCaps(lngDC, LOGPIXELSY)
ReleaseDC HWND_DESKTOP, lngDC
End Function

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

Dim nodTemp As Node
Dim strText As String

If Button = 0 Then
Set nodTemp = TreeView1.HitTest( _
TwipsPerPixelX * x, TwipsPerPixelY * y)
If Not nodTemp Is Nothing Then
strText = nodTemp.Text
Else
strText = "Nothing"
End If
Me.Caption = "X=" & x & " Y=" & y & " " & strText
End If
End Sub

Cheers
Andy

Karim Benabd wrote:
Hi Andy,

I used a conversion function published by Microsoft with which it is
possible to convert twips (Treeview output) into pixels used by the
MouseMove event.

However, the values given by the conversion function are not accurate.
Here is my code:

Here is the function:

================================================== =
Option Explicit:
'Declarations
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long
'Constants
Const WU_LOGPIXELSX = 88
Const WU_LOGPIXELSY = 90
'Function
Function ConvertTwipsToPixels(lngTwips As Long, lngDirection As Long)
As Long
'Handle to device
Dim lngDC As Long
Dim lngPixelsPerInch As Long
Const nTwipsPerInch = 1440
lngDC = GetDC(0)

If (lngDirection = 0) Then 'Horizontal
lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX)
Else 'Vertical
lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY)
End If
lngDC = ReleaseDC(0, lngDC)
ConvertTwipsToPixels = (lngTwips / nTwipsPerInch) * lngPixelsPerInch
End Function

Here is the code inside the userform with a TreeView and 3 Labels:

Private Sub TreeView1_MouseMove(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As stdole.OLE_XPOS_PIXELS, ByVal Y As
stdole.OLE_YPOS_PIXELS)
Dim nodHoover As Node
If Button = 0 Then
X_Pixels = ConvertTwipsToPixels(X, 0)
Y_Pixels = ConvertTwipsToPixels(Y, 1)
Set nodHoover = TreeView1.HitTest(X_Pixels, Y_Pixels)
Label2.Caption = X & " pix," & X_Pixels & " pix,"
Label3.Caption = Y & " pix," & Y_Pixels & " pix,"
If Not nodHoover Is Nothing Then
Label1.Caption = nodHoover.Text
End If
End If
End Sub

Private Sub UserForm_Initialize()
Dim NodX As Node
Dim L As Long
With TreeView1
.Nodes.Clear
Set NodX = .Nodes.Add(, , "Root", "I am Root")
NodX.Expanded = True
Set NodX = Nothing
Set NodX = .Nodes.Add("Root", tvwChild, "XX", "Item XX")
NodX.Expanded = True
Set NodX = Nothing
For L = 1 To 3
Set NodX = .Nodes.Add("XX", tvwChild, "X" & L, "Item X" & L)
NodX.Expanded = True
Set NodX = Nothing
Next
End With
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
Label1.Caption = "UserForm"
End Sub
================================================== =

Could you please help me?

Thanks,
Karim


--

Andy Pope, Microsoft MVP - Excel
http://www.andypope.info

Thanks Andy. It works fine and deserves 5 stars.

Cheers,
Karim