SftTree/OCX 7.5 - ActiveX Tree Control

Pictures Sample (VB6)

This sample illustrates using bitmaps, images, imagelists, checkboxes, radiobuttons, color samples, progress bars and more.

The source code is located at C:\Program Files (x86)\Softelvdm\SftTree OCX 7.5\Samples\VB6\Pictures\Form1.frm or C:\Program Files\Softelvdm\SftTree OCX 7.5\Samples\VB6\Pictures\Form1.frm (on 32-bit Windows versions).

Option Explicit

Dim SortDirection As Boolean

Private Sub AppExit_Click()
    End
End Sub

Private Sub Form_Resize()
    SftTree1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

Private Sub CopyImageFromCurrentItem()
    Dim ItemIndex As Integer
    Dim Img As SftPictureObject

    ItemIndex = SftTree1.Items.Current
    If ItemIndex < 0 Then Exit Sub

    ' don't use images that are too large in the other areas
    Set Img = SftTree1.Cell(ItemIndex, 0).Image
    If Img.ActualHeight <= 20 And Img.ActualWidth <= 20 Then
        SftTree1.RowColumnHeader.Image = Img
        SftTree1.Header(1).Image = Img
    Else
        SftTree1.RowColumnHeader.Image.Clear
        SftTree1.Header(1).Image.Clear
    End If

End Sub

Private Sub ToggleImage(Img As SftPictureObject)
    Select Case Img.Appearance
    Case sftImageCheckboxNo
        Img.Appearance = sftImageCheckboxYes
    Case sftImageCheckboxYes
        Img.Appearance = sftImageCheckboxNo
    Case sftImageCheckboxUnknown
        Img.Appearance = sftImageCheckboxNo
    Case sftImageCheckboxNoDisabled
        Img.Appearance = sftImageCheckboxYesDisabled
    Case sftImageCheckboxYesDisabled
        Img.Appearance = sftImageCheckboxNoDisabled
    Case sftImageCheckboxUnknownDisabled
        Img.Appearance = sftImageCheckboxNoDisabled
    Case sftImageRadioButtonNo
        Img.Appearance = sftImageRadioButtonYes
    Case sftImageRadioButtonYes
        Img.Appearance = sftImageRadioButtonNo
    Case sftImageRadioButtonNoDisabled
        Img.Appearance = sftImageRadioButtonYesDisabled
    Case sftImageRadioButtonYesDisabled
        Img.Appearance = sftImageRadioButtonNoDisabled
    Case sftImageUp
        Img.Appearance = sftImageDown
    Case sftImageUpDisabled
        Img.Appearance = sftImageDownDisabled
    Case sftImageDown
        Img.Appearance = sftImageUp
    Case sftImageDownDisabled
        Img.Appearance = sftImageUpDisabled
    Case sftImageSortAsc
        Img.Appearance = sftImageSortDesc
    Case sftImageSortAscDisabled
        Img.Appearance = sftImageSortDescDisabled
    Case sftImageSortDesc
        Img.Appearance = sftImageSortAsc
    Case sftImageSortDescDisabled
        Img.Appearance = sftImageSortAscDisabled
    Case Else
        ' nothing
    End Select
End Sub

Private Sub PropagateImage(ByVal ItemIndex As Integer, Img As SftPictureObject)
    ' don't use images that are too large in the other areas
    If Img.ActualHeight <= 20 And Img.ActualWidth < 20 Then
        SftTree1.Item(ItemIndex).Image = Img
        SftTree1.Item(ItemIndex).LabelImage = Img
        SftTree1.Item(ItemIndex).RowHeader.Image = Img
    End If
End Sub

Private Sub UpdatePictures(ByVal ItemIndex As Integer, ByVal Pic As StdPicture, ByVal Align As SftTreeHAlignConstants)
    Dim C As SftTreeCell
    Set C = SftTree1.Cell(ItemIndex, 0)
    Set C.Image.Picture = Pic
    C.ImageHAlign = Align
    PropagateImage ItemIndex, C.Image
End Sub

Private Sub UpdateImages(ByVal ItemIndex As Integer, ByVal Pic As LONG_PTR, ByVal Align As SftTreeHAlignConstants)
    Dim C As SftTreeCell
    Set C = SftTree1.Cell(ItemIndex, 0)
    C.Image.SetImage Pic, True
    C.ImageHAlign = Align
    PropagateImage ItemIndex, C.Image
End Sub

Private Sub UpdateImageList(ByVal ItemIndex As Integer, ByVal ImageListControl As ImageList, ByVal I As Integer, ByVal Align As SftTreeHAlignConstants)
    Dim C As SftTreeCell
    Set C = SftTree1.Cell(ItemIndex, 0)
    C.Image.SetImageList ImageListControl, I
    C.ImageHAlign = Align
    PropagateImage ItemIndex, C.Image
End Sub

Private Sub UpdateColor(ByVal ItemIndex As Integer, ByVal Clr As OLE_COLOR, ByVal Align As SftTreeHAlignConstants)
    Dim C As SftTreeCell
    Set C = SftTree1.Cell(ItemIndex, 0)
    C.Image.SetColorSample Clr, vbBlack
    C.Image.Width = 12
    C.Image.Height = 12
    C.ImageHAlign = Align
    PropagateImage ItemIndex, C.Image
End Sub

Private Sub AddColor(ByVal Text As String, ByVal Clr As OLE_COLOR)
    Dim I As Integer
    I = SftTree1.Items.Add(Text)
    SftTree1.Item(I).Level = 2
    UpdateColor I, Clr, halignSftTreeRight
End Sub

Private Sub UpdateBuiltinImage(ByVal ItemIndex As Integer, ByVal Style As SftPictureImageConstants, ByVal wPix As Integer, ByVal hPix As Integer, ByVal Align As SftTreeHAlignConstants)
    Dim C As SftTreeCell
    Set C = SftTree1.Cell(ItemIndex, 0)
    C.Image.Appearance = Style
    C.Image.Width = wPix
    C.Image.Height = hPix
    C.ImageHAlign = Align
    PropagateImage ItemIndex, C.Image
End Sub

Private Sub AddBuiltinImage(ByVal Text As String, ByVal Style As SftPictureImageConstants, ByVal wPix As Integer, ByVal hPix As Integer)
    Dim I As Integer
    I = SftTree1.Items.Add(Text)
    SftTree1.Item(I).Level = 2
    UpdateBuiltinImage I, Style, wPix, hPix, halignSftTreeRight
End Sub

Private Sub ShowSortDirection(ByVal Ascending As Boolean)
    If Ascending Then
        SftTree1.Header(0).Image.Appearance = sftImageSortAsc
    Else
        SftTree1.Header(0).Image.Appearance = sftImageSortDesc
    End If
    SortDirection = Ascending
End Sub

Private Sub SetSortDirection(ByVal NewDirection As Boolean)
    ShowSortDirection NewDirection
    If NewDirection Then
        SftTree1.Items.SortDependents -1, 0, sortSftTreeAscending
    Else
        SftTree1.Items.SortDependents -1, 0, sortSftTreeDescending
    End If
End Sub


Private Sub Form_Load()
    Dim ItemIndex As Integer, I As Integer
    Dim C As Integer, Count As Integer

    SortDirection = False

    With SftTree1
        ItemIndex = .Items.Add("Progress Bars")
        .Cell(ItemIndex, 1).Text = "SftTree/OCX supports progress bars as cell background (partial or full size)."

        ' add progress bar samples

        I = .Items.Add("Progress Bar - Full Size")
        .Item(I).Level = 1
        .Cell(I, 0).ProgressMax = 100    ' maximum value 0-100
        .Cell(I, 0).ProgressValue = 33   ' current value

        I = .Items.Add("Progress Bar - Partial")
        .Item(I).Level = 1
        .Cell(I, 0).ProgressColorOrientation = horizontalDefaultOrientationSftTree
        .Cell(I, 0).ProgressStyle = smallDefaultProgressStyleSftTree
        .Cell(I, 0).ProgressMax = 200    ' maximum value 0-200
        .Cell(I, 0).ProgressValue = 33   ' current value

        I = .Items.Add("Progress Bar - with gradient fill")
        .Item(I).Level = 1
        .Cell(I, 0).ProgressColorOrientation = horizontalDefaultOrientationSftTree
        .Cell(I, 0).ProgressStyle = smallDefaultProgressStyleSftTree
        .Cell(I, 0).ProgressColor = &H8080&
        .Cell(I, 0).ProgressColorEnd = &HFFFF&
        .Cell(I, 0).ProgressMax = 50     ' maximum value 0-50
        .Cell(I, 0).ProgressValue = 40   ' current value

        I = .Items.Add("Progress Bar - customizable colors")
        .Item(I).Level = 1
        Dim cellObj As SftTreeCell
        Set cellObj = .Cell(I, 0)
        cellObj.ProgressColorOrientation = verticalDefaultOrientationSftTree
        cellObj.ProgressStyle = smallDefaultProgressStyleSftTree
        cellObj.ProgressColor = &H8080&
        cellObj.ProgressColorEnd = &HFFFF&
        cellObj.ProgressMax = 150    ' maximum value 0-150
        cellObj.ProgressValue = 40   ' current value
        cellObj.BackColor = &H80000005
        cellObj.BackColorEnd = &HFF&
        cellObj.BackColorOrientation = horizontalDefaultOrientationSftTree

        ' Picture Types

        ItemIndex = .Items.Add("Supported Picture Types")
        .Cell(ItemIndex, 1).Text = "SftTree/OCX supports numerous image types, such as GDI+ images, bitmaps, icons, ImageLists and also offers numerous built-in images."

        ' add GDI+ samples

        ItemIndex = .Items.Add("GDI+ Images")
        .Item(ItemIndex).Level = 1
        .Cell(ItemIndex, 1).Text = "All GDI+ images are supported, like GIF, JPEG, Exif, PNG, TIFF and device-independent bitmaps (up to 64bpp) with semi-transparent and translucent areas."

        I = .Items.Add("PNG Sample with alpha-channel for translucent edges")
        .Item(I).Level = 2
        Dim PicturePNG1 As LONG_PTR
        PicturePNG1 = SftTree1.LoadGDIPlusImage(App.Path + "\pic_warn_32.png", False)
        UpdateImages I, PicturePNG1, halignSftTreeRight

        I = .Items.Add("Another PNG Sample with alpha-channel for translucent edges")
        .Item(I).Level = 2
        Dim PicturePNG2 As LONG_PTR
        PicturePNG2 = SftTree1.LoadGDIPlusImage(App.Path + "\pic_world_48.png", False)
        UpdateImages I, PicturePNG2, halignSftTreeRight

        ' add bitmap samples

        ItemIndex = .Items.Add("Bitmaps")
        .Item(ItemIndex).Level = 1
        .Cell(ItemIndex, 1).Text = "Bitmaps can be of varying sizes and also support Bitmap Transparency, which allows the background to show through the image (in areas selected by the bitmap designer)."

        I = .Items.Add("Large Bitmap")
        .Item(I).Level = 2
        UpdatePictures I, PictureLogo, halignSftTreeRight

        I = .Items.Add("Various bitmap sizes")
        .Item(I).Level = 2
        UpdatePictures I, PictureSmallBitmap, halignSftTreeRight

        ' add icon samples

        ItemIndex = .Items.Add("Icons")
        .Item(ItemIndex).Level = 1
        .Cell(ItemIndex, 1).Text = "The supported icons can be standard size icons (32x32) or any other size supported by the operating system."

        I = .Items.Add("Standard Icon (32x32)")
        .Item(I).Level = 2
        UpdatePictures I, PictureIcon, halignSftTreeRight

        I = .Items.Add("Any other size")
        .Item(I).Level = 2
        UpdatePictures I, PictureIconSmall, halignSftTreeRight

        ' add imagelist samples

        ItemIndex = .Items.Add("ImageLists")
        .Item(ItemIndex).Level = 1
        .Cell(ItemIndex, 1).Text = "Complete ImageList support simplifies bitmap handling and can avoid the limited resource availability on earlier Windows versions."

        Count = ImageList1.ListImages.Count
        For C = 1 To Count
            I = .Items.Add("Image " & C)
            .Item(I).Level = 2
            UpdateImageList I, ImageList1, C, halignSftTreeRight
        Next

        ' add color samples

        ItemIndex = .Items.Add("Color Samples")
        .Item(ItemIndex).Level = 1
        .Cell(ItemIndex, 1).Text = "Using the built-in color sample image, simple color selection can easily be implemented.  Color samples can display all colors available."

        AddColor "Black", vbBlack
        AddColor "Blue", vbBlue
        AddColor "Cyan", vbCyan
        AddColor "Green", vbGreen
        AddColor "Magenta", vbMagenta
        AddColor "Red", vbRed
        AddColor "White", vbWhite
        AddColor "Yellow", vbYellow

        AddColor "3DDKSHADOW - Dark shadow for 3D elements", vb3DDKShadow
        AddColor "3DFACE - Face color for 3D elements", vb3DFace
        AddColor "3DHILIGHT - Edges facing the light source", vb3DHighlight
        AddColor "3DLIGHT - Edges facing the light source", vb3DLight
        AddColor "3DSHADOW - Edges facing away from the light source", vb3DShadow
        AddColor "INFOBK - Background color for tooltip controls", vbInfoBackground
        AddColor "INFOTEXT - Text color for tooltip controls", vbInfoText
        AddColor "MENUTEXT - Text in menus", vbMenuText
        AddColor "ACTIVEBORDER - Active window border", vbActiveBorder
        AddColor "ACTIVECAPTION - Active window caption", vbActiveTitleBar
        AddColor "APPWORKSPACE - Background color MDI applications", vbApplicationWorkspace
        AddColor "BACKGROUND - Desktop", vbDesktop
        AddColor "BTNFACE - Face shading on push buttons", vbButtonFace
        AddColor "BTNHILIGHT - Highlight color for buttons", vb3DHighlight
        AddColor "BTNSHADOW - Edge shading on push buttons", vbButtonShadow
        AddColor "BTNTEXT - Text on push buttons", vbButtonText
        AddColor "CAPTIONTEXT - Text in caption", vbTitleBarText
        AddColor "GRAYTEXT - Grayed (disabled) text", vbGrayText
        AddColor "HIGHLIGHT - Selected Item(s)", vbHighlight
        AddColor "HIGHLIGHTTEXT - Text of selected item(s)", vbHighlightText
        AddColor "INACTIVEBORDER - Inactive window border", vbInactiveBorder
        AddColor "INACTIVECAPTION - Inactive window caption", vbInactiveTitleBar
        AddColor "INACTIVECAPTIONTEXT - Inactive caption text color", vbInactiveCaptionText
        AddColor "MENU - Menu background", vbMenuBar
        AddColor "SCROLLBAR - Scroll bar gray area", vbScrollBars
        AddColor "WINDOW - Window background", vbWindowBackground
        AddColor "WINDOWFRAME - Window frame", vbWindowFrame
        AddColor "WINDOWTEXT - Text in windows", vbWindowText

        ' add predefined image samples

        ItemIndex = .Items.Add("Predefined (Built-in) Pictures")
        .Cell(ItemIndex, 1).Text = "Predefined images are available for commonly used items, such as check boxes, radio buttons, sort direction indicators and more..."

        ItemIndex = .Items.Add("Check Boxes - Honors Windows Themes")
        .Item(ItemIndex).Level = 1

        AddBuiltinImage "Enabled, Selected Check Box", sftImageCheckboxYes, 14, 14
        AddBuiltinImage "Disabled, Selected Check Box", sftImageCheckboxYesDisabled, 14, 14
        AddBuiltinImage "Enabled Check Box", sftImageCheckboxNo, 14, 14
        AddBuiltinImage "Disabled Check Box", sftImageCheckboxNoDisabled, 14, 14
        AddBuiltinImage "Enabled, Unknown Check Box", sftImageCheckboxUnknown, 14, 14
        AddBuiltinImage "Disabled, Unknown Check Box", sftImageCheckboxUnknownDisabled, 14, 14

        ItemIndex = .Items.Add("Radio Buttons - Honors Windows Themes")
        .Item(ItemIndex).Level = 1

        AddBuiltinImage "Enabled, Selected Radio Button", sftImageRadioButtonYes, 14, 14
        AddBuiltinImage "Disabled, Selected Radio Button", sftImageRadioButtonYesDisabled, 14, 14
        AddBuiltinImage "Enabled Radio Button", sftImageRadioButtonNo, 14, 14
        AddBuiltinImage "Disabled Radio Button", sftImageRadioButtonNoDisabled, 14, 14

        ItemIndex = .Items.Add("Up/Down Buttons - Honors Windows Themes")
        .Item(ItemIndex).Level = 1

        AddBuiltinImage "Enabled Up Button", sftImageUp, 14, 14
        AddBuiltinImage "Disabled Up Button", sftImageUpDisabled, 14, 14
        AddBuiltinImage "Enabled Down Button", sftImageDown, 14, 14
        AddBuiltinImage "Disabled Down Button", sftImageDownDisabled, 14, 14

        ItemIndex = .Items.Add("Sort Direction Indicator")
        .Item(ItemIndex).Level = 1

        AddBuiltinImage "Enabled Ascending Indicator", sftImageSortAsc, 8, 8
        AddBuiltinImage "Disabled Ascending Indicator", sftImageSortAscDisabled, 8, 8
        AddBuiltinImage "Enabled Descending Indicator", sftImageSortDesc, 8, 8
        AddBuiltinImage "Disabled Descending Indicator", sftImageSortDescDisabled, 8, 8


        .RowHeaders.MakeOptimal ' make the row headers optimal
        .Column(0).MakeOptimal  ' make the first column optimal
        .Items.RecalcHorizontalExtent ' update horizontal scroll bar

        .Item(0).Selected = True
        .Items.Current = 0

        CopyImageFromCurrentItem

    End With
End Sub

Private Sub SftTree1_ItemClick(ByVal ItemIndex As Long, ByVal ColIndex As Integer, ByVal AreaType As Integer, ByVal Button As Integer, ByVal Shift As Integer)
    Dim Area As SftTreeAreaTypeConstants
    Area = AreaType
    If Area = constSftTreeExpandAll Then
        SftTree1.Item(ItemIndex).Expand True, True
    ElseIf Area = constSftTreeColumn And ColIndex = 0 Then
        SetSortDirection Not SortDirection
    ElseIf Area = constSftTreeCellGraphic Then
        ToggleImage SftTree1.Cell(ItemIndex, ColIndex).Image
    ElseIf Area = constSftTreeItem Then
        ToggleImage SftTree1.Item(ItemIndex).Image
    ElseIf Area = constSftTreeLabel Then
        ToggleImage SftTree1.Item(ItemIndex).LabelImage
    End If
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)
    Dim Area As SftTreeAreaTypeConstants
    Area = AreaType
    If Area = constSftTreeColumnRes Then
        SftTree1.Column(ColIndex).MakeOptimal ' Make column width optimal
        SftTree1.Items.RecalcHorizontalExtent ' Update horizontal scroll bar
    ElseIf Area = constSftTreeColumn And ColIndex = 0 Then
        SetSortDirection Not SortDirection
    ElseIf Area = constSftTreeCellGraphic Then
        ToggleImage SftTree1.Cell(ItemIndex, ColIndex).Image
    End If
End Sub

Private Sub SftTree1_SelectionChange()
    CopyImageFromCurrentItem
End Sub

Private Sub Timer1_Timer()
    ' update all cells that have a progress bar by incrementing the progress value
    Dim Total As Integer, Cols As Integer, ItemIndex As Integer
    Total = SftTree1.Items.Count
    For ItemIndex = 0 To Total - 1
        Dim cellObj As SftTreeCell
        Set cellObj = SftTree1.Cell(ItemIndex, 0)
        If cellObj.ProgressMax > 0 Then
            cellObj.ProgressValue = (cellObj.ProgressValue + 4) Mod cellObj.ProgressMax
        End If
    Next
End Sub