cDialogFont class

A cDialogFont shows the Windows Font dialog, in which the user picks a face, a style, a size and, optionally, a color and the effects underline and strikeout. It holds the choice as properties, and describes it as text: a short description and a line of CSS.

Properties: Bold, Color, FaceName, FixedPitchOnly, ForceFontExist, Italic, MaxSize, MinSize, OwnerHwnd, ScreenFontsOnly, ShowEffects, Size, StrikeOut, Style, Underline. Methods: Reset, ShowDialog, ToCssFont, ToDescription. Enumerations: FontFamily, FontPitch, FontStyle, FontWeight.

Create an object with Dim dlg As New cDialogFont. The class is declared [COMCreatable(False)], so CreateObject cannot make one, and New can.

Dim dlg As New cDialogFont

dlg.FaceName = "Consolas"
dlg.Size = 11
If dlg.ShowDialog() Then
    Debug.Print dlg.ToDescription()
    Debug.Print dlg.ToCssFont()
Else
    Debug.Print "Cancelled"
End If

How the dialog is shown

ShowDialog calls ChooseFontW with a LOGFONT made from the properties and the flag CF_INITTOLOGFONTSTRUCT, which is always set. The size is passed in points, as the structure holds it in tenths of a point, and as a height in pixels at 96 dots per inch (-Size * 96 / 72). Four properties set a flag when they are True: ScreenFontsOnly (CF_SCREENFONTS), ShowEffects (CF_EFFECTS), ForceFontExist (CF_FORCEFONTEXIST) and FixedPitchOnly (CF_FIXEDPITCHONLY, together with a fixed pitch in the LOGFONT). CF_LIMITSIZE is set when MinSize or MaxSize is above 0. The class sets no hook, template, printer device context or help button. The dialog is modal and has the title Font.

When the user chooses OK, ShowDialog stores the face, the size, the bold and italic parts of the style, the underline and strikeout effects and the color in the properties, and returns True. When the user chooses Cancel, or closes the dialog, it returns False and leaves every property as it was. No error is raised in either case.

The face list holds every font that Windows lists for the screen, including the vertical variants, whose names begin with @: the class sets no flag that hides them. The list of styles, the script box and the colors depend on the face and on Windows, and the class reads neither the style name nor the script that the user chose, only the weight and the italic bit.

Warning

ShowDialog also returns False, without showing a dialog, when the call to Windows fails. A MinSize above 0 with MaxSize left at 0, or a MinSize above MaxSize, makes it fail. The class does not read the error code, so the program cannot tell such a failure from a Cancel. Set both MinSize and MaxSize, or neither.

Properties

Bold

Whether the font is bold.

Syntax: object.Bold [ = value ]

A Boolean, False by default. It is bit 1 of Style: setting it sets or clears that bit and leaves bit 2 (italic) alone. After a ShowDialog that returned True it is True when the weight of the chosen font is 700 or more, so a style such as Semibold (600) gives False.

Dim dlg As New cDialogFont

dlg.Bold = True
dlg.Italic = True
dlg.Bold = False
Debug.Print dlg.Style
Debug.Print dlg.Italic
' Output:
' 2
' True

Color

The color of the text.

Syntax: object.Color [ = value ]

A Long in the layout of the RGB function (&H00BBGGRR), black by default. It is the color the dialog shows when ShowEffects is True, and after OK it holds one of the 16 colors of the dialog’s color box, such as &H8000 for Green. Any Long is accepted and stored as it is.

Dim dlg As New cDialogFont

dlg.Color = RGB(0, 0, 128)
dlg.ShowEffects = True
Debug.Print Hex$(dlg.Color)

FaceName

The name of the font face.

Syntax: object.FaceName [ = value ]

A String, Segoe UI by default. The dialog opens with that face selected. A name that is not an installed face leaves the face box empty, and then the property ForceFontExist decides what OK does.

Dim dlg As New cDialogFont

dlg.FaceName = "Courier New"
Debug.Print dlg.FaceName

FixedPitchOnly

Whether the dialog lists only fixed-pitch fonts.

Syntax: object.FixedPitchOnly [ = value ]

A Boolean, False by default. When it is True, the dialog lists only fonts whose characters have one width, such as Consolas and Courier New. Set FaceName to one of them, or the face box opens without a selection.

Dim dlg As New cDialogFont

dlg.FixedPitchOnly = True
dlg.FaceName = "Consolas"
Debug.Print dlg.ShowDialog()

ForceFontExist

Whether the dialog accepts only the name of an installed face.

Syntax: object.ForceFontExist [ = value ]

A Boolean, True by default. When it is True and the face box holds a name that is not in the list, OK shows a message, There is no font with that name. Choose a font from the list of fonts., and the dialog stays open; Cancel then returns False and keeps FaceName. When it is False, OK closes the dialog.

Note

With ForceFontExist False and a FaceName that is not installed, OK returns True and sets FaceName to an empty string.

Dim dlg As New cDialogFont

dlg.ForceFontExist = False
dlg.FaceName = "A Face Of My Own"
If dlg.ShowDialog() Then
    Debug.Print "[" & dlg.FaceName & "]"
End If

Italic

Whether the font is italic.

Syntax: object.Italic [ = value ]

A Boolean, False by default. It is bit 2 of Style, set and cleared as Bold sets and clears bit 1.

Dim dlg As New cDialogFont

dlg.Italic = True
Debug.Print dlg.Style
Debug.Print dlg.Bold
' Output:
' 2
' False

MaxSize

The largest size, in points, that the dialog accepts.

Syntax: object.MaxSize [ = value ]

A Long, 0 by default, which means no limit. Above 0, ShowDialog sets CF_LIMITSIZE and passes the value as the largest size. The size list then ends at the largest standard size not above it, and a size that the user types above it is refused with a message and the dialog stays open. The message, for the limits 10 and 14, is Size must be between 10 and 14 points.

A MaxSize alone is valid. A MinSize above it makes the call fail: see the warning on ShowDialog.

Dim dlg As New cDialogFont

dlg.MinSize = 10
dlg.MaxSize = 14
dlg.Size = 12
Debug.Print dlg.ShowDialog()

MinSize

The smallest size, in points, that the dialog accepts.

Syntax: object.MinSize [ = value ]

A Long, 0 by default, which means no limit. Above 0, ShowDialog sets CF_LIMITSIZE and passes the value as the smallest size. The size list then starts at the smallest standard size not below it.

Warning

A MinSize above 0 needs a MaxSize of at least the same value. With MaxSize left at 0, ShowDialog returns False at once, without a dialog, as if the user had cancelled.

Dim dlg As New cDialogFont

dlg.MinSize = 8
dlg.MaxSize = 72
Debug.Print dlg.MinSize

OwnerHwnd

The window that owns the dialog.

Syntax: object.OwnerHwnd [ = value ]

A LongPtr window handle, 0 by default, which gives the dialog no owner. ShowDialog passes it as the owner window of the call.

Private Sub PickFont(ByVal ownerWindow As LongPtr)
    Dim dlg As New cDialogFont

    dlg.OwnerHwnd = ownerWindow         ' the handle of a window of the program
    Debug.Print dlg.OwnerHwnd
    Debug.Print dlg.ShowDialog()
End Sub

ScreenFontsOnly

Whether the dialog lists the fonts of the screen.

Syntax: object.ScreenFontsOnly [ = value ]

A Boolean, True by default. When it is True, ShowDialog sets CF_SCREENFONTS. The class never sets the flag for printer fonts, and the documentation of ChooseFont asks for one of the two, so leave the property True. On Windows 10 a False still shows the same dialog with the same fonts.

Dim dlg As New cDialogFont

dlg.ScreenFontsOnly = True
Debug.Print dlg.ScreenFontsOnly

ShowEffects

Whether the dialog offers the effects strikeout and underline, and the color.

Syntax: object.ShowEffects [ = value ]

A Boolean, True by default. When it is True, ShowDialog sets CF_EFFECTS and the dialog shows the Strikeout and Underline check boxes and the Color box. When it is False they are hidden, and Underline, StrikeOut and Color keep the values they had.

Dim dlg As New cDialogFont

dlg.ShowEffects = False
dlg.Underline = True
If dlg.ShowDialog() Then Debug.Print dlg.Underline      ' still True

Size

The size of the font, in points.

Syntax: object.Size [ = value ]

A Double, 9 by default. A value of 0 or less is ignored, without an error, and the size is not changed. After OK it holds the size the dialog returns, which is a number of tenths of a point divided by 10.

Dim dlg As New cDialogFont

dlg.Size = 12
dlg.Size = 0            ' ignored
dlg.Size = -3           ' ignored
Debug.Print dlg.Size
' Output:
' 12

StrikeOut

Whether the text is struck out.

Syntax: object.StrikeOut [ = value ]

A Boolean, False by default. It is the strikeout effect of the dialog. ToDescription names it, and ToCssFont leaves it out.

Dim dlg As New cDialogFont

dlg.StrikeOut = True
Debug.Print dlg.ToDescription()

Style

The bold and italic parts of the style, as one number.

Syntax: object.Style [ = value ]

A FontStyle. Bit 1 is Bold and bit 2 is Italic. The property holds the number that was assigned, whatever it is: 4 is accepted and gives Bold and Italic both False.

Dim dlg As New cDialogFont

dlg.Style = FontStyle.StyleBoldItalic
Debug.Print dlg.Bold
Debug.Print dlg.Italic
dlg.Style = 4
Debug.Print dlg.Bold
' Output:
' True
' True
' False

Underline

Whether the text is underlined.

Syntax: object.Underline [ = value ]

A Boolean, False by default. It is the underline effect of the dialog. ToCssFont writes it as text-decoration.

Dim dlg As New cDialogFont

dlg.Underline = True
Debug.Print dlg.ToCssFont()

Methods

Reset

Restores every property to its starting value.

Syntax: object.Reset

FaceName becomes Segoe UI, Size 9, Style regular, Color black, Underline, StrikeOut and FixedPitchOnly False, ForceFontExist, ShowEffects and ScreenFontsOnly True, and OwnerHwnd, MinSize and MaxSize 0.

Dim dlg As New cDialogFont

dlg.FaceName = "Courier New"
dlg.Size = 14
dlg.Bold = True
dlg.Reset
Debug.Print dlg.ToDescription()
' Output:
' Segoe UI 9pt

ShowDialog

Shows the Font dialog.

Syntax: object.ShowDialog ( ) As Boolean

Returns True when the user chose OK, and then the properties hold the choice. Returns False when the user cancelled, and the properties are unchanged. Any error inside the method is trapped and also gives False. See How the dialog is shown, and the warning there: False is also the answer to a call that Windows refused.

Dim dlg As New cDialogFont

dlg.FaceName = "Courier New"
dlg.Size = 10
If dlg.ShowDialog() Then
    Debug.Print dlg.ToDescription()
End If

ToCssFont

Returns the font as a line of CSS.

Syntax: object.ToCssFont ( ) As String

The result has the form

font-family: 'Segoe UI'; font-size: 9pt; font-weight: normal; font-style: normal; text-decoration: none;

with the face name between single quotes, the size in points, bold or normal, italic or normal, and underline or none. It does not write StrikeOut or Color. A single quote in the face name is written as it is, without an escape, and ends the quoted name early. A fractional size is written with the decimal separator of the regional settings of the computer, so the CSS is wrong where that is a comma.

Dim dlg As New cDialogFont

dlg.FaceName = "Courier New"
dlg.Size = 14
dlg.Bold = True
dlg.Italic = True
dlg.Underline = True
Debug.Print dlg.ToCssFont()
' Output:
' font-family: 'Courier New'; font-size: 14pt; font-weight: bold; font-style: italic; text-decoration: underline;

ToDescription

Returns the font as a short line of text.

Syntax: object.ToDescription ( ) As String

The face name, a space, the size and pt, then Bold, Italic, Underline and Strikeout for each that is set, in that order. The color is not part of it. A fractional size is written with the decimal separator of the regional settings of the computer.

Dim dlg As New cDialogFont

Debug.Print dlg.ToDescription()
dlg.FaceName = "Courier New"
dlg.Size = 14
dlg.Style = FontStyle.StyleBoldItalic
dlg.Underline = True
dlg.StrikeOut = True
Debug.Print dlg.ToDescription()
' Output:
' Segoe UI 9pt
' Courier New 14pt Bold Italic Underline Strikeout

Enumerations

The enumerations are declared inside the class. A program names their members with the name of the enumeration in front, as in the samples, or by the member alone, such as StyleBold. The name of the class cannot be put in front: cDialogFont.FontStyle.StyleBold is refused with TB5079, Unrecognized symbol ‘cDialogFont’. Only FontStyle is used by a member, the property Style. The other three hold Windows constants for the font structure and are not taken or returned by any member.

FontFamily

The font families of Windows.

Member	Value
FF_DONTCARE	0
FF_ROMAN	16
FF_SWISS	32
FF_MODERN	48
FF_SCRIPT	64
FF_DECORATIVE	80

FontPitch

The pitch of a font.

Member	Value
DEFAULT_PITCH	0
FIXED_PITCH	1
VARIABLE_PITCH	2

FontStyle

The bold and italic parts of a style, the type of Style.

Member	Value	Meaning
StyleRegular	0	Neither bold nor italic.
StyleBold	1	Bold.
StyleItalic	2	Italic.
StyleBoldItalic	3	Bold and italic.

FontWeight

The weights of a font, as Windows numbers them.

Member	Value
FW_DONTCARE	0
FW_THIN	100
FW_EXTRALIGHT	200
FW_LIGHT	300
FW_NORMAL	400
FW_MEDIUM	500
FW_SEMIBOLD	600
FW_BOLD	700
FW_EXTRABOLD	800
FW_HEAVY	900

Debug.Print FontWeight.FW_BOLD
Debug.Print FontFamily.FF_SWISS
Debug.Print FontPitch.FIXED_PITCH
Debug.Print FontStyle.StyleBoldItalic
' Output:
' 700
' 32
' 1
' 3