Hide

SftTree/NET 2.0 - Tree Control for Windows Forms

Display
Print

MergeSample2 (VB)

This sample demonstrates vertical and horizontal cell merging (MergeStyle = SameText).

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 identical cell text (MergeStyle = MergeStyleEnum.SameText).
    ' 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 = 0
    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
    Dim item As ItemClass
    For i As Integer = 0 To 3
        item = sftTree1.ItemCollection.Add(New String() {"Text 0", "Text 1", "Text 2", "Text 3", "Text 4"})
        item.RowHeader.Text = "Row " & i.ToString()
    Next
    ' End of initialization

    ' In this sample, vertical merging is based on identical cell text.
    sftTree1.MergeStyle = MergeStyleEnum.SameText

    ' set merging default for each column
    For Each col As ColumnClass In sftTree1.Columns.Collection
        col.MergeWithLowerDefault = True
        col.AllowMergeFromUpperDefault = True
    Next
    ' set merging default for headers and footers
    sftTree1.Headers.MergeWithLowerDefault = True
    sftTree1.Headers.AllowMergeFromUpperDefault = True
    sftTree1.Footers.MergeWithLowerDefault = True
    sftTree1.Footers.AllowMergeFromUpperDefault = True

    ' Horizontally merge column header cells in row 1, columns 1 through 4
    For c As Integer = 1 To 4
        sftTree1.Headers(1, c).AllowMergeFromPrevious = BoolOptionalEnum.True
        sftTree1.Headers(1, c).MergeWithNext = BoolOptionalEnum.True
        sftTree1.Headers(1, c).Parts.Clear()
    Next
    sftTree1.Headers(1, 1).Text = "Horizontally merged cells"
    sftTree1.Headers(1, 1).Image = img

    ' Horizontally merge cells in the second item (starting at 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"
    ' Horizontally merge cells in the third item (starting at column 1 through last)
    item = sftTree1.ItemCollection(2)
    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 = sftTree1.ItemCollection(2)
    item.Cells(1).Parts.Add(New ImagePartClass(img))
    item.Cells(1).Text = "Another horizontally merged cell"

    ' Merge 2 row headers, starting at the second item
    Dim count As Integer = 2
    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.Text = "Merge"
        count = count - 1
        item = item.NextSibling
    Loop
    Dim f As Font = New Font("Arial", 8, FontStyle.Bold, GraphicsUnit.Point)
    sftTree1.ItemCollection(1).RowHeader.TextPart.Font = f
    sftTree1.ItemCollection(1).RowHeader.TextPart.Format = sftTree1.ItemCollection(1).RowHeader.TextPart.Format Or StringFormatFlags.DirectionVertical
    sftTree1.ItemCollection(1).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


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.