Hide

SftTree/NET 2.0 - Tree Control for Windows Forms

Display
Print

MergeSample1 (VB)

This sample demonstrates vertical and horizontal cell merging (MergeStyle = EmptyCells), cell images, rotated text in row headers and column headers.

Imports System.Reflection
Imports Softelvdm.Controls
Imports Softelvdm.SftTreeNET

Public Class Form1

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    ' This sample demonstrates cell merging. In this sample, vertical merging
    ' is based on empty subordinate cells (MergeStyle = MergeStyleEnum.EmptyCells).
    ' To prepare for this sample, create a new project with a blank form and add
    ' a SftTree/NET control named sftTree1.
    ' In addition, adjust the following FromFile method to use a (small) bitmap
    ' that is located on your system.
    Dim img As Image = Bitmap.FromFile("..\\..\\test.gif")
    Dim cell As CellClass

    ' Most of this initialization code could be eliminated by designing the control.
    ' Here, all header area, footer area and item area cells are simply populated 
    ' with text. The actual cell merging portion happens later on
    sftTree1.Initializing = True
    sftTree1.Columns.Count = 5
    sftTree1.Headers.Rows = 3
    sftTree1.Footers.Rows = 3
    For r As Integer = 0 To sftTree1.Headers.Rows - 1
        For c As Integer = 0 To sftTree1.Columns.Count - 1
            cell = sftTree1.Headers(r, c) ' access each header cell
            cell.Text = "Column " & c.ToString() ' set the title
        Next
    Next
    For r As Integer = 0 To sftTree1.Footers.Rows - 1
        For c As Integer = 0 To sftTree1.Columns.Count - 1
            cell = sftTree1.Footers(r, c) ' access each header cell
            cell.Text = "Column " + c.ToString() ' set the title
        Next
    Next
    Dim item As ItemClass
    For i As Integer = 0 To 9
        item = sftTree1.ItemCollection.Add(New String() {"Text 0", "Text 1", "Text 2", "Text 3"})
        item.RowHeader.Text = "Row " & i.ToString()
    Next
    ' End of initialization

    ' In this sample, vertical merging is based on empty subordinate cells.
    sftTree1.MergeStyle = MergeStyleEnum.EmptyCells

    ' Merge all cells in the column header vertically (in the second column)
    ' clear the text in all subordinate cells except for the first, main cell
    sftTree1.Headers.MaxLines = 4 ' allow up to 4 text lines 
    For r As Integer = 0 To sftTree1.Headers.Rows - 1
        cell = sftTree1.Headers(r, 1)
        cell.MergeWithLower = BoolOptionalEnum.True
        cell.AllowMergeFromUpper = BoolOptionalEnum.True
        cell.Parts.Clear()
    Next
    Dim tp As TextPartClass = New TextPartClass("Vertical")
    tp.Format = tp.Format Or StringFormatFlags.DirectionVertical
    sftTree1.Headers(0, 1).Parts.Add(tp)
    sftTree1.Headers(0, 1).Parts.Add(New ImagePartClass(img))
    tp = New TextPartClass("Cell merging in" & vbCrLf & "a column header")
    sftTree1.Headers(0, 1).Parts.Add(tp)

    ' Horizontally merge column header cells in row 1, columns 3 + 4
    sftTree1.Headers(1, 3).MergeWithNext = BoolOptionalEnum.True
    sftTree1.Headers(1, 4).AllowMergeFromPrevious = BoolOptionalEnum.True
    sftTree1.Headers(1, 3).Text = "Horizontally merged cells"
    sftTree1.Headers(1, 3).Image = img
    sftTree1.Headers(1, 4).Parts.Clear()

    ' Vertically merge some cells in the column footer (in the last column)
    sftTree1.Footers.MaxLines = 4 ' allow up to 4 text lines 
    For r As Integer = 1 To sftTree1.Footers.Rows - 1
        cell = sftTree1.Footers(r, 4)
        cell.MergeWithLower = BoolOptionalEnum.True
        cell.AllowMergeFromUpper = BoolOptionalEnum.True
        cell.Parts.Clear()
    Next
    sftTree1.Footers(1, 4).Parts.Add(New ImagePartClass(img))
    sftTree1.Footers(1, 4).Text = "Vertical cell merging" & vbCrLf & "(only two cells)"

    ' Horizontally merge cells in the second item (column 1 through last)
    item = sftTree1.ItemCollection(1)
    cell = item.Cells(1)
    Do While Not cell Is Nothing
        cell.AllowMergeFromPrevious = BoolOptionalEnum.True
        cell.MergeWithNext = BoolOptionalEnum.True
        cell.Parts.Clear()
        cell = cell.NextDisplayed
    Loop
    item.Cells(1).Parts.Add(New ImagePartClass(img))
    item.Cells(1).Text = "Horizontally merged cells"

    ' Vertically merge a few cells (in the third column) starting with the fifth item.
    item = sftTree1.ItemCollection(4)
    Do While Not item Is Nothing
        cell = item.Cells(2)
        cell.AllowMergeFromUpper = BoolOptionalEnum.True
        cell.MergeWithLower = BoolOptionalEnum.True
        cell.Parts.Clear()
        item = item.NextSibling
    Loop
    cell = sftTree1.ItemCollection(4).Cells(2)
    cell.Text = "Vertically" & vbCrLf & "merged" & vbCrLf & "cells"
    cell.Image = img

    ' Merge 3 row headers, starting at the second item
    Dim count As Integer = 3
    item = sftTree1.ItemCollection(1)
    Do While Not item Is Nothing And count > 0
        Dim rhd As RowHeaderClass = item.RowHeader
        rhd.AllowMergeFromUpper = BoolOptionalEnum.True
        rhd.MergeWithLower = BoolOptionalEnum.True
        rhd.Parts.Clear()
        count = count - 1
        item = item.NextSibling
    Loop
    item = sftTree1.ItemCollection(1)
    item.RowHeader.Text = "Vertical"
    Dim f As Font = New Font("Arial", 8, FontStyle.Bold, GraphicsUnit.Point)
    item.RowHeader.TextPart.Font = f
    item.RowHeader.TextPart.Format = item.RowHeader.TextPart.Format Or StringFormatFlags.DirectionVertical
    item.RowHeader.Parts.Add(New ImagePartClass(img))

    ' Make column widths and row header area width optimal
    sftTree1.Columns.MakeOptimal(0, False)
    sftTree1.RowHeaders.MakeOptimal(0, False)
    ' Activate the horizontal scrollbar
    sftTree1.RecalcHorizontalExtent()
    sftTree1.Initializing = False
End Sub

' ItemClick event
Private Sub sftTree1_ItemClick(ByVal sender As Object, ByVal e As Softelvdm.SftTreeNET.ItemClickEventArgs) Handles sftTree1.ItemClick
    Debug.Write("** ItemClick")
    Dim itemIndex As Integer = -1
    If Not e.Item Is Nothing Then itemIndex = e.Item.VisibleIndex
    If itemIndex >= 0 Then
        Debug.Write(" Row " & itemIndex.ToString())
    End If
    Dim colIndex As Integer = -1
    If Not e.Cell Is Nothing Then colIndex = e.Cell.ColumnIndex
    If colIndex >= 0 Then
        Debug.Write(" Column " + colIndex.ToString())
    End If
    DumpValues(e)
 DumpValues(e)
End Sub

Private Sub sftTree1_ItemDoubleClick(ByVal sender As Object, ByVal e As Softelvdm.SftTreeNET.ItemClickEventArgs) Handles sftTree1.ItemDoubleClick
    Debug.Write("** ItemDoubleClick")
    DumpValues(e)
End Sub

' This is a small helper routine to show all properties and fields of an object
Private Sub DumpValues(ByVal o As Object)
    Dim api() As PropertyInfo = o.GetType().GetProperties()
    For Each pi As PropertyInfo In api
        Debug.Write(" " & pi.Name & " " & pi.GetValue(o, New Object() ))
    Next
    Dim afi() As FieldInfo = o.GetType().GetFields()
    For Each fi As FieldInfo In afi
        Dim t As Object = fi.GetValue(o)
        Dim s As String = "(null)"
        If Not t Is Nothing Then s = t.ToString()
        Debug.Write(" " & fi.Name & " " & s)
    Next
    Debug.WriteLine("")
End Sub

End Class