03-15-2024, 06:00 PM
This is a simple single function cross-platform font list builder. The nice thing about this is that it does absolutely no filesystem writes. It needs QB64-PE v3.11 or later to work. To avoid recursion for sub-directories I used a simple stack.
Code: (Select All)
''' @brief Builds an array of fonts from that are available in the host OS (user installed + system installed).
''' @param fontList This a dynamic string array. The function will redimension fontList starting from 0.
''' @return The count of fonts found.
FUNCTION BuildFontList~& (fontList() AS STRING)
' Some system specific constants that we'll need
$IF WINDOWS THEN
CONST __BFL_DIR_SEP = "\"
$ELSE
CONST __BFL_DIR_SEP = "/"
$END IF
CONST __BFL_CUR_DIR = "." + __BFL_DIR_SEP
CONST __BFL_PAR_DIR = ".." + __BFL_DIR_SEP
' dirStack is a stack of directories that we'll need to traverse
REDIM dirStack(0 TO 0) AS STRING
' Add the system font directory to the stack
dirStack(0) = _DIR$("FONT")
IF _DIR$("USERFONT") <> dirStack(0) THEN
' Add the user font directory to the stack only if it is unique
REDIM _PRESERVE dirStack(0 TO 1) AS STRING
dirStack(1) = _DIR$("USERFONT")
END IF
' This keeps the total count of fonts that we found and is returned to the caller
DIM fontCount AS _UNSIGNED LONG
' Keep reading the directories unless we have exhausted everything in the stack
WHILE LEN(dirStack(UBOUND(dirStack))) > 0
' Get the directory at the top of the stack
DIM directory AS STRING: directory = dirStack(UBOUND(dirStack))
' Pop the directory
IF UBOUND(dirStack) > 0 THEN
REDIM _PRESERVE dirStack(0 TO UBOUND(dirStack) - 1) AS STRING
ELSE
dirStack(0) = "" ' clear the last directory
END IF
' Start getting the entries from the directory
DIM entry AS STRING: entry = _FILES$(directory)
DO
IF entry <> __BFL_CUR_DIR AND entry <> __BFL_PAR_DIR AND RIGHT$(entry, 1) = __BFL_DIR_SEP THEN
' If the entry is a legit directory, then push it to the stack
IF LEN(dirStack(0)) > 0 THEN
REDIM _PRESERVE dirStack(0 TO UBOUND(dirStack) + 1) AS STRING
dirStack(UBOUND(dirStack)) = directory + entry
ELSE
dirStack(0) = directory + entry ' this then becomes the only directory in the stack
END IF
ELSE
DIM extension AS STRING: extension = LCASE$(RIGHT$(entry, 4)) ' we can get away with this because all our font file extensions are 3 characters in length
SELECT CASE extension
' Add the entry to the fontList() array if it is a legit font file name
CASE ".ttf", ".ttc", ".otf" ', ".fnt", ".fon", ".pcf", ".bdf" ' uncomment this if bitmap fonts are needed
' Grow the fontList array and add the complete font pathname to it
REDIM _PRESERVE fontList(0 TO fontCount) AS STRING
fontList(fontCount) = directory + entry
fontCount = fontCount + 1
END SELECT
END IF
entry = _FILES$
LOOP WHILE LEN(entry) > 0
WEND
BuildFontList = fontCount
END FUNCTION
Code: (Select All)
' Example
$CONSOLE:ONLY
REDIM fl(0) AS STRING
IF BuildFontList(fl()) > 0 THEN
DIM i AS LONG: FOR i = LBOUND(fl) TO UBOUND(fl)
PRINT i; ": "; fl(i)
NEXT i
ELSE
PRINT "Failed to build font list!"
END IF
END