Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

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

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

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

    Code:
    ' 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
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

  • #2
    Code:
    '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

    Comment


    • #3
      Hi Mike and Michael,

      I found 414 fonts, and without sorting the list is a mess ... so I added sorting.
      Code:
      [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
      Attached Files
      Last edited by Arthur Gomide; 12 Jan 2016, 11:08 AM.
      "The trouble with quotes on the Internet is that you can never know if they are genuine." - Abraham Lincoln.

      Comment

      Working...
      X