Loading Fonts into Comboboxes via API

Here's an alternative method to your everyday:

For I = 1 To Printer.FontCount - 1
       Combo.AddItem Printer.Fonts(I)
Next

This method uses the EnumFontFamilies API function. Its simply faster than inserting one by one each font on a users system. This itself may decrease loading times on your application by 2/3z.

So here's the code you will need. First, insert this to a module:

'//= START MODULE =\\
Private Const LF_FACESIZE = 32
Private Type LOGFONT
   lfHeight As Long
   lfWidth As Long
   lfEscapement As Long
   lfOrientation As Long
   lfWeight As Long
   lfItalic As Byte
   lfUnderline As Byte
   lfStrikeOut As Byte
   lfCharSet As Byte
   lfOutPrecision As Byte
   lfClipPrecision As Byte
   lfQuality As Byte
   lfPitchAndFamily As Byte
   lfFaceName(LF_FACESIZE) As Byte
End Type
Private Type NEWTEXTMETRIC
   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
   ntmFlags As Long
   ntmSizeEM As Long
   ntmCellHeight As Long
   ntmAveWidth As Long
End Type
Private Declare Function EnumFontFamilies Lib "gdi32" Alias "EnumFontFamiliesA" (ByVal hdc As Long, ByVal lpszFamily As String, ByVal lpEnumFontFamProc As Long, lParam As Any) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Public Sub AddFonts(Combo As ComboBox)
   Dim hdc As Long
   Combo.Clear
   hdc = GetDC(Combo.hwnd)
   EnumFontFamilies hdc, vbNullString, AddressOf EnumFontFamProc, Combo
   ReleaseDC Combo.hwnd, hdc
End Sub
Private Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, ByVal FontType As Long, lParam As ComboBox) As Long
   Dim FaceName As String
   FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
   lParam.AddItem Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
   EnumFontFamProc = 1
End Function

'//= END MODULE =\\

Now lets insert a combo box into our form and call the AddFonts sub to add it. The way you call it is:

AddFonts Combo1

where Combo1 is the name of the combobox you are tryign to load the Fonts into. Great! Thats about it:) Have fun and enjoy the speedier way of programming in VB with the Win32 API!

You might also like...

Comments

Thushan Fernando Senior Developer working at Readify on cool new technology and platforms.

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“Computer Science is no more about computers than astronomy is about telescopes.” - E. W. Dijkstra