Come convenuto ti posto il codice, parte del modulo1 l'ho trovato su internet.
A risentirci, ciao.
Private Sub Form_Load()
With TreeView1
.Nodes.Add , , "main", "Main"
.Nodes.Add "main", TVWCHILD, "item1", "Item 1"
.Nodes.Add "main", TVWCHILD, "item2", "Item 2"
.Nodes.Add "main", TVWCHILD, "item3", "Item 3"
.Nodes.Add "main", TVWCHILD, "item4", "Item 4"
.Nodes.Add "main", TVWCHILD, "item5", "Item 5"
.Nodes("main").Expanded = True
End With
End Sub
Private Sub TreeView1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Long, ByVal Y As Long)
Dim getRect As RECT
Dim hitemTV As Long
Dim hwndTV As Long
Dim NodeX As MSComctlLib.Node
Set NodeX = TreeView1.Object.SelectedItem
If NodeX Is Nothing Or NodeX.Text = "Main" Then Exit Sub
getRect.Bottom = 0
getRect.Left = 0
getRect.Right = 0
getRect.Top = 0
If Button = eMouse.RightClick Then
hwndTV = TreeView1.hWnd
hitemTV = SendMessageLong(hwndTV, TVM_GETNEXTITEM, TVGN_CARET, 0&)
getRect = GetTreeViewNodeRect(TreeView1.Object, hitemTV)
TreePopup getRect
End If
End Sub
'***************************Modulo1****************************************************
Option Compare Database
Option Explicit
Private Declare Function ClientToScreen Lib "user32.dll" (ByVal hWnd As Long, ByRef lpPoint As POINTAPI) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Enum eMouse
leftClick = 1
RightClick = 2
End Enum
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type POINTAPI
X As Long
Y As Long
End Type
Public Const HWND_DESKTOP As Long = 0
Public Const WU_LOGPIXELSX = 88
Public Const WU_LOGPIXELSY = 90
Public Const TVGN_CARET As Long = &H9
Public Const TV_FIRST = &H1100
Public Const TVM_GETITEMRECT = (TV_FIRST + 4)
Public Const TVM_GETITEM As Long = (TV_FIRST + 12)
Public Const TVWFIRST = 0
Public Const TVM_GETNEXTITEM As Long = (TV_FIRST + 10)
'--------------------------------------------------------------------------------------------
Public Function GetTreeViewNodeRect(ByVal TV As MSComctlLib.TreeView, ByVal hItem As Long) As RECT
Dim lpRect As RECT
' the function expects in input the handle of the item
' at the beginning of the RECT structure
lpRect.Left = hItem
If SendMessage(TV.hWnd, TVM_GETITEMRECT, True, lpRect) Then
' a non-zero value means that the item is visible
GetTreeViewNodeRect = lpRect
End If
End 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
'ConvertTwipsToPixels = 1440& / lngPixelsPerInch
End Function
'----------------------------------------------------------------------------------------------
Public Function ConvertPIXELSToTWIPS(lPixel As Long, lDirection As Long) As Long
Dim hdc As Long
Dim RetVal As Long
Dim PIXELSPERINCH As Long
Const nTwipsPerInch = 1440
hdc = GetDC(0)
' Horizontal
If (lDirection = 0) Then
PIXELSPERINCH = GetDeviceCaps(hdc, WU_LOGPIXELSX)
' Vertical
Else
PIXELSPERINCH = GetDeviceCaps(hdc, WU_LOGPIXELSY)
End If
'*RetVal = ReleaseDC(0, hdc)
ConvertPIXELSToTWIPS = (lPixel / PIXELSPERINCH) * nTwipsPerInch
RetVal = ReleaseDC(0, hdc)
End Function
'----------------------------------------------------------------------------------------------
Public Sub TreePopup(MyControl As RECT)
Dim lt_Pt As POINTAPI
Dim obar As CommandBar
Dim MyForm As Form
Set MyForm = Screen.ActiveForm
Set obar = CommandBars.Add(, msoBarPopup, False, True)
Dim cmdNuovaTipologia As CommandBarButton
Set cmdNuovaTipologia = obar.Controls.Add(msoControlButton)
cmdNuovaTipologia.Caption = "Aggiungi Tipologia"
cmdNuovaTipologia.Style = msoButtonIconAndCaption
Dim cmdEditTipologia As CommandBarButton
Set cmdEditTipologia = obar.Controls.Add(msoControlButton)
cmdEditTipologia.Caption = "Modifica Tipologia"
cmdEditTipologia.Style = msoButtonIconAndCaption
'cmdEditTipologia.OnAction = "=ModificaTipologia()"
Dim cmdDeleteTipologia As CommandBarButton
Set cmdDeleteTipologia = obar.Controls.Add(msoControlButton)
cmdDeleteTipologia.Caption = "Cancella Tipologia"
cmdDeleteTipologia.Style = msoButtonIconAndCaption
'cmdDeleteTipologia.OnAction = "=CancellaTipologia()"
Dim cmdNewDPI As CommandBarButton
Set cmdNewDPI = obar.Controls.Add(msoControlButton)
cmdNewDPI.Caption = "Aggiungi" '& strNomeTipologia
cmdNewDPI.Style = msoButtonIconAndCaption
' Get position for popup menu based on button position & height
lt_Pt.X = MyControl.Left + MyForm!TreeView1.Left + MyForm!TreeView1.Indentation '+ 200 '/ 2 'Me.PushButton1.Left
lt_Pt.Y = MyForm!TreeView1.Top + (MyControl.Top + (MyControl.Bottom - MyControl.Top))
lt_Pt.X = ConvertTwipsToPixels(lt_Pt.X, 0)
lt_Pt.Y = ConvertTwipsToPixels(lt_Pt.Y, 1)
ClientToScreen Screen.ActiveForm!TreeView1.hWnd, lt_Pt
obar.ShowPopup lt_Pt.X, lt_Pt.Y
'cleanup
Set MyForm = Nothing
Set obar = Nothing
End Sub