generating list of fonts for selection 1

[mohrbike]

I want to have a form that will bring up a list of available fonts. My form will display the characters in that font. I could select all the files in the windows\fonts directory with a .ttf extension, but I still need the Font Name for my selection to work. I use Win2k and Access 2k. I have the form working by typing the fontnames in a table but I would like to automate it further.

thanks, Steve

 

[Norris68]

I have finally found some code on the web. There is little, as Visual Basic exposes the font list in the Screen.Fonts() collection. However, there is an excellent article comparing the two methods ... with VB source, to be found at

http://www.mvps.org/vbnet/index.html?code/enums/enumfonts.htm

 

[Norris68]

Ah! Trying to test it, it will need some modification to get it to work in Access, as the ListBox is completely different to the VB ListBox. If I can sort it in the next 10 mins I'll post again with the mods.

 

[Norris68]

Right. A couple of things. A value list ListBox has a limit of 2048 characters, and you will need to add the following API declaration to a public module so that you can pass the hDC to the EnumFontFamilies function:

Public Declare Function GetDC Lib "User32" (ByVal hWnd As Long) As Long

Then, modify the form code to read:

Dim hDC As Long
  hDC = GetDC(Application.hWndAccessApp)
  EnumFontFamilies hDC, vbNullString, AddressOf EnumFontFamProc, List1
     
  'indicate the fonts found
   Label1.Caption = List1.ListCount & " fonts"

And finally modify the module code to:

Public Function EnumFontFamProc(lpNLF As LOGFONT, _
                                lpNTM As NEWTEXTMETRIC, _
                                ByVal FontType As Long, _
                                LParam As ListBox) As Long

   Dim FaceName As String
   
  'convert the returned string from Unicode to ANSI
   FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
   FaceName = Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
  'add the font to the list
   If Len(LParam.RowSource) + Len(FaceName) <= 2048 Then
        If LParam.RowSource <> &quot;&quot; Then
             LParam.RowSource = LParam.RowSource & &quot;;&quot; & FaceName
        Else
             LParam.RowSource = LParam.RowSource & FaceName
        End If
   End If
   
  'return success to the call
   EnumFontFamProc = 1

End Function
'--end block--'

 

[mohrbike]

Excellent help! I really want to do it within Access but this gives me a good start. I haven't participated in these forums much, but I'm a believer now. Thanks!

 

[Norris68]

My last post gave you all the changes you would need to make to get it to run in Access.

What may make it better would be to use the returned fonts to populate a temporary table - you are not restricted to 2048 characters if the listbox type is table/query. You would be able to easily sort your fonts alphabetically too.

P.S. See that link called "Mark this post as a helpful/expert post!"? That's what gives people the purple stars you see by some posts