Imports System.Reflection Imports Softelvdm.Controls Imports Softelvdm.SftTreeNET Public Class Form1 Public Class InfoTip Private Shared InfoTips As New Microsoft.VisualBasic.Collection() Public Delegate Sub FPtr() Private _Loc As Point Private _Text As String Private _Title As String Private _ArrowLoc As ArrowLocationEnum = -1 Private _Func As FPtr = Nothing Private _FuncEnd As FPtr = Nothing Private _Interval As Integer = 0 Sub New(ByVal Interval As Integer, ByVal Loc As Point, ByVal Title As String, ByVal Text As String, ByVal ArrowLoc As ArrowLocationEnum, ByVal Func As FPtr, ByVal FuncEnd As FPtr) Me._Interval = Interval * 1000 Me._Title = Title Me._Loc = Loc Me._Text = Text Me._ArrowLoc = ArrowLoc Me._Func = Func Me._FuncEnd = FuncEnd End Sub Sub New(ByVal Loc As Point, ByVal Text As String) Me._Loc = Loc Me._Text = Text End Sub Public Shared Sub Clear() InfoTips.Clear() End Sub Public Shared Sub Add(ByVal Loc As Point, ByVal Text As String) Dim t As InfoTip = New InfoTip(0, Loc, "", Text, -1, Nothing, Nothing) InfoTips.Add(t) End Sub Public Shared Sub Add(ByVal Loc As Point, ByVal Text As String, ByVal ArrowLoc As ArrowLocationEnum) Dim t As InfoTip = New InfoTip(0, Loc, "", Text, ArrowLoc, Nothing, Nothing) InfoTips.Add(t) End Sub Public Shared Sub Add(ByVal Interval As Integer, ByVal Loc As Point, ByVal Title As String, ByVal Text As String, ByVal ArrowLoc As ArrowLocationEnum, ByVal Func As FPtr, ByVal FuncEnd As FPtr) Dim t As InfoTip = New InfoTip(Interval, Loc, Title, Text, ArrowLoc, Func, FuncEnd) InfoTips.Add(t) End Sub Public Shared Sub Add(ByVal Loc As Point, ByVal Title As String, ByVal Text As String, ByVal ArrowLoc As ArrowLocationEnum, ByVal Func As FPtr, ByVal FuncEnd As FPtr) Dim t As InfoTip = New InfoTip(0, Loc, Title, Text, ArrowLoc, Func, FuncEnd) InfoTips.Add(t) End Sub Public Shared ReadOnly Property Count() As Integer Get Return InfoTips.Count End Get End Property Public Shared ReadOnly Property Info(ByVal index As Integer) As InfoTip Get Return InfoTips(index + 1) End Get End Property Public ReadOnly Property Location() As Point Get Return _Loc End Get End Property Public ReadOnly Property Title() As String Get If _Title = "" Then Return "SftTree/NET 2.0 Features" Return _Title End Get End Property Public ReadOnly Property Text() As String Get Return _Text End Get End Property Public ReadOnly Property ArrowLoc() As String Get Return _ArrowLoc End Get End Property Public ReadOnly Property Func() As FPtr Get Return _Func End Get End Property Public ReadOnly Property FuncEnd() As FPtr Get Return _FuncEnd End Get End Property Public ReadOnly Property Interval() As Integer Get If _Interval <= 0 Then Return 5000 Return _Interval End Get End Property End Class Private Sub Optimize() sftTree1.Initializing = True sftTree1.Columns.MakeOptimal(0, False) sftTree1.RowHeaders.MakeOptimal(0, False) sftTree1.Splitter.MakeOptimal() sftTree1.RecalcHorizontalExtent() sftTree1.Initializing = False End Sub Private Sub AdjustInfo() Dim cr As Rectangle = sftTree1.ClientRectangle Dim xcenter As Integer = cr.Width / 2 Dim ybottom As Integer = cr.Height - SystemInformation.HorizontalScrollBarHeight Dim r As Rectangle InfoTip.Clear() InfoTip.Add(4, New Point(xcenter / 2, ybottom / 4), "", _ "This demo will show some of the many features you will find in this product." + vbCrLf + vbCrLf + _ "To end this demo, please close this window.", ArrowLocationEnum.TopLeft, Nothing, Nothing) InfoTip.Add(5, New Point(xcenter / 2, ybottom / 4), "", "From simple tree control...", ArrowLocationEnum.TopLeft, AddressOf SimpleTree, Nothing) InfoTip.Add(5, New Point(xcenter / 2, ybottom / 4), "", "...back to a grid-like hierarchical tree control", ArrowLocationEnum.TopLeft, AddressOf ComplexTree, Nothing) InfoTip.Add(New Point(xcenter, 0 + sftTree1.Headers.Height / 2), "Optional headers with one or multiple rows") InfoTip.Add(New Point(xcenter, ybottom - sftTree1.Footers.Height / 2), "Optional footers with one or multiple rows") r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(5).RowHeader) InfoTip.Add(New Point(0 + sftTree1.RowHeaders.Width / 2, r.Y), "", "Optional row headers for items, headers and footers", ArrowLocationEnum.LeftTop, Nothing, AddressOf RowHeadersOff) InfoTip.Add(New Point(0 + sftTree1.RowHeaders.Width / 2, r.Y), "", "Without row headers", ArrowLocationEnum.LeftTop, Nothing, AddressOf RowHeadersOn) Dim pt As New Point(sftTree1.Splitter.Area.Location.X + sftTree1.Splitter.Area.Width / 2, ybottom / 2) InfoTip.Add(pt, "Optional splitter bar", ArrowLocationEnum.TopLeft) InfoTip.Add(pt, "", "Without splitter bar", ArrowLocationEnum.TopLeft, AddressOf SplitterOff, AddressOf SplitterOn) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(0).Cells(1)) InfoTip.Add(CenterOf(r), "Cells can display one or multiple images (and other parts)", ArrowLocationEnum.LeftTop) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(1).Cells(1)) InfoTip.Add(CenterOf(r), "Cells can contain clickable buttons (and other parts)", ArrowLocationEnum.LeftTop) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(2).Cells(1)) InfoTip.Add(CenterOf(r), "Cells can contain checkboxes (and other parts)", ArrowLocationEnum.LeftTop) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(3).Cells(1)) InfoTip.Add(CenterOf(r), "Cells can contain radiobuttons (and other parts)", ArrowLocationEnum.LeftTop) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(4).Cells(1)) InfoTip.Add(CenterOf(r), "Cells can contain dropdown buttons (and other parts)", ArrowLocationEnum.BottomLeft) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(5).Cells(1)) InfoTip.Add(CenterOf(r), "Cells can contain progress bars (and other parts)", ArrowLocationEnum.LeftTop) r = sftTree1.GetDimension(sftTree1.ItemCollection(1).Cells(1)) InfoTip.Add(CenterOf(r), "Even many clickable parts within the same cell") r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Cells(0)) InfoTip.Add(CenterOf(r), "Any one column can display the hierarchy" + vbCrLf + "with tree lines and item images", ArrowLocationEnum.BottomLeft) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Cells(1)) InfoTip.Add(CenterOf(r), "", "Any one column can display the hierarchy" + vbCrLf + "with tree lines and item images", ArrowLocationEnum.BottomLeft, AddressOf HierarchyOnColumn1, Nothing) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Cells(2)) InfoTip.Add(CenterOf(r), "", "Any one column can display the hierarchy" + vbCrLf + "with tree lines and item images", ArrowLocationEnum.BottomLeft, AddressOf HierarchyOnColumn2, Nothing) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Cells(0)) InfoTip.Add(CenterOf(r), "", "Any one column can display the hierarchy" + vbCrLf + "with tree lines and item images", ArrowLocationEnum.BottomLeft, AddressOf HierarchyOnColumn0, Nothing) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Cells(0)) Dim loc As Point = r.Location loc.X = sftTree1.RowHeaders.Width + 5 InfoTip.Add(loc, "", "Fully customizable expand/collapse buttons and connecting tree lines", ArrowLocationEnum.BottomLeft, AddressOf ExpandCollapseButtonsSimple, Nothing) InfoTip.Add(loc, "", "Expand/collapse buttons with Windows Vista look (even without Windows Vista)", ArrowLocationEnum.BottomLeft, AddressOf ExpandCollapseButtonsVista, Nothing) InfoTip.Add(loc, "", "Fully customizable expand/collapse buttons and connecting tree lines", ArrowLocationEnum.BottomLeft, AddressOf ExpandCollapseButtonsXP, AddressOf ExpandCollapseButtonsNormal) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Cells(0)) InfoTip.Add(CenterOf(r), "", "Support for single item selection", ArrowLocationEnum.BottomLeft, AddressOf SelectOneItem, Nothing) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Cells(0)) InfoTip.Add(CenterOf(r), "", "Support for multiple item selection", ArrowLocationEnum.BottomLeft, AddressOf SelectItems, Nothing) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Cells(1)) InfoTip.Add(CenterOf(r), "", "Support for single cell selection", ArrowLocationEnum.BottomLeft, AddressOf SelectOneCell, Nothing) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Cells(1)) InfoTip.Add(CenterOf(r), "", "Support for multiple cell selection", ArrowLocationEnum.BottomLeft, AddressOf SelectCells, AddressOf SelectOneItem) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(3).Cells(0)) InfoTip.Add(New Point(r.Location.X - 8, r.Location.Y + r.Height / 5), "Item images can be customized for each item", ArrowLocationEnum.BottomLeft) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(0).RowHeader) InfoTip.Add(CenterOf(r), "Vertical cell merging to visually combine similar data", ArrowLocationEnum.LeftTop) r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Cells(2)) InfoTip.Add(CenterOf(r), "Horizontal cell merging to visually combine similar data") r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(1).Cells(2)) InfoTip.Add(6, CenterOf(r), "", "Vertical cell merging to visually combine similar data" + vbCrLf + "Of course, all parts and color definitions are also applied when cells are merged", ArrowLocationEnum.LeftTop, Nothing, Nothing) r = sftTree1.GetDimension(sftTree1.Headers(1, 0)) InfoTip.Add(CenterOf(r), "All parts (like dropdown buttons) are also available in headers", ArrowLocationEnum.TopLeft) r = sftTree1.GetDimension(sftTree1.Footers(0, 0).OwningItem.RowHeader) InfoTip.Add(CenterOf(r), "Parts (like checkboxes) are even available in footers") r = sftTree1.GetDimension(sftTree1.Headers(1, 3)) InfoTip.Add(CenterOf(r), "Sorting data is easily accomplished (even multi-column sorting)") r = sftTree1.GetDimension(sftTree1.Headers(1, 2)) InfoTip.Add(CenterOf(r), "Columns can be reordered and resized") r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Cells(3)) InfoTip.Add(CenterOf(r), "Use colors and gradient fills to make important data noticeable") r = sftTree1.GetDimension(sftTree1.ItemCollection(0).Children(0).Children(4).Cells(3)) InfoTip.Add(CenterOf(r), "Even parts can have their own background color within a cell (with its own background color)") r = sftTree1.GetDimension(sftTree1.Headers(1, 0)) InfoTip.Add(CenterOf(r), "SftTree/NET 2.0 is available now!") r = sftTree1.GetDimension(sftTree1.Footers(0, 2)) InfoTip.Add(CenterOf(r), "Click here to order SftTree/NET 2.0" + vbCrLf + "for immediate online delivery!") InfoTip.Add(15, New Point(cr.Width - 25, 0), "There are many more features to explore in this product.", _ "Make sure to try the control that we added to Visual Studio's toolbox" + vbCrLf + _ "and review the complete online help and sample source code." + vbCrLf + vbCrLf + _ "To end this demo, please close this window.", ArrowLocationEnum.RightTop, Nothing, Nothing) End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Optimize() AdjustInfo() End Sub Private Sub SimpleTree() sftTree1.Initializing = True sftTree1.Splitter.Visible = False sftTree1.RowHeaders.Width = 0 sftTree1.Columns(1).Width = 0 sftTree1.Columns(2).Width = 0 sftTree1.Columns(3).Width = 0 sftTree1.Columns(4).Width = 0 sftTree1.Columns(5).Width = 0 sftTree1.GridLines = GridLinesStyleEnum.None sftTree1.Headers.Visible = False sftTree1.Footers.Visible = False sftTree1.Initializing = False End Sub Private Sub ComplexTree() sftTree1.Initializing = True sftTree1.Splitter.Visible = True sftTree1.GridLines = GridLinesStyleEnum.Both sftTree1.Headers.Visible = True sftTree1.Footers.Visible = True Optimize() AdjustInfo() sftTree1.Initializing = False End Sub Private Sub RowHeadersOff() sftTree1.RowHeaders.Width = 0 End Sub Private Sub RowHeadersOn() Optimize() AdjustInfo() End Sub Private Sub ExpandCollapseButtonsSimple() sftTree1.ButtonLook = ButtonLookEnum.Simple sftTree1.TreeLinesPen = LinesPenStyleEnum.Dots End Sub Private Sub ExpandCollapseButtonsVista() sftTree1.ButtonLook = ButtonLookEnum.ThemedAppearanceVista sftTree1.TreeLineStyle = TreeLineStyleEnum.None End Sub Private Sub ExpandCollapseButtonsXP() sftTree1.ButtonLook = ButtonLookEnum.ThemedAppearanceXP sftTree1.TreeLineStyle = TreeLineStyleEnum.None End Sub Private Sub ExpandCollapseButtonsNormal() sftTree1.ButtonLook = ButtonLookEnum.ThemedSystem sftTree1.TreeLinesPen = LinesPenStyleEnum.Solid sftTree1.TreeLineStyle = TreeLineStyleEnum.AllLevels End Sub Private Sub SelectOneItem() sftTree1.SelectionStyle = SelectionStyleEnum.SingleItem sftTree1.ItemCollection(0).Children(0).Selected = True End Sub Private Sub SelectItems() sftTree1.SelectionStyle = SelectionStyleEnum.MultipleItems sftTree1.ItemCollection(0).Children(0).Selected = True sftTree1.ItemCollection(0).Children(0).Children(0).Selected = True End Sub Private Sub SelectOneCell() sftTree1.SelectionStyle = SelectionStyleEnum.SingleCell sftTree1.ItemCollection(0).Children(0).Cells(1).Selected = True End Sub Private Sub SelectCells() sftTree1.SelectionStyle = SelectionStyleEnum.MultipleCells sftTree1.ItemCollection(0).Children(0).Cells(1).Selected = True sftTree1.ItemCollection(0).Children(0).Cells(2).Selected = True sftTree1.ItemCollection(0).Children(0).Children(0).Cells(1).Selected = True sftTree1.ItemCollection(0).Children(0).Children(0).Cells(2).Selected = True End Sub Private Sub SplitterOff() sftTree1.Splitter.Visible = False End Sub Private Sub SplitterOn() sftTree1.Splitter.Visible = True Update() Optimize() AdjustInfo() End Sub Private Sub HierarchyOnColumn0() sftTree1.Columns(0).ShowHierarchy = True Optimize() AdjustInfo() End Sub Private Sub HierarchyOnColumn1() sftTree1.Columns(1).ShowHierarchy = True Optimize() AdjustInfo() End Sub Private Sub HierarchyOnColumn2() sftTree1.Columns(2).ShowHierarchy = True Optimize() AdjustInfo() End Sub Private Function CenterOf(ByVal r As Rectangle) As Point Dim pt As Point = r.Location pt.Offset(r.Width / 2, r.Height / 2) Return pt End Function Private TimerCounter As Integer = 0 Private ToolTip As ToolTipClass Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick Static Dim LastFunc As InfoTip.FPtr = Nothing If Not LastFunc Is Nothing Then LastFunc() LastFunc = Nothing End If Dim Info As InfoTip = Nothing Do If TimerCounter >= InfoTip.Count Then TimerCounter = 0 Info = InfoTip.Info(TimerCounter) If TimerCounter = 0 Then Exit Do If Info.Location <> Point.Empty And sftTree1.ClientRectangle.Contains(Info.Location) Then Exit Do End If TimerCounter = TimerCounter + 1 Loop Dim ttIcon As ToolTipIcon = ToolTipIcon.Info If Info.Location = Point.Empty Or Not sftTree1.ClientRectangle.Contains(Info.Location) Then Info = New InfoTip(0, New Point(20, 0), "", "The window is too small to" & vbCrLf & "display the informational balloons.", ArrowLocationEnum.TopLeft, Nothing, Nothing) ttIcon = ToolTipIcon.Error End If ToolTip = Nothing ShowToolTip(Info.Location, ttIcon, Info.Title, Info.Text, Info.ArrowLoc) If Not Info.Func Is Nothing Then Dim f As InfoTip.FPtr = Info.Func() f() End If LastFunc = Info.FuncEnd ' save function to call after balloon has been shown Timer1.Interval = Info.Interval TimerCounter = TimerCounter + 1 End Sub Private Sub ShowToolTip(ByVal loc As Point, ByVal ttIcon As ToolTipIcon, ByVal title As String, ByVal text As String, ByVal ArrowLoc As ArrowLocationEnum) ' figure out what quadrant to locate the arrow nicely If ArrowLoc = -1 Then If loc.X < sftTree1.ClientRectangle.Width / 2 Then If loc.X < sftTree1.ClientRectangle.Width / 4 Then If loc.Y < sftTree1.ClientRectangle.Height / 2 Then ArrowLoc = ArrowLocationEnum.LeftTop Else ArrowLoc = ArrowLocationEnum.LeftBottom End If Else If loc.Y < sftTree1.ClientRectangle.Height / 2 Then ArrowLoc = ArrowLocationEnum.TopLeft Else ArrowLoc = ArrowLocationEnum.BottomLeft End If End If Else If loc.X < sftTree1.ClientRectangle.Width / 4 Then If loc.Y > sftTree1.ClientRectangle.Height * 3 / 4 Then ArrowLoc = ArrowLocationEnum.RightTop Else ArrowLoc = ArrowLocationEnum.RightBottom End If Else If loc.Y < sftTree1.ClientRectangle.Height / 2 Then ArrowLoc = ArrowLocationEnum.TopRight Else ArrowLoc = ArrowLocationEnum.BottomLeft End If End If End If End If ToolTipClass.ShowToolTip(sftTree1, loc, ttIcon, title, text, ArrowLoc) End Sub Private Sub sftTree1_ItemClick(ByVal sender As System.Object, ByVal e As Softelvdm.SftTreeNET.ItemClickEventArgs) Handles sftTree1.ItemClick If Not e.Item Is Nothing And Not e.Cell Is Nothing Then If e.Item.UsageLocation = UsageLocationEnum.footer And _ e.Area = ItemClickAreaEnum.Cell And _ e.Item.VisibleIndex = 0 And e.Cell.ColumnIndex = 2 And _ TypeOf e.Part Is ButtonPartClass Then Try System.Diagnostics.Process.Start("http://www.softelvdm.com/treenet.html") Catch ex As Exception End Try End If End If End Sub Private Sub Form1_Resize(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Resize AdjustInfo() End Sub Private Sub sftTree1_ColumnReordered(ByVal sender As System.Object, ByVal e As Softelvdm.SftTreeNET.ColumnReorderedEventArgs) Handles sftTree1.ColumnReordered AdjustInfo() End Sub Private Sub sftTree1_ColumnResized(ByVal sender As System.Object, ByVal e As Softelvdm.SftTreeNET.ColumnResizedEventArgs) Handles sftTree1.ColumnResized AdjustInfo() End Sub Private Sub Form1_Deactivate(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Deactivate Timer1.Enabled = False ToolTipClass.HideToolTip() End Sub Private Sub Form1_Activated(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Activated Timer1.Interval = 500 Timer1.Enabled = True End Sub Private Sub Form1_Move(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Move Timer1.Interval = 2000 ToolTipClass.HideToolTip() End Sub Private Sub sftTree1_ItemCollapsed(ByVal sender As System.Object, ByVal e As Softelvdm.SftTreeNET.ItemCollapsedEventArgs) Handles sftTree1.ItemCollapsed AdjustInfo() End Sub Private Sub sftTree1_ItemExpanded(ByVal sender As System.Object, ByVal e As Softelvdm.SftTreeNET.ItemExpandedEventArgs) Handles sftTree1.ItemExpanded AdjustInfo() End Sub End Class