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!
Senior Developer working at Readify on cool new technology and platforms.
Comments