View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Andy Pope Andy Pope is offline
external usenet poster
 
Posts: 2,489
Default TreeView mousemove event

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