ChooseFont Function

Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (lpcf As CHOOSEFONT_TYPE) As Long

Platforms

Windows 95: Supported.
Windows 98: Supported.
Windows NT: Requires Windows NT 3.1 or later.
Windows 2000: Supported.
Windows CE: Not Supported.

Description & Usage

ChooseFont opens the Choose Font common dialog box. All of the necessary information needed to create the dialog box, as well as all of the information returned from it, is stored in the structure passed as pChooseFont. The logical font information is mostly stored in a LOGFONT structure, which can be used to access that font.

Return Value

If an error occured or the user pressed Cancel, the function returns 0 (use CommDlgExtendedError to get the error code). If the user successfully selected a font, the function returns a non-zero value.

Visual Basic-Specific Issues

None.

Parameters

lpcf: Passes information to and from the Choose Font dialog box. Initialize this before calling the function, and read the necessary information from it afterwards.

Example

' This code is licensed according to the terms and conditions listed here.

' Display a Choose Font dialog box.  Print out the typeface name, point size,
' and style of the selected font.  More detail about topics in this example can be found in
' the pages for CHOOSEFONT_TYPE and LOGFONT.
Dim cf As CHOOSEFONT_TYPE  ' data structure needed for function
Dim lfont As LOGFONT  ' receives information about the chosen font
Dim hMem As Long, pMem As Long  ' handle and pointer to memory buffer
Dim fontname As String  ' receives name of font selected
Dim retval As Long  ' return value

' Initialize the default selected font: Times New Roman, regular, black, 12 point.
' (Note that some of that information is in the CHOOSEFONT_TYPE structure instead.)
lfont.lfHeight = 0  ' determine default height
lfont.lfWidth = 0  ' determine default width
lfont.lfEscapement = 0  ' angle between baseline and escapement vector
lfont.lfOrientation = 0  ' angle between baseline and orientation vector
lfont.lfWeight = FW_NORMAL  ' normal weight i.e. not bold
lfont.lfItalic = 0  ' not italic
lfont.lfUnderline = 0  ' not underline
lfont.lfStrikeOut = 0  ' not strikeout
lfont.lfCharSet = DEFAULT_CHARSET  ' use default character set
lfont.lfOutPrecision = OUT_DEFAULT_PRECIS  ' default precision mapping
lfont.lfClipPrecision = CLIP_DEFAULT_PRECIS  ' default clipping precision
lfont.lfQuality = DEFAULT_QUALITY  ' default quality setting
lfont.lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN  ' default pitch, proportional with serifs
lfont.lfFaceName = "Times New Roman" & vbNullChar  ' string must be null-terminated

' Create the memory block which will act as the LOGFONT structure buffer.
hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(lfont))
pMem = GlobalLock(hMem)  ' lock and get pointer
CopyMemory ByVal pMem, lfont, Len(lfont)  ' copy structure's contents into block

' Initialize dialog box: Screen and printer fonts, point size between 10 and 72.
cf.lStructSize = Len(cf)  ' size of structure
cf.hwndOwner = Form1.hWnd  ' window Form1 is opening this dialog box
cf.hdc = Printer.hDC  ' device context of default printer (using VB's mechanism)
cf.lfLogFont = pMem  ' pointer to LOGFONT memory block buffer
cf.iPointSize = 120  ' 12 point font (in units of 1/10 point)
cf.flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
cf.rgbColors = RGB(0, 0, 0)  ' black
cf.lCustData = 0  ' we don't use this here...
cf.lpfnHook = 0  ' ...or this...
cf.lpTemplateName = ""  ' ...or this...
cf.hInstance = 0  ' ...or this...
cf.lpszStyle = ""  ' ...or this
cf.nFontType = REGULAR_FONTTYPE  ' regular font type i.e. not bold or anything
cf.nSizeMin = 10  ' minimum point size
cf.nSizeMax = 72  ' maximum point size

' Now, call the function.  If successful, copy the LOGFONT structure back into the structure
' and then print out the attributes we mentioned earlier that the user selected.
retval = ChooseFont(cf)  ' open the dialog box
If retval <> 0 Then  ' success
  CopyMemory lfont, ByVal pMem, Len(lfont)  ' copy memory back
  ' Now make the fixed-length string holding the font name into a "normal" string.
  fontname = Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) - 1)
  ' Display font name and a few attributes.
  Debug.Print "FONT NAME: "; fontname
  Debug.Print "FONT SIZE (points):"; cf.iPointSize / 10  ' in units of 1/10 point!
  Debug.Print "FONT STYLE(S): ";
  If lfont.lfWeight >= FW_BOLD Then Debug.Print "Bold ";
  If lfont.lfItalic <> 0 Then Debug.Print "Italic ";
  If lfont.lfUnderline <> 0 Then Debug.Print "Underline ";
  If lfont.lfStrikeOut <> 0 Then Debug.Print "Strikeout";
  Debug.Print  ' end the line
End If

' Deallocate the memory block we created earlier.  Note that this must
' be done whether the function succeeded or not.
retval = GlobalUnlock(hMem)  ' destroy pointer, unlock block
retval = GlobalFree(hMem)  ' free the allocated memory