How To List Fixed Pitch Fonts with GetTextMetrics (298133)

MORE INFORMATION

Step-by-Step Example

1. Create a new Standard EXE project in Visual Basic. Form1 is created by default.
2. Add a CommandButton control (Command1) and a ListBox control (List1) to Form1.
3. Add the following code to the General Declarations section of Form1:

   Option Explicit
   
   Private Declare Function GetTextMetrics Lib "gdi32" _
      Alias "GetTextMetricsA" _
      (ByVal hdc As Long, _
      lpMetrics As TEXTMETRIC) _
      As Long
   
   Private Type TEXTMETRIC
      tmHeight As Long
      tmAscent As Long
      tmDescent As Long
      tmInternalLeading As Long
      tmExternalLeading As Long
      tmAveCharWidth As Long
      tmMaxCharWidth As Long
      tmWeight As Long
      tmOverhang As Long
      tmDigitizedAspectX As Long
      tmDigitizedAspectY As Long
      tmFirstChar As Byte
      tmLastChar As Byte
      tmDefaultChar As Byte
      tmBreakChar As Byte
      tmItalic As Byte
      tmUnderlined As Byte
      tmStruckOut As Byte
      tmPitchAndFamily As Byte
      tmCharSet As Byte
   End Type
   
   Const FIXED_PITCH_BIT As Byte = 1
   
   Private Sub Command1_Click()
    Dim index As Long
    Dim tm As TEXTMETRIC
    Dim ret As Long
    Dim FontFound As Boolean
    
    FontFound = False   ' Just in case none are found!
    List1.Clear
    For index = 0 To Printer.FontCount - 1      ' Determine number of fonts.
       Printer.FontName = Printer.Fonts(index)  ' Select the font.
       ret = GetTextMetrics(Printer.hdc, tm)    ' Retrieve information.
       ' Test the fixed pitch bit.
       ' Fonts with this bit off are fixed pitch.
       If (tm.tmPitchAndFamily And FIXED_PITCH_BIT) = 0 Then
           List1.AddItem Printer.Fonts(index)
           FontFound = True   ' Found at least one!
       End If
    Next index
    If Not FontFound Then List1.AddItem "No fixed pitched fonts found!"
   End Sub
   					

4. Run the project, and click Command1. The ListBox is populated with the names of all fixed-pitched fonts that are available to the current printer.