Imports System.Globalization Imports System.Windows.Forms.VisualStyles.VisualStyleElement.TextBox Imports System.Windows.Media.Media3D Public Module TreeViewItemHelper ' Gestione MouseOver come in ListBox Private CurrentItem As TreeViewItem Private ReadOnly UpdateOverItemEvent As RoutedEvent = EventManager.RegisterRoutedEvent("UpdateOverItem", RoutingStrategy.Bubble, GetType(RoutedEventHandler), GetType(TreeViewItemHelper)) Private ReadOnly IsMouseDirectlyOverItemKey As DependencyPropertyKey = DependencyProperty.RegisterAttachedReadOnly("IsMouseDirectlyOverItem", GetType(Boolean), GetType(TreeViewItemHelper), New FrameworkPropertyMetadata(Nothing, New CoerceValueCallback(AddressOf CalculateIsMouseDirectlyOverItem))) Public ReadOnly IsMouseDirectlyOverItemProperty As DependencyProperty = IsMouseDirectlyOverItemKey.DependencyProperty Sub New() EventManager.RegisterClassHandler(GetType(TreeViewItem), UIElement.MouseEnterEvent, New MouseEventHandler(AddressOf OnMouseTransition), True) EventManager.RegisterClassHandler(GetType(TreeViewItem), UIElement.MouseLeaveEvent, New MouseEventHandler(AddressOf OnMouseTransition), True) EventManager.RegisterClassHandler(GetType(TreeViewItem), UpdateOverItemEvent, New RoutedEventHandler(AddressOf OnUpdateOverItem)) End Sub Function GetIsMouseDirectlyOverItem(ByVal obj As DependencyObject) As Boolean Return CBool(obj.GetValue(IsMouseDirectlyOverItemProperty)) End Function Private Function CalculateIsMouseDirectlyOverItem(ByVal item As DependencyObject, ByVal value As Object) As Object Return item Is CurrentItem End Function Private Sub OnUpdateOverItem(ByVal sender As Object, ByVal e As RoutedEventArgs) CurrentItem = TryCast(sender, TreeViewItem) CurrentItem.InvalidateProperty(IsMouseDirectlyOverItemProperty) e.Handled = True End Sub Private Sub OnMouseTransition(ByVal sender As Object, ByVal e As MouseEventArgs) SyncLock IsMouseDirectlyOverItemProperty If Not IsNothing(CurrentItem) Then Dim oldItem As DependencyObject = CurrentItem CurrentItem = Nothing oldItem.InvalidateProperty(IsMouseDirectlyOverItemProperty) End If Mouse.DirectlyOver?.RaiseEvent(New RoutedEventArgs(UpdateOverItemEvent)) End SyncLock End Sub ' Gestione click destro del mouse che seleziona l'elemento Public ReadOnly SelectItemOnRightClickProperty As DependencyProperty = DependencyProperty.RegisterAttached("SelectItemOnRightClick", GetType(Boolean), GetType(TreeViewItemHelper), New UIPropertyMetadata(False, AddressOf OnSelectItemOnRightClickChanged)) Public Function GetSelectItemOnRightClick(ByVal d As DependencyObject) As Boolean Return CBool(d.GetValue(SelectItemOnRightClickProperty)) End Function Public Sub SetSelectItemOnRightClick(ByVal d As DependencyObject, ByVal value As Boolean) d.SetValue(SelectItemOnRightClickProperty, value) End Sub Private Sub OnSelectItemOnRightClickChanged(ByVal d As DependencyObject, ByVal e As DependencyPropertyChangedEventArgs) Dim selectItemOnRightClick As Boolean = CBool(e.NewValue) Dim treeView As TreeView = TryCast(d, TreeView) If treeView IsNot Nothing Then If selectItemOnRightClick Then AddHandler treeView.PreviewMouseRightButtonDown, AddressOf OnPreviewMouseRightButtonDown Else RemoveHandler treeView.PreviewMouseRightButtonDown, AddressOf OnPreviewMouseRightButtonDown End If End If End Sub Private Sub OnPreviewMouseRightButtonDown(ByVal sender As Object, ByVal e As MouseButtonEventArgs) Dim treeViewItem As TreeViewItem = VisualUpwardSearch(Of TreeViewItem)(TryCast(e.OriginalSource, DependencyObject)) If treeViewItem IsNot Nothing Then treeViewItem.IsSelected = True If Not IsNothing(treeViewItem.ContextMenu) Then Dim Tree As TreeView = VisualUpwardSearch(Of TreeView)(TryCast(treeViewItem, DependencyObject)) If Not IsNothing(Tree) Then Dim myTransform As GeneralTransform = treeViewItem.TransformToAncestor(Tree) Dim myOffset As Point = myTransform.Transform(New Point(0, 0)) treeViewItem.ContextMenu.HorizontalOffset = -treeViewItem.ActualWidth + (-myOffset.X) + Tree.ActualWidth - 3 treeViewItem.ContextMenu.VerticalOffset = -3 End If End If e.Handled = True End If End Sub Private Function VisualUpwardSearch(Of T As DependencyObject)(ByVal source As DependencyObject) As T Dim returnVal As DependencyObject = source While returnVal IsNot Nothing AndAlso Not (TypeOf returnVal Is T) Dim tempReturnVal As DependencyObject = Nothing If TypeOf returnVal Is Visual OrElse TypeOf returnVal Is Visual3D Then tempReturnVal = VisualTreeHelper.GetParent(returnVal) End If If tempReturnVal Is Nothing Then returnVal = LogicalTreeHelper.GetParent(returnVal) Else returnVal = tempReturnVal End If End While Return TryCast(returnVal, T) End Function ' Gestione indentazione sottoelementi Public Function GetDepth(item As TreeViewItem) As Integer Dim parent As TreeViewItem = GetParent(item) If Not IsNothing(parent) Then Return GetDepth(parent) + 1 Return 0 End Function Private Function GetParent(item As TreeViewItem) As TreeViewItem Dim parent As DependencyObject = If(Not IsNothing(item), VisualTreeHelper.GetParent(item), Nothing) While Not IsNothing(parent) AndAlso Not (TypeOf parent Is TreeViewItem OrElse TypeOf parent Is TreeView) parent = VisualTreeHelper.GetParent(parent) End While Return TryCast(parent, TreeViewItem) End Function Private Function GetTreeParent(item As TreeViewItem) As TreeViewItem Dim parent As DependencyObject = If(Not IsNothing(item), VisualTreeHelper.GetParent(item), Nothing) While Not IsNothing(parent) AndAlso Not (TypeOf parent Is TreeViewItem OrElse TypeOf parent Is TreeView) parent = VisualTreeHelper.GetParent(parent) End While Return TryCast(parent, TreeViewItem) End Function ' Gestione indentazione sottoelementi Public Function GetHeight(Item As TreeViewItem, SearchedItem As TreeViewItem, ByRef nHeight As Integer) As Boolean Dim Index As Integer = 0 While Index <= Item.Items.Count - 1 If GetHeight(Item.Items(Index), SearchedItem, nHeight) Then nHeight += 1 Return True End If Index += 1 End While Return False End Function End Module Public Class LeftMarginMultiplierConverter Implements IValueConverter Public Property Length As Double Public Function Convert(ByVal value As Object, ByVal targetType As Type, ByVal parameter As Object, ByVal culture As CultureInfo) As Object Implements IValueConverter.Convert Dim item As TreeViewItem = TryCast(value, TreeViewItem) If item Is Nothing Then Return New Thickness(0) Return New Thickness(Length * GetDepth(item), 0, 0, 0) End Function Public Function ConvertBack(ByVal value As Object, ByVal targetType As Type, ByVal parameter As Object, ByVal culture As CultureInfo) As Object Implements IValueConverter.ConvertBack Throw New System.NotImplementedException() End Function End Class