Hide

SftTree/NET 2.0 - Tree Control for Windows Forms

Display
Print

DemoSample Sample (VB)

This sample shows an overview of the tree control's features.

The source code is located at C:\Program Files (x86)\Softelvdm\SftTree NET 2.0\Samples\VB\DemoSample.

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


Spring Break!

Our offices will be closed this week (March 18 through March 22).

We'll be back March 24 to address any pending sales and support issues.