SftBox/OCX 5.0 - Combo Box Control

Pictures Sample (VB6)

This sample illustrates images, checkboxes, radiobuttons, more.

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

Option Explicit

Dim SortDirection As Boolean

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

    ItemIndex = SftBox1.Items.Selection
    If ItemIndex < 0 Then Exit Sub

    ' don't use images that are too large in the other areas
    Set Img = SftBox1.Cell(ItemIndex, 0).Image
    If Img.ActualHeight <= 20 And Img.ActualWidth <= 20 Then
        SftBox1.RowColumnHeader.Image = Img
        SftBox1.Header(1).Image = Img
    Else
        SftBox1.RowColumnHeader.Image.Clear
        SftBox1.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
        SftBox1.Item(ItemIndex).Image = Img
        SftBox1.Item(ItemIndex).LabelImage = Img
        SftBox1.Item(ItemIndex).RowHeader.Image = Img
    End If
End Sub

Private Sub UpdatePictures(ByVal ItemIndex As Integer, ByVal Pic As StdPicture, ByVal Align As SftBoxHAlignConstants)
    Dim C As SftBoxCell
    Set C = SftBox1.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 SftBoxHAlignConstants)
    Dim C As SftBoxCell
    Set C = SftBox1.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 SftBoxHAlignConstants)
    Dim C As SftBoxCell
    Set C = SftBox1.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 SftBoxHAlignConstants)
    Dim C As SftBoxCell
    Set C = SftBox1.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 = SftBox1.Items.Add(Text)
    SftBox1.Item(I).Level = 2
    UpdateColor I, Clr, halignSftBoxRight
End Sub

Private Sub UpdateBuiltinImage(ByVal ItemIndex As Integer, ByVal Style As SftPictureImageConstants, ByVal wPix As Integer, ByVal hPix As Integer, ByVal Align As SftBoxHAlignConstants)
    Dim C As SftBoxCell
    Set C = SftBox1.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 = SftBox1.Items.Add(Text)
    SftBox1.Item(I).Level = 2
    UpdateBuiltinImage I, Style, wPix, hPix, halignSftBoxRight
End Sub

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

Private Sub SetSortDirection(ByVal NewDirection As Boolean)
    ShowSortDirection NewDirection
    If NewDirection Then
        SftBox1.Items.Sort -1, 0, sortSftBoxAscending
    Else
        SftBox1.Items.Sort -1, 0, sortSftBoxDescending
    End If
End Sub


Private Sub Command1_Click()
    End
End Sub

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

    SortDirection = False

    With SftBox1
        ItemIndex = .Items.Add("Supported Picture Types")
        .Cell(ItemIndex, 1).Text = "SftBox/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 = SftBox1.LoadGDIPlusImage(App.Path + "\pic_warn_32.png", False)
        UpdateImages I, PicturePNG1, halignSftBoxRight

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

        ' 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, halignSftBoxRight

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

        ' add icon samples

        ItemIndex = .Items.Add("Icons")
        .Item(ItemIndex).Level = 1
        .Cell(ItemIndex, 1).Text = "The supported icons can be stardard 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, halignSftBoxRight

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

        ' 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, halignSftBoxRight
        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 0 ' make the row headers optimal
        .Column(0).MakeOptimal 0 ' make the first column optimal
        .Items.RecalcHorizontalExtent 0 ' update horizontal scroll bar

        .Items.Selection = 0

        CopyImageFromCurrentItem

    End With

    SftBox1.DropDown.Dropped = True
End Sub

Private Sub ExpandCollapseItem(ByVal ItemIndex As Long, ByVal Shift As Integer)
    Dim Item As SftBoxItem
    Set Item = SftBox1.Item(ItemIndex)
    If Item.Expanded Then
        Item.Collapse True
    Else
        Item.Expand True, (Shift And constSftBoxCtrlMask)
    End If
End Sub

Private Sub SftBox1_ItemClick(ByVal Part As SftBoxLib50.SftBoxPortionConstants, ByVal AreaType As SftBoxLib50.SftBoxAreaConstants, ByVal ItemIndex As Long, ByVal ColNum As Integer, ByVal Button As Integer, ByVal Shift As Integer)
    Select Case AreaType
    Case areaSftBoxColumn
        If ColNum = 0 Then
            SetSortDirection Not SortDirection
        End If
    Case areaSftBoxCellGraphic
        If Part = partSftBoxDropDown Then SftBox1.DropDown.Suppress ' Make sure we don't close the drop down
        ToggleImage SftBox1.Cell(ItemIndex, ColNum).Image
    Case areaSftBoxItem
        If Part = partSftBoxDropDown Then SftBox1.DropDown.Suppress ' Make sure we don't close the drop down
        ToggleImage SftBox1.Item(ItemIndex).Image
    Case areaSftBoxLabel
        If Part = partSftBoxDropDown Then SftBox1.DropDown.Suppress ' Make sure we don't close the drop down
        ToggleImage SftBox1.Item(ItemIndex).LabelImage
    Case areaSftBoxButton
        If Part = partSftBoxDropDown Then SftBox1.DropDown.Suppress ' Make sure we don't close the drop down
        ExpandCollapseItem ItemIndex, Shift
    End Select
End Sub

Private Sub SftBox1_ItemDblClk(ByVal Part As SftBoxLib50.SftBoxPortionConstants, ByVal AreaType As SftBoxLib50.SftBoxAreaConstants, ByVal ItemIndex As Long, ByVal ColNum As Integer, ByVal Button As Integer, ByVal Shift As Integer)
    Select Case AreaType
    Case areaSftBoxColumnRes
        SftBox1.Column(ColNum).MakeOptimal 0 ' Make column width optimal
        SftBox1.Items.RecalcHorizontalExtent 0 ' Update horizontal scroll bar
    Case areaSftBoxColumn
        If ColNum = 0 Then
            SetSortDirection Not SortDirection
        End If
    Case areaSftBoxCellGraphic
        If Part = partSftBoxDropDown Then SftBox1.DropDown.Suppress ' Make sure we don't close the drop down
        ToggleImage SftBox1.Cell(ItemIndex, ColNum).Image
    Case areaSftBoxLabel
        If Part = partSftBoxDropDown Then SftBox1.DropDown.Suppress ' Make sure we don't close the drop down
        ToggleImage SftBox1.Item(ItemIndex).LabelImage
    Case areaSftBoxItem
        If Part = partSftBoxDropDown Then SftBox1.DropDown.Suppress ' Make sure we don't close the drop down
        If SftBox1.Item(ItemIndex).Expandable Then
            ExpandCollapseItem ItemIndex, Shift
        Else
            ToggleImage SftBox1.Item(ItemIndex).Image
        End If
    Case areaSftBoxButton, areaSftBoxCell
        If Part = partSftBoxDropDown Then SftBox1.DropDown.Suppress ' Make sure we don't close the drop down
        ExpandCollapseItem ItemIndex, Shift
    End Select
End Sub

Private Sub SftBox1_SelectionChange()
    CopyImageFromCurrentItem
End Sub