Font List 
Author Message
 Font List

On Thu, 21 Nov 2002 00:03:51 -0200, "Bruno Piovan"


>is possible to make or an API can do that, a control like the font list from
>WordPad??????? there is an icon before the name (see the pic)

Looks like an ImageCombo (included in the commoncontrols in VB6) or an
ownerdraw combo. You can find an OD combo (including source) at
http://www.*-*-*.com/ ;I believe it event has a built-in font list

MVP - Visual Basic
(please post replies to the newsgroup)

Mon, 09 May 2005 12:16:04 GMT  
 Font List

> is possible to make or an API can do that, a control like the font list
> WordPad??????? there is an icon before the name (see the pic)

Tom's given you a good link for the user drawn list box's example, however
there's another here if you get bogged down:
For the font list side of things you can either go the VB way:

Dim GetFont As Long

For GetFont = 0 To Screen.FontCount - 1
    List1.AddItem Screen.Fonts(GetFont)
Next GetFont

Call MsgBox(Screen.FontCount & " Font's found", vbInformation, "Font list

Or the API way:

'*** In a module:
Private Declare Function EnumFonts Lib "gdi32" Alias "EnumFontsA" _
    (ByVal hdc As Long, ByVal lpsz As String, _
    ByVal lpFontEnumProc As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias _
    "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetDesktopWindow Lib "user32" () 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

Private Const LF_FACESIZE = 32

Type LogicalFont
    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 FillList As ListBox

Public Function EnumFontList(ByRef outListBox As ListBox) As Long
    Dim DeskWnd As Long, DeskDC As Long

    DeskWnd = GetDesktopWindow()
    DeskDC = GetDC(DeskWnd)

    Set FillList = outListBox
    EnumFontList = EnumFonts(DeskDC, vbNullString, _
        AddressOf EnumFontProc, 0&)
    Set FillList = Nothing

    Call ReleaseDC(DeskWnd, DeskDC)
End Function

Private Function EnumFontProc(ByVal lplf As Long, ByVal lptm As Long, _
    ByVal dwType As Long, ByVal lpData As Long) As Long
    Dim LF As LogicalFont
    Dim FontName As String
    Dim NullPos As Long

    Call CopyMemory(LF, ByVal lplf, LenB(LF))
    Call FillList.AddItem(TrimNull(StrConv(LF.lfFaceName, vbUnicode)))
    EnumFontProc = 1
End Function

Private Function TrimNull(ByRef inString As String) As String
    Dim NullPos As Long

    NullPos = InStr(inString, vbNullChar)
    If (NullPos) Then TrimNull = Left$(inString, NullPos - 1) Else TrimNull
= inString
End Function


'*** In a form:
Call MsgBox(EnumFontList(List2) & " Font's found", vbInformation, "Font list

While the API method looks horrendous, it does bypass the dependence of VB's
"Screen" object so it makes porting to other languages a lot easier if
that's a concern.
Hope this helps,


 -- EDais --

 - Microsoft Visual Basic MVP -
WWW: Http://

Mon, 09 May 2005 19:06:59 GMT  
 [ 2 post ] 

 Relevant Pages 

1. Fonts list in ACCESS 2.0

2. Reading Font list

3. Modifying Font List

4. Available fonts list in ComboBox

5. Getting font list from read-only document

6. macro to print font list

7. create a font list

8. Font Listing in word 2000

9. Getting Font List

10. Font list

11. Font List: How Do I Obtain One?

12. ??? Returning Font list in a Combo Box Like Works


Powered by phpBB® Forum Software