SftTree/OCX 7.5 - ActiveX Tree Control

Email Sample (VB.NET)

This sample illustrates using a splitter bar, cell merging, cell images, sorting, column reordering.

The source code is located at C:\Program Files (x86)\Softelvdm\SftTree OCX 7.5\Samples\Visual Studio - VB.NET\Email\Form1.vb or C:\Program Files\Softelvdm\SftTree OCX 7.5\Samples\Visual Studio - VB.NET\Email\Form1.vb (on 32-bit Windows versions).

    Private m_InboxFolder As Integer = 0      ' IDs for various top-level folders
    Private m_OutboxFolder As Integer = 0
    Private m_SavedFolder As Integer = 0
    Private m_DeletedFolder As Integer = 0
    Private m_BoldFont As stdole.IFontDisp = Nothing ' saved bold font
    ' in case many cells use the same font, it preserves resources to
    ' save one instance of an OLE font object

    Private Sub Command1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Command1.Click
        Application.Exit()
    End Sub

    Private Function AddFolder(ByVal Folder As String, ByVal Desc As String, ByVal Count As Integer) As Integer

        Dim ItemIndex As Integer
        ItemIndex = AxSftTree1.Items.Add(Folder) ' add folder
        AxSftTree1.get_Cell(ItemIndex, 1).Text = Desc ' add description
        AxSftTree1.get_Cell(ItemIndex, 3).Text = Count.ToString() ' add number of messages
        AxSftTree1.get_Cell(ItemIndex, 3).Data = Count ' also save number of messages for sorting

        ' make the folder name bold
        If m_BoldFont Is Nothing Then
            m_BoldFont = AxSftTree1.get_Cell(ItemIndex, 0).Font
            m_BoldFont.Bold = True
        End If
        AxSftTree1.get_Cell(ItemIndex, 0).Font = m_BoldFont

        ' if this folder has no messages (ie. dependents), we still want the
        ' folder graphic, not the email (leaf) graphic
        If Count = 0 Then
            AxSftTree1.get_Item(ItemIndex).Image = AxSftTree1.Items.ItemImageExpandable
        End If

        AddFolder = AxSftTree1.get_Item(ItemIndex).ID
    End Function

    Private Function AddMessage(ByVal Level As Integer, ByVal Email As String, ByVal Desc As String, ByVal Dt As String, ByVal Size As Integer, ByVal Attachment As Boolean) As Integer
        Dim ItemIndex As Integer
        ItemIndex = AxSftTree1.Items.Add(Email) ' add folder
        AxSftTree1.get_Item(ItemIndex).Level = Level
        AxSftTree1.get_Cell(ItemIndex, 1).Text = Desc ' add description
        AxSftTree1.get_Cell(ItemIndex, 2).Text = Dt ' add date
        AxSftTree1.get_Cell(ItemIndex, 3).Text = Size.ToString() + "K"
        AxSftTree1.get_Cell(ItemIndex, 3).Data = Size ' also save size for sorting
        ' if this email has replies (ie. dependents), we still want the
        ' email graphic, not the expand folder image
        AxSftTree1.get_Item(ItemIndex).Image = AxSftTree1.Items.ItemImageLeaf
        ' if the email has an attachment, show the image
        If Attachment Then
            AxSftTree1.get_Cell(ItemIndex, 1).Image.NETImageObject = Attach.Image
            AxSftTree1.get_Cell(ItemIndex, 1).ImageHAlign = SftTreeHAlignConstants.halignSftTreeRight
        End If
        Return AxSftTree1.get_Item(ItemIndex).ID
    End Function

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim ItemIndex As Integer
        m_InboxFolder = AddFolder("Inbox", "Viewed and unviewed mail", 10)
        AddMessage(1, "support@softelvdm.com", "Re: A support question", "10/09/05", 88, True)
        AddMessage(1, "anyone@acompany.com", "Re: Why did you say that", "10/10/05", 5, False)
        AddMessage(1, "anyone@acompany.com", "Re: You're fired", "10/11/05", 82, True)
        AddMessage(1, "anyone@acompany.com", "Re: You're hired", "10/11/05", 6, False)
        ItemIndex = AxSftTree1.Items.ItemIndex(m_InboxFolder)
        AxSftTree1.get_Item(ItemIndex).Collapse(False)
        m_OutboxFolder = AddFolder("Outbox", "Mail about to be sent", 2)
        AddMessage(1, "me@mycompany.com", "Re: You're fired", "10/11/05", 5, False)
        AddMessage(1, "anyone@acompany.com", "Re: Why did you say that", "10/10/05", 5, False)
        ItemIndex = AxSftTree1.Items.ItemIndex(m_OutboxFolder)
        AxSftTree1.get_Item(ItemIndex).Collapse(False)
        m_SavedFolder = AddFolder("Saved", "Saved messages", 2)
        AddMessage(1, "me@mycompany.com", "A support question", "10/09/05", 3, False)
        AddMessage(2, "support@softelvdm.com", "Re: A support question", "10/09/05", 88, True)
        AddMessage(3, "me@mycompany.com", "Re: A support question", "10/09/05", 3, False)
        AddMessage(1, "me@mycompany.com", "Why did you say that", "10/06/05", 5, False)
        AddMessage(2, "anyone@acompany.com", "Re: Why did you say that", "10/10/05", 5, False)
        AddMessage(1, "me@mycompany.com", "You're fired", "10/08/05", 2, False)
        AddMessage(2, "anyone@acompany.com", "Re: You're fired", "10/11/05", 82, False)
        AddMessage(1, "me@mycompany.com", "You're hired", "10/01/05", 4, False)
        AddMessage(1, "anyone@acompany.com", "Re: You're hired", "10/11/05", 6, False)
        ItemIndex = AxSftTree1.Items.ItemIndex(m_SavedFolder)
        AxSftTree1.get_Item(ItemIndex).Collapse(False)
        m_DeletedFolder = AddFolder("Deleted", "Deleted messages", 0)
        AxSftTree1.ColumnsObj.MakeOptimal()
        AxSftTree1.Items.RecalcHorizontalExtent()
        AxSftTree1.Splitter.MakeOptimal()
        ' allow sorting
        AxSftTree1.Headers.SortIndicators = SftTreeHeaderSortIndicatorsConstants.headerSortIndicatorsSftTreeAuto

        AxSftTree1.Items.Current = 0
        AxSftTree1_CaretChange(Me, New _DSftTreeEvents_CaretChangeEvent(0))
    End Sub

    Private Sub AxSftTree1_CaretChange(ByVal sender As Object, ByVal e As AxSftTreeLib75._DSftTreeEvents_CaretChangeEvent) Handles AxSftTree1.CaretChange
        ' set column headers based on selected item
        Dim ID As Integer
        ID = AxSftTree1.get_Item(e.itemIndex).ID
        If ID = m_InboxFolder Or ID = m_OutboxFolder Or ID = m_SavedFolder Or ID = m_DeletedFolder Then
            AxSftTree1.get_Header(0).Text = "Folder"
            AxSftTree1.get_Header(1).Text = "Description"
            AxSftTree1.get_Header(2).Text = "" ' we can use this to merge the adjacent title
            AxSftTree1.get_Header(3).Text = "Msgs"
        Else
            AxSftTree1.get_Header(0).Text = "From"
            AxSftTree1.get_Header(1).Text = "Subject"
            AxSftTree1.get_Header(2).Text = "Received"
            AxSftTree1.get_Header(3).Text = "Size"
        End If
    End Sub

    Private Sub AxSftTree1_ItemClick(ByVal sender As Object, ByVal e As AxSftTreeLib75._DSftTreeEvents_ItemClickEvent) Handles AxSftTree1.ItemClick
        Dim AreaType As Short = e.areaType
        If AreaType = SftTreeAreaTypeConstants.constSftTreeButton Then
            If (AxSftTree1.get_Item(e.itemIndex).Expanded) Then
                AxSftTree1.get_Item(e.itemIndex).Collapse(True)
            Else
                AxSftTree1.get_Item(e.itemIndex).Expand(True, False)
            End If
        ElseIf AreaType = SftTreeAreaTypeConstants.constSftTreeText Then
            ' edit description
            If e.colIndex = 1 Then
                AxSftTree1.get_Cell(e.itemIndex, e.colIndex).Edit(0, 0)
            End If
        ElseIf AreaType = SftTreeAreaTypeConstants.constSftTreeColumn Then
            Dim SortedColumn As Integer
            SortedColumn = AxSftTree1.Headers.SortedColumn
            If SortedColumn >= 0 Then
                ' we have to sort based on current column headers
                Dim ItemIndex As Integer
                ItemIndex = AxSftTree1.Items.Current
                Dim ID As Integer
                ID = 0
                If ItemIndex >= 0 Then
                    ID = AxSftTree1.get_Item(ItemIndex).ID
                End If
                If ID = m_InboxFolder Or ID = m_OutboxFolder Or ID = m_SavedFolder Or ID = m_DeletedFolder Then
                    ' we're on a folder, so sort on folder level
                    If AxSftTree1.get_Header(SortedColumn).SortIndicator = SftTreeSortIndicatorConstants.sortIndicatorSftTreeAscending Then
                        If (SortedColumn = 3) Then
                            ' last column is sorted by Cell.Data (numeric values)
                            AxSftTree1.Items.SortDependents(-1, SortedColumn, SftTreeSortTypeConstants.sortSftTreeAscCellItemData)
                        Else
                            AxSftTree1.Items.SortDependents(-1, SortedColumn, SftTreeSortTypeConstants.sortSftTreeAscending)
                        End If
                    Else
                        If (SortedColumn = 3) Then
                            AxSftTree1.Items.SortDependents(-1, SortedColumn, SftTreeSortTypeConstants.sortSftTreeDscCellItemData)
                        Else
                            AxSftTree1.Items.SortDependents(-1, SortedColumn, SftTreeSortTypeConstants.sortSftTreeDescending)
                        End If
                    End If
                Else
                    ' we're on a message, sort inside folders
                    ' now sort the dependents of all folders
                    ItemIndex = 0
                    Do
                        If AxSftTree1.get_Header(SortedColumn).SortIndicator = SftTreeSortIndicatorConstants.sortIndicatorSftTreeAscending Then
                            If SortedColumn = 3 Then
                                ' last column is sorted by Cell.Data (numeric values)
                                AxSftTree1.Items.SortDependents(ItemIndex, SortedColumn, SftTreeSortTypeConstants.sortSftTreeAscCellItemData)
                            Else
                                AxSftTree1.Items.SortDependents(ItemIndex, SortedColumn, SftTreeSortTypeConstants.sortSftTreeAscending)
                            End If
                        Else
                            If SortedColumn = 3 Then
                                AxSftTree1.Items.SortDependents(ItemIndex, SortedColumn, SftTreeSortTypeConstants.sortSftTreeDscCellItemData)
                            Else
                                AxSftTree1.Items.SortDependents(ItemIndex, SortedColumn, SftTreeSortTypeConstants.sortSftTreeDescending)
                            End If
                        End If
                        ItemIndex = AxSftTree1.get_Item(ItemIndex).NextSibling
                    Loop While ItemIndex >= 0
                End If
                ' update column headers by calling CaretChange
                AxSftTree1_CaretChange(Me, New _DSftTreeEvents_CaretChangeEvent(AxSftTree1.Items.Current))
            End If
        End If
    End Sub

    Private Sub AxSftTree1_ItemDblClick(ByVal sender As Object, ByVal e As AxSftTreeLib75._DSftTreeEvents_ItemDblClickEvent) Handles AxSftTree1.ItemDblClick
        Dim AreaType As SftTreeAreaTypeConstants = e.areaType
        If AreaType = SftTreeAreaTypeConstants.constSftTreeText Or AreaType = SftTreeAreaTypeConstants.constSftTreeButton Then
            ' if an item on level 1 or lower is clicked, it's an
            ' email message, display message box
            If AxSftTree1.get_Item(e.itemIndex).Level > 0 And AreaType = SftTreeAreaTypeConstants.constSftTreeText Then
                MessageBox.Show("You could be viewing the message from " & AxSftTree1.get_Cell(e.itemIndex, 0).Text & _
                    " with the subject '" & AxSftTree1.get_Cell(e.itemIndex, 1).Text + "'.")
            Else
                ' otherwise just expand or collapse the item
                If (AxSftTree1.get_Item(e.itemIndex).Expanded) Then
                    AxSftTree1.get_Item(e.itemIndex).Collapse(True)
                Else
                    AxSftTree1.get_Item(e.itemIndex).Expand(True, False)
                End If
            End If
        ElseIf AreaType = SftTreeAreaTypeConstants.constSftTreeColumnRes Then
            If e.colIndex >= 0 Then
                AxSftTree1.get_Column(e.colIndex).MakeOptimal()
                AxSftTree1.Items.RecalcHorizontalExtent()
            Else
                AxSftTree1.Splitter.MakeOptimal()
            End If
        End If
    End Sub

    Private Sub AxSftTree1_EditAllowed(ByVal sender As Object, ByVal e As AxSftTreeLib75._DSftTreeEvents_EditAllowedEvent) Handles AxSftTree1.EditAllowed
        ' Only allow editing in column 1
        If e.colIndex = 1 Then
            e.allowed = True
        Else
            e.allowed = False
        End If
    End Sub

    Private Sub AxSftTree1_EditInitializing(ByVal sender As Object, ByVal e As AxSftTreeLib75._DSftTreeEvents_EditInitializingEvent) Handles AxSftTree1.EditInitializing
        ' LeftPix/TopPix/WidthPix/HeightPix describes the current cell AreaType
        ' we need to return the position and size needed for editing.
        ' In this example, we use the height of the control on the form
        ' and center it over the cell.

        e.topPix = e.topPix + (e.heightPix - EditControl.Height) / 2
        e.heightPix = EditControl.Height

        ' Set the text in the control used for cell editing and
        ' set other control-specific properties
        EditControl.Width = 200
        EditControl.Text = AxSftTree1.get_Cell(e.editIndex, e.editCol).Text
        EditControl.SelectionStart = 0
        EditControl.SelectionLength = 999

        ' Return the control's window handle
        e.window = EditControl.Handle.ToInt32()
        e.vData = EditControl

        ' Define navigation keys
        ' VK_TAB
        AxSftTree1.CellEditIntercept(9, SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeChar Or SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeControlChar Or SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeShiftChar)
        ' VK_RETURN
        AxSftTree1.CellEditIntercept(13, SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeChar Or SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeControlChar Or SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeShiftChar)
        ' VK_HOME
        AxSftTree1.CellEditIntercept(36, SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeControlChar)
        ' VK_END
        AxSftTree1.CellEditIntercept(35, SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeControlChar)
        ' VK_UP
        AxSftTree1.CellEditIntercept(38, SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeChar Or SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeControlChar Or SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeShiftChar)
        ' VK_DOWN
        AxSftTree1.CellEditIntercept(40, SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeChar Or SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeControlChar Or SftTreeCellEditInterceptStyleConstants.cellEditInterceptSftTreeShiftChar)
    End Sub

    Private Sub AxSftTree1_EditNavigating(ByVal sender As Object, ByVal e As AxSftTreeLib75._DSftTreeEvents_EditNavigatingEvent) Handles AxSftTree1.EditNavigating
        ' Process key pressed
        AxSftTree1.EditNavigate(e.key, e.shift)
    End Sub

    Private Sub AxSftTree1_EditValidate(ByVal sender As Object, ByVal e As AxSftTreeLib75._DSftTreeEvents_EditValidateEvent) Handles AxSftTree1.EditValidate
        ' Validate the new cell contents
        Dim S As String = EditControl.Text
        S = S.Trim()
        If S.Length <= 0 Then
            MessageBox.Show("Please enter a description.")
            e.inputValid = False
        End If
    End Sub

    Private Sub AxSftTree1_EditEnding(ByVal sender As Object, ByVal e As AxSftTreeLib75._DSftTreeEvents_EditEndingEvent) Handles AxSftTree1.EditEnding
        ' Save the new cell contents
        If e.saveInput Then
            AxSftTree1.get_Cell(e.editIndex, e.editCol).Text = EditControl.Text
        End If
        Dim ctrl As Control = e.vData
        ctrl.Visible = False
        ctrl.Enabled = False
    End Sub

End Class