SftPrintPreview/OCX 1.0 - ActiveX Print Preview Control

PreviewSftTree Sample (VB6)

This sample illustrates using a SftTree/OCX control.

The source code is located at C:\Program Files (x86)\Softelvdm\SftPrintPreview OCX 1.0\Samples\VB6\PreviewSftTree\Form1.frm or C:\Program Files\Softelvdm\SftPrintPreview OCX 1.0\Samples\VB6\PreviewSftTree\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
    SftPrintPreview1.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 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, Counter As Integer

    SortDirection = False

    With SftTree1
        .BulkUpdate = True

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

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

        Next

        .BulkUpdate = False

        .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

    ' Connect the tree control to the print preview control
    SftPrintPreview1.ContentProvider = SftTree1.hWnd
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 ViewTree_Click()
    ' Show the tree control
    SftTree1.Visible = True
    SftTree1.Enabled = True
    SftTree1.SetFocus
    ' Disable & hide the print preview control
    SftPrintPreview1.Visible = False
    SftPrintPreview1.Enabled = False
End Sub

Private Sub Preview_Click()
    ' Disable & hide the tree control
    SftTree1.Visible = False
    SftTree1.Enabled = False
    ' Show the print preview control
    SftPrintPreview1.Enabled = True
    SftPrintPreview1.Visible = True
    SftPrintPreview1.SetFocus
    ' In case the tree control changed, we have to reformat everything
    SftPrintPreview1.Restart restartSftPrintPreviewComplete
End Sub

Private Sub SftPrintPreview1_PageSetupWanted()
    SftPrintPreview1.PageSetup 0
End Sub

Private Sub SftPrintPreview1_HelpWanted(ByVal HelpName As String)
    MsgBox ("Sorry, this sample doesn't offer a help file")
End Sub

Private Sub SftPrintPreview1_CloseWanted()
    ViewTree_Click
End Sub