Windows Font List

[TerryRitchie]

I have another Windows 7 machine running my entertainment center in the living room. It has a plain vanilla install of Windows 7 Pro 64bit and Kodi to access my NAS'. I'll take the code over to that machine and see if I get the same results.

The main machine that I code on seems to work properly and has for years. I have no idea why the output I'm getting is so weird. The only program I have running in the background is Desktops64 by SysInternals ( https://learn.microsoft.com/en-us/sysint...s/desktops ). It gives me four different desktops to work with like Linux. Even with that uninstalled I get the same weird output.

[TerryRitchie]

Terry, I'm on v3.12.0
I have no syntax error in my IDE. Are you sure you installed QB64 to a fresh folder?

For reference, here is my output running that same code in v3.12.0:


To be on the safe side, I ran it as $CONSOLE:ONLY and as a regular window. Both gave me the same results. Something is wack with your install.

Yep, installs are kept in their own folders. I currently have versions 3.4.1 through 3.12.0 installed on my system.

The $CONSOLE:ONLY line was a brain fart on my end. The comment you added to the code broke the line and I didn't catch that until later.

[SMcNeill]

The issue seems to be Microsoft trying to format the text for display in an actual column.

If you look, you have a font name that is helluva long  (77 characters, or so!!)...

Your console must be configured for 79 characters total width...

So what is going on here??

It's forming two columns to align the text on the screen.   Column 1 is 77 characters in size.  The ":" is the separator between columns.  That only leaves ONE character for the second column -- and that's what we're seeing.   That one character printed and aligned to the border for that 2nd column!

Two things to try here:

1) Resize your console and save it at 120 characters width and see if that doesn't fix the issue.

2) Try this code below:

Code: (Select All)

Screen _NewImage(800, 600, 32)

Shell _Hide "Powershell -command " + Chr$(34) + "$Host.UI.RawUI.BufferSize = New-Object Management.Automation.Host.Size (200, 50); Get-ItemProperty 'HKLM:\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts'|Out-File -Encoding Ascii 'temp.txt'" + Chr$(34)

If _FileExists("temp.txt") Then

    Open "temp.txt" For Binary As #1

    Do

        Line Input #1, text$

        Print text$

        Sleep

    Loop Until EOF(1)

Else

    Print "No file created"

End If

I'm trying to tell Powershell to set the formatting to a (200,50) screen.  If this works on your machine, it *should* fix the issue for you.  

I hope. 

---

(Hopefully that runs as is.  I had to tweak the (200, 50) values a bit so that they'd actually work on my system.  Console/Terminal is VERY picky in what it allows for a min/max width/height for those values.  You might need to tweak them a bit if they error with a min/max blah blah blah message.)

[SMcNeill]

One of these fonts has the name

Code: (Select All)

Meiryo Bold & Meiryo Bold Italic & Meiryo UI Bold & Meiryo UI Bold Italic

, it's actually cutoff because it's so long

[SMcNeill]

Update:  Sorry.  Noticed the filename didn't match in the above, so it'd never find the file we were creating.  /blush

Try this instead:

Code: (Select All)

Screen _NewImage(800, 600, 32)

Shell _Hide "Powershell -command " + Chr$(34) + "$Host.UI.RawUI.BufferSize = New-Object Management.Automation.Host.Size (200, 50); Get-ItemProperty 'HKLM:\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts'|Out-File -Encoding Ascii 'temp.txt'" + Chr$(34)

If _FileExists("temp.txt") Then

    Open "temp.txt" For Binary As #1

    Do

        Line Input #1, text$

        Print text$

        Sleep

    Loop Until EOF(1)

Else

    Print "No file created"

End If

I've really got to be a little more careful with these things.  I was opening an old file, and not making a new one, and thus never caught the issue until I went in and cleaned up all the temp files.  Apologies. 

[a740g]

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

[Pete]

That one looks like fun, and not possible before 3-1-1. 

+2 Buckaroo!

Pete

- I'm not serious, seriously.