Tweet
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