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
Comment