Option Explicit Private Sub Command1_Click() End End Sub Private Sub Form_Load() Dim Bk As Integer, Ch As Integer, Sect As Integer, ItemIndex As Integer Dim BookIndex As Integer Dim size As Integer Dim CellFont As New StdFont Randomize With SftTree1 ' Mass-Update .BulkUpdate = True ' set default item graphic. This can also be done at design time Set .Items.ItemImageExpandable.Picture = BookClosed.Picture Set .Items.ItemImageExpanded.Picture = BookOpen.Picture Set .Items.ItemImageLeaf.Picture = Topic.Picture ' set the column header images (to indicate sorting) SftTree1.Header(0).Image.Appearance = sftImageSortAsc SftTree1.Header(1).Image.Clear SftTree1.Header(2).Image.Clear ' set the cell font for books Set CellFont = Font CellFont.Bold = True ' Add all available options For Bk = 1 To 4 ' add a book BookIndex = .Items.Add("Book " & Bk) .Cell(BookIndex, 1).Text = "Description for book " & Bk size = Int((1000 * Rnd) + 1) .Cell(BookIndex, 2).Text = size .Item(BookIndex).Data = size ' add chapters For Ch = 1 To 2 ItemIndex = .Items.Add("Chapter " & Ch) .Item(ItemIndex).Level = 1 ' add sections For Sect = 1 To 2 ItemIndex = .Items.Add("Section " & Sect) .Item(ItemIndex).Level = 2 Next Sect Next Ch ' after adding the book and all dependent items, we ' collapse the item, so it's up to the user to expand it .Item(BookIndex).Collapse False ' set font Set .Cell(BookIndex, 0).Font = CellFont Next Bk ' End of Mass-Update .BulkUpdate = False ' Make columns optimal .ColumnsObj.MakeOptimal ' allow horizontal scrolling .Items.RecalcHorizontalExtent End With End Sub Private Sub ShowPlusMin_Click() If ShowPlusMin.Value = 0 Then SftTree1.Items.PlusMinusImageExpandable.Clear SftTree1.Items.PlusMinusImageExpanded.Clear Else Set SftTree1.Items.PlusMinusImageExpandable.Picture = Plus.Picture Set SftTree1.Items.PlusMinusImageExpanded.Picture = Minus.Picture End If End Sub Private Sub Ugly_Click() If Ugly.Value = 0 Then SftTree1.ButtonPicture = Nothing Else Set SftTree1.ButtonPicture = UglyButtons.Picture End If End Sub Private Sub SortHeader(ByVal ColIndex As Integer) With SftTree1 If .Header(ColIndex).Image.Appearance = sftImageSortAsc Then ' Sort the data. Note that column 2 is sorted by Item.Data, which is ' an integer value (book size in pages) If ColIndex = 2 Then .Items.SortDependents -1, ColIndex, sortSftTreeDscItemData Else .Items.SortDependents -1, ColIndex, sortSftTreeDescending End If .Header(ColIndex).Image.Appearance = sftImageSortDesc Else .Header(0).Image.Clear .Header(1).Image.Clear .Header(2).Image.Clear ' Sort the data. Note that column 2 is sorted by Item.Data, which is ' an integer value (book size in pages) If ColIndex = 2 Then .Items.SortDependents -1, ColIndex, sortSftTreeAscItemData Else .Items.SortDependents -1, ColIndex, sortSftTreeAscending End If .Header(ColIndex).Image.Appearance = sftImageSortAsc End If End With End Sub Private Sub HeaderMenu() Dim Count As Integer Count = 0 If SftTree1.Column(0).WidthPix > 0 Then MenuForm.ShowContents.Checked = True Count = Count + 1 Else MenuForm.ShowContents.Checked = False End If If SftTree1.Column(1).WidthPix > 0 Then MenuForm.ShowDescription.Checked = True Count = Count + 1 Else MenuForm.ShowDescription.Checked = False End If If SftTree1.Column(2).WidthPix > 0 Then MenuForm.ShowSize.Checked = True Count = Count + 1 Else MenuForm.ShowSize.Checked = False End If If Count <= 1 Then If MenuForm.ShowContents.Checked Then MenuForm.ShowContents.Enabled = False If MenuForm.ShowDescription.Checked Then MenuForm.ShowDescription.Enabled = False If MenuForm.ShowSize.Checked Then MenuForm.ShowSize.Enabled = False Else MenuForm.ShowContents.Enabled = True MenuForm.ShowDescription.Enabled = True MenuForm.ShowSize.Enabled = True End If MenuForm.ShowAll.Enabled = Count < 3 SftTree1.CancelMode PopupMenu MenuForm.HeaderPopup End Sub Private Sub SftTree1_ContextMenu(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) ' Determine click context menu for header or item Dim l As Single, t As Single, h As Single, w As Single SftTree1.Headers.GetPosition l, t, w, h If X >= l And X < l + w And Y >= t And Y <= t + h Then HeaderMenu Exit Sub End If ' determine item right-clicked Dim ItemIndex As Long ItemIndex = SftTree1.Items.HitTest(X, Y) If ItemIndex >= 0 And ItemIndex < SftTree1.Items.Count Then SftTree1.Items.Current = ItemIndex SftTree1.Item(ItemIndex).Selected = True SftTree1.CancelMode PopupMenu MenuForm.ItemPopup End If End Sub Private Sub SftTree1_ItemClick(ByValItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer) With SftTree1 If AreaType = constSftTreeColumnHeader And Button = constSftTreeLeftButton Then SortHeader ColIndex ElseIf AreaType = constSftTreeExpandAll Then .Item(ItemIndex).Expand False, True End If End With End Sub Private Sub SftTree1_ItemDblClick(ByVal ItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer) With SftTree1 If AreaType = constSftTreeColumnRes And Button = constSftTreeLeftButton Then .Column(ColIndex).MakeOptimal .Items.RecalcHorizontalExtent ElseIf AreaType = constSftTreeColumnHeader And Button = constSftTreeLeftButton Then SortHeader ColIndex End If End With End Sub