SftBox/OCX 5.0 - Combo Box Control

FontDlg Sample (VB.NET)

This sample illustrates a font dialog for font selection.

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

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

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    ' add all font information
    UpdateFontNames()
End Sub

Private Sub UpdateFontNames()
    ' add all font names
    fontNames.BulkUpdate = True
    fontNames.Items.Clear()
    fontNames.Items.AddFontNames(-1, SftBoxFontConstants.fontSftBoxAll, True, 0)
    fontNames.Items.Selection = 0
    PerformSort(fontNames, SftBoxSortConstants.sortSftBoxAscending)
    fontNames.BulkUpdate = False
    fontNames.Columns.MakeOptimal(0)
    fontNames.Items.RecalcHorizontalExtent(0)
End Sub

Private Sub UpdateFontStyles()
    ' add all styles for the current font name
    If fontNames.Items.Selection >= 0 Then
        Dim OldText As String = fontStyles.Edit.Text
        fontStyles.Items.AddFontStyles(fontNames.get_Cell(fontNames.Items.Selection, 0).Text, 0, "", "")
        Dim index As Integer = fontStyles.Items.Find(OldText, 0, 0, False, True, True)
        If index < 0 Then index = 0
        fontStyles.Items.Selection = index
    Else
        fontStyles.Items.Clear()
    End If
    PerformSort(fontStyles, SftBoxSortConstants.sortSftBoxAscending)
    fontStyles.Columns.MakeOptimal(0)
    fontStyles.Items.RecalcHorizontalExtent(0)
End Sub

Private Sub UpdateFontSizes()
    ' add all sizes for the current font name
    If fontNames.Items.Selection >= 0 Then
        Dim OldText As String = fontSizes.Edit.Text
        fontSizes.Items.AddFontSizes(fontNames.get_Cell(fontNames.Items.Selection, 0).Text, 0)
        Dim index As Integer = fontSizes.Items.Find(OldText, 0, 0, False, True, True)
        If index < 0 Then index = 0
        fontSizes.Items.Selection = index
    Else
        fontSizes.Items.Clear()
    End If
    PerformSort(fontSizes, SftBoxSortConstants.sortSftBoxAscending)
    fontSizes.Columns.MakeOptimal(0)
    fontSizes.Items.RecalcHorizontalExtent(0)
    UpdateSample()
End Sub

Private Sub fontNames_SelectionChange(ByVal sender As Object, ByVal e As System.EventArgs) Handles fontNames.SelectionChange
    UpdateFontStyles()
End Sub

Private Sub fontStyles_SelectionChange(ByVal sender As Object, ByVal e As System.EventArgs) Handles fontStyles.SelectionChange
    UpdateFontSizes()
End Sub

Private Sub fontSizes_SelectionChange(ByVal sender As Object, ByVal e As System.EventArgs) Handles fontSizes.SelectionChange
    UpdateSample()
End Sub

Private Sub UpdateSample()
    Dim SelItem As Integer = fontStyles.Items.Selection
    If SelItem >= 0 And fontSizes.Edit.Text <> "" Then
        sampleText.Text = "AaBbCcYyZz"
        Dim style As FontStyle = 0
        If (fontStyles.get_Cell(SelItem, 0).Data And &H80000000&) <> 0 Then style = style Or FontStyle.Italic
        Dim weight As Integer = fontStyles.get_Cell(SelItem, 0).Data And &H7FFFFFFF&
        If weight > 400 Then style = style Or FontStyle.Bold
        sampleText.Font = New Font(fontNames.Edit.Text, Convert.ToSingle(fontSizes.Edit.Text), style)
    Else
        sampleText.Text = ""
    End If
End Sub

Private Sub condHeaders_CheckedChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles condHeaders.CheckedChanged
    ' if this event occurs during form initialization, the activeX control
    ' may not yet be initialized completely, so we have to check for GetOcx()
    If Not fontNames.GetOcx() Is Nothing Then
        If condHeaders.Checked Then
            fontNames.Headers.Main = True
            fontNames.Headers.DropDown = False
            fontStyles.Headers.Main = True
            fontStyles.Headers.DropDown = False
            fontSizes.Headers.Main = True
            fontSizes.Headers.DropDown = False
        Else
            fontNames.Headers.Main = False
            fontNames.Headers.DropDown = True
            fontStyles.Headers.Main = False
            fontStyles.Headers.DropDown = True
            fontSizes.Headers.Main = False
            fontSizes.Headers.DropDown = True
        End If
    End If
End Sub

Private Sub PerformSort(ByVal box As AxSftBox, ByVal currDirection As SftBoxSortConstants)
    If currDirection = SftBoxSortConstants.sortSftBoxAscending Then
        box.get_Header(0).Image.Appearance = SftPictureImageConstants.sftImageSortAsc
    Else
        box.get_Header(0).Image.Appearance = SftPictureImageConstants.sftImageSortDesc
    End If
    ' Font styles and font names are sorted by Cell.Text property
    ' Font sizes are sorted according to numeric Cell.Data property
    ' Outside of this function, only sortSftBoxAscending and sortSftBoxDescending
    ' are used, so we need to translate these
    If box Is fontSizes Then
        If currDirection = SftBoxSortConstants.sortSftBoxAscending Then
            currDirection = SftBoxSortConstants.sortSftBoxCellValueAscending
        Else
            currDirection = SftBoxSortConstants.sortSftBoxCellValueDescending
        End If
    End If
    box.Items.Sort(-1, 0, currDirection)
End Sub

Private Sub ReverseSortOrder(ByVal box As AxSftBox, ByRef currDirection As SftBoxSortConstants)
    If currDirection = SftBoxSortConstants.sortSftBoxAscending Then
        currDirection = SftBoxSortConstants.sortSftBoxDescending
    Else
        currDirection = SftBoxSortConstants.sortSftBoxAscending
    End If
End Sub

Private Sub fontNames_ItemClick(ByVal sender As Object, ByVal e As AxSftBoxLib50._ISftBoxEvents_ItemClickEvent) Handles fontNames.ItemClick
    If e.areaType = SftBoxAreaConstants.areaSftBoxColumn Then
        ReverseSortOrder(fontNames, fontNamesDirection)
        PerformSort(fontNames, fontNamesDirection)
    End If
End Sub

Private Sub fontNames_ItemDblClk(ByVal sender As Object, ByVal e As AxSftBoxLib50._ISftBoxEvents_ItemDblClkEvent) Handles fontNames.ItemDblClk
    If e.areaType = SftBoxAreaConstants.areaSftBoxColumn Then
        ReverseSortOrder(fontNames, fontNamesDirection)
        PerformSort(fontNames, fontNamesDirection)
    End If
End Sub

Private Sub fontStyles_ItemClick(ByVal sender As Object, ByVal e As AxSftBoxLib50._ISftBoxEvents_ItemClickEvent) Handles fontStyles.ItemClick
    If e.areaType = SftBoxAreaConstants.areaSftBoxColumn Then
        ReverseSortOrder(fontStyles, fontStylesDirection)
        PerformSort(fontStyles, fontStylesDirection)
    End If
End Sub

Private Sub fontStyles_ItemDblClk(ByVal sender As Object, ByVal e As AxSftBoxLib50._ISftBoxEvents_ItemDblClkEvent) Handles fontStyles.ItemDblClk
    If e.areaType = SftBoxAreaConstants.areaSftBoxColumn Then
        ReverseSortOrder(fontStyles, fontStylesDirection)
        PerformSort(fontStyles, fontStylesDirection)
    End If
End Sub

Private Sub fontSizes_ItemClick(ByVal sender As Object, ByVal e As AxSftBoxLib50._ISftBoxEvents_ItemClickEvent) Handles fontSizes.ItemClick
    If e.areaType = SftBoxAreaConstants.areaSftBoxColumn Then
        ReverseSortOrder(fontSizes, fontSizesDirection)
        PerformSort(fontSizes, fontSizesDirection)
    End If
End Sub

Private Sub fontSizes_ItemDblClk(ByVal sender As Object, ByVal e As AxSftBoxLib50._ISftBoxEvents_ItemDblClkEvent) Handles fontSizes.ItemDblClk
    If e.areaType = SftBoxAreaConstants.areaSftBoxColumn Then
        ReverseSortOrder(fontSizes, fontSizesDirection)
        PerformSort(fontSizes, fontSizesDirection)
    End If
End Sub