Microsoft KB Archive/298133

= How To List Fixed Pitch Fonts with GetTextMetrics =

Article ID: 298133

Article Last Modified on 7/1/2004

-

APPLIES TO


 * Microsoft Visual Basic 5.0 Enterprise Edition
 * Microsoft Visual Basic 6.0 Enterprise Edition
 * Microsoft Visual Basic 5.0 Professional Edition
 * Microsoft Visual Basic 6.0 Professional Edition
 * Microsoft Visual Basic 5.0 Learning Edition
 * Microsoft Visual Basic 6.0 Learning Edition
 * Microsoft Visual Basic 4.0 32-Bit Enterprise Edition
 * Microsoft Visual Basic 4.0 Professional Edition
 * Microsoft Visual Basic 4.0 Standard Edition

-



This article was previously published under Q298133



SUMMARY
You can use the GetTextMetrics function within an iteration through the Printer object's Font collection to determine if a font is non-proportional by analyzing the TEXTMETRIC structure that is returned for each font in the collection.



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

Private Declare Function GetTextMetrics Lib &quot;gdi32&quot; _ Alias &quot;GetTextMetricsA&quot; _ (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 &quot;No fixed pitched fonts found!&quot; End Sub  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.

