Determine if font face name is valid and installed on user system

[Arthur Gomide]

Hi Mike and Michael,

I found 414 fonts, and without sorting the list is a mess ... so I added sorting.

[color=#007F00]'Enumnerate System fonts

' Author: Michael Mattias Racine WI 11/20/05
[/color][color=#0000C0]#COMPILE EXE
#DIM ALL
#REGISTER NONE
#OPTION WIN95
#INCLUDE [/color][color=#C020C0]"WIN32API.INC"
[/color][color=#0000C0]#RESOURCE MANIFEST[/color][color=#8000FF], [/color][color=#000000]1[/color][color=#8000FF], [/color][color=#C020C0]"XPTheme.xml"    [/color][color=#007F00]' from PBSamples

[/color][color=#0000C0]GLOBAL [/color][color=#000000]gsFonts [/color][color=#0000C0]AS STRING


[/color][color=#007F00]'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'
[/color][color=#0000C0]FUNCTION [/color][color=#000000]enumfonts_callback [/color][color=#8000FF]([/color][color=#000000]LF [/color][color=#0000C0]AS [/color][color=#000000]Logfont[/color][color=#8000FF], [/color][color=#000000]TM [/color][color=#0000C0]AS [/color][color=#000000]TextMetric[/color][color=#8000FF], [/color][color=#0000C0]BYVAL [/color][color=#000000]FontType [/color][color=#0000C0]AS DWORD[/color][color=#8000FF], [/color][color=#000000]szFaceName [/color][color=#0000C0]AS ASCIIZ[/color][color=#8000FF]) [/color][color=#0000C0]AS LONG

  [/color][color=#000000]gsFonts [/color][color=#8000FF]= [/color][color=#000000]gsFonts [/color][color=#8000FF]+ [/color][color=#000000]LF.lfFaceName [/color][color=#8000FF]+ [/color][color=#C020C0]", "
  [/color][color=#0000C0]FUNCTION [/color][color=#8000FF]= [/color][color=#000000]%TRUE

[/color][color=#0000C0]END FUNCTION

[/color][color=#007F00]'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'
[/color][color=#0000C0]FUNCTION PBMAIN [/color][color=#8000FF]() [/color][color=#0000C0]AS LONG

  LOCAL [/color][color=#000000]szFace [/color][color=#0000C0]AS ASCIIZ [/color][color=#8000FF]* [/color][color=#0000C0]%MAX_PATH
  LOCAL [/color][color=#000000]szDriver [/color][color=#0000C0]AS ASCIIZ [/color][color=#8000FF]* [/color][color=#000000]64
  [/color][color=#0000C0]LOCAL [/color][color=#000000]iValid[/color][color=#8000FF], [/color][color=#000000]hdc[/color][color=#8000FF], [/color][color=#000000]dwUser[/color][color=#8000FF], [/color][color=#000000]iRet [/color][color=#0000C0]AS LONG
  LOCAL [/color][color=#000000]CbAddr [/color][color=#0000C0]AS DWORD

    [/color][color=#000000]gsFonts  [/color][color=#8000FF]= [/color][color=#C020C0]""
    [/color][color=#000000]szDriver [/color][color=#8000FF]= [/color][color=#C020C0]"DISPLAY"
    [/color][color=#000000]hDC      [/color][color=#8000FF]= [/color][color=#000000]CreateDc [/color][color=#8000FF]([/color][color=#000000]szDriver [/color][color=#8000FF],[/color][color=#0000C0]BYVAL [/color][color=#000000]%NULL[/color][color=#8000FF], [/color][color=#0000C0]BYVAL [/color][color=#000000]%NULL[/color][color=#8000FF], [/color][color=#0000C0]BYVAL [/color][color=#000000]%NULL[/color][color=#8000FF])
    [/color][color=#000000]CbAddr   [/color][color=#8000FF]= [/color][color=#0000C0]CODEPTR [/color][color=#8000FF]([/color][color=#000000]enumfonts_callback[/color][color=#8000FF])
    [/color][color=#000000]dwUser   [/color][color=#8000FF]= [/color][color=#0000C0]VARPTR [/color][color=#8000FF]([/color][color=#000000]szFace[/color][color=#8000FF])
    [/color][color=#000000]iRet     [/color][color=#8000FF]= [/color][color=#000000]EnumFonts [/color][color=#8000FF]( [/color][color=#000000]hDc[/color][color=#8000FF], [/color][color=#0000C0]BYVAL [/color][color=#000000]%NULL[/color][color=#8000FF], [/color][color=#000000]CbAddr[/color][color=#8000FF], [/color][color=#0000C0]BYVAL [/color][color=#000000]dwUser[/color][color=#8000FF])
    [/color][color=#000000]DeleteDc hDc
    [/color][color=#007F00]'MSGBOX gsFonts,64,"Installed Fonts"
    ' code added below
    [/color][color=#000000]gsFonts [/color][color=#8000FF]= [/color][color=#0000C0]LEFT$[/color][color=#8000FF]([/color][color=#000000]gsFonts[/color][color=#8000FF], [/color][color=#0000C0]LEN[/color][color=#8000FF]([/color][color=#000000]gsFonts[/color][color=#8000FF])-[/color][color=#000000]2[/color][color=#8000FF])    [/color][color=#007F00]' remove last ", "
    [/color][color=#0000C0]LOCAL [/color][color=#000000]fonts[/color][color=#8000FF]() [/color][color=#0000C0]AS STRING[/color][color=#8000FF], [/color][color=#000000]counter [/color][color=#0000C0]AS LONG
    [/color][color=#000000]counter [/color][color=#8000FF]= [/color][color=#0000C0]PARSECOUNT[/color][color=#8000FF]([/color][color=#000000]gsFonts[/color][color=#8000FF])
    [/color][color=#0000C0]REDIM [/color][color=#000000]fonts[/color][color=#8000FF]([/color][color=#000000]counter[/color][color=#8000FF]-[/color][color=#000000]1[/color][color=#8000FF])
    [/color][color=#0000C0]PARSE [/color][color=#000000]gsFonts[/color][color=#8000FF], [/color][color=#000000]fonts[/color][color=#8000FF]()
    [/color][color=#0000C0]ARRAY SORT [/color][color=#000000]fonts[/color][color=#8000FF](), [/color][color=#0000C0]COLLATE UCASE
    [/color][color=#000000]gsFonts [/color][color=#8000FF]= [/color][color=#0000C0]JOIN$[/color][color=#8000FF]([/color][color=#000000]fonts[/color][color=#8000FF](), [/color][color=#C020C0]", "[/color][color=#8000FF])

    [/color][color=#0000C0]LOCAL [/color][color=#000000]successful [/color][color=#0000C0]AS LONG
    CLIPBOARD RESET
    CLIPBOARD SET TEXT [/color][color=#000000]gsFonts[/color][color=#8000FF], [/color][color=#000000]successful
    [/color][color=#0000C0]IF [/color][color=#000000]successful [/color][color=#0000C0]THEN [/color][color=#000000]gsFonts [/color][color=#8000FF]+= [/color][color=#0000C0]$CR [/color][color=#8000FF]& [/color][color=#C020C0]"--> This list was sent to the clipboard <--"
    [/color][color=#0000C0]MSGBOX [/color][color=#000000]gsFonts[/color][color=#8000FF],[/color][color=#0000C0]%MB_ICONINFORMATION[/color][color=#8000FF],[/color][color=#C020C0]"Installed Fonts =" [/color][color=#8000FF]& [/color][color=#0000C0]STR$[/color][color=#8000FF]([/color][color=#000000]counter[/color][color=#8000FF])

[/color][color=#0000C0]END FUNCTION
[/color]

Added: manifest

[Mike Trader]

'Enumnerate System fonts

' Author: Michael Mattias Racine WI 11/20/05
#COMPILE EXE
#REGISTER NONE
#INCLUDE "WIN32API.INC" 

GLOBAL gsFonts AS STRING
       
               
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'        
FUNCTION enumfonts_callback (LF AS Logfont, TM AS TextMetric, BYVAL FontType AS DWORD, szFaceName AS ASCIIZ) AS LONG

  gsFonts = gsFonts + LF.lfFaceName + ", "  
  FUNCTION = %TRUE   

END FUNCTION
               
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'
FUNCTION PBMAIN () AS LONG    

  LOCAL szFace AS ASCIIZ * %MAX_PATH
  LOCAL szDriver AS ASCIIZ * 64
  LOCAL iValid, hdc, dwUser, iRet AS LONG
  LOCAL CbAddr AS DWORD
      
    gsFonts  = ""
    szDriver = "DISPLAY" 
    hDC      = CreateDc (szDriver ,BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
    CbAddr   = CODEPTR (enumfonts_callback)
    dwUser   = VARPTR (szFace)
    iRet     = EnumFonts ( hDc, BYVAL %NULL, CbAddr, BYVAL dwUser) 
    DeleteDc hDc   
    MSGBOX gsFonts,64,"Installed Fonts"

END FUNCTION    
               
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤'

------------------
Kind Regards
Mike

[Michael Mattias]

' FILE: IsValidFontFaceName.bas
' Simple function with wimpy test interface to determine (True or False) if a given string represents
' a valid installed font name on a user system
' Author: Michael Mattias Racine WI 11/20/05
' Compiler: PB/Windows v 7.02 11/20/05
' Public domain; posted January 2006

#COMPILE EXE
#DEBUG ERROR ON
#REGISTER NONE
#INCLUDE "WIN32API.INC"    ' May 9 2002

' CHEAP AND DIRTY USER TESTING INTERFACE
FUNCTION PBMAIN () AS LONG

    LOCAL   iValid  AS LONG
    LOCAL   szFace AS ASCIIZ * %MAX_PATH
    ' Accept the user string
    DO
       szFace  =   INPUTBOX$("Face Name? <Null exits>")
       IF lstrLen(szFace) = 0 THEN
           EXIT DO
       ELSE
           CALL  IsValidFontFaceName (szFace)  TO ivalid
           MSGBOX "Face '" & szFace & "' is " & IIF$(ivalid, $SPC, "NOT ") & "a valid installed face name on this system"
       END IF
    LOOP

END FUNCTION

' returns: TRUE, at least one font with this face name is installed on this system
'          FALSE, no font with this face name is installed on this system
FUNCTION IsValidFontFaceName (szFace AS ASCIIZ) AS LONG

  LOCAL szDriver     AS ASCIIZ * 64
  LOCAL hdc          AS LONG
  LOCAL CbAddr     AS DWORD,        dwUser AS LONG
  LOCAL  iRet      AS LONG

  'Create the device context required by the EnumFonts function:
  szDriver           = "DISPLAY"
  hDC                = CreateDc (szDriver ,BYVAL %NULL, BYVAL %NULL, BYVAL %NULL)
 ' set up the enumfonts...
  CbAddr             = CODEPTR (enumfonts_callback)
  dwUser             = VARPTR (szFace)
  ' Call the enum....
  iRet               = EnumFonts ( hDc, BYVAL %NULL, CbAddr, BYVAL dwUser)
  ' Thou shalt destroyeth any GDI object thou hast created...
  DeleteDc hDc
  ' If the enum returned zero, it's because the face name was found and we forced the enum to end.
  ' Otherwise we returned TRUE to continue the enum.
  FUNCTION   = ISFALSE (iRet)

END FUNCTION

' If the enumerated font's face name is the name to be tested, return zero to terminate the enumeration
' The last value returned by callback is returned as the function result by EnumFonts
FUNCTION enumfonts_callback (LF AS Logfont, TM AS TextMetric, BYVAL FontType AS DWORD, szFaceName AS ASCIIZ) AS LONG

   IF LF.lfFaceName = szFaceName THEN
       FUNCTION = 0
   ELSE
       FUNCTION = %TRUE
   END IF

END FUNCTION
'/// END OF FILE

------------------
Michael Mattias
Tal Systems Inc.
Racine WI USA
mailto:[email protected][email protected]</A>
www.talsystems.com