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
On
Off