Windows Font List

[SMcNeill]

A version with a scrollable listing.  Just use arrow keys to scroll up and down.  

Code: (Select All)

Type Font_Name_Type

    Name As String

    FileName As String

End Type

ReDim Shared Fonts(10000) As Font_Name_Type



Screen _NewImage(1280, 720, 32)

GetFontList



numbered = -1 'number our quick list

l = 20 'number to print to the screen

w = 50 'width to print to the screen

Do

    Cls

    _Limit 30

    k = _KeyHit

    Select Case k

        Case 20480: s = s + 1: If s > UBound(Fonts) Then s = UBound(Fonts)

        Case 18432: s = s - 1: If s < 0 Then s = 0

    End Select

    Locate 10

    start = s: finish = s + l - 1

    For i = start To finish

        If numbered Then counter$ = LTrim$(Str$(i)) + ") "

        Locate , 10: Print counter$ + Left$(Fonts(i).Name, w);

        Locate , 70: Print Left$(Fonts(i).FileName, w)

    Next

    _Display

Loop Until k = 27









Sub GetFontList

    Shell _Hide "Powershell Get-ItemProperty 'HKLM:\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts'|Out-File -Encoding Ascii 'temp_fontlist.txt'"

    f = FreeFile

    Open "temp_fontlist.txt" For Binary As #f

    Do Until EOF(1)

        Line Input #1, temp$

        sep = InStr(temp$, ":")

        l$ = _Trim$(Left$(temp$, sep - 1))

        r$ = _Trim$(Mid$(temp$, sep + 1))

        If l$ <> "PSPath" Then 'we can stop reading files at this point (according to my tests)

            If l$ <> "" Then 'skip the blank space lines

                Fonts(count).Name = l$

                Fonts(count).FileName = r$

                count = count + 1

            End If

        Else

            count = count - 1

            Exit Do

        End If

    Loop

    Close f

    Kill "temp_fontlist.txt"

    ReDim _Preserve Fonts(count) As Font_Name_Type



    'a quick and simple combsort to make certain our list is in alphabetical order



    gap = count

    Do

        gap = 10 * gap \ 13

        If gap < 1 Then gap = 1

        i = 0

        swapped = 0

        Do

            If Fonts(i).Name > Fonts(i + gap).Name Then

                Swap Fonts(i).Name, Fonts(i + gap).Name

                Swap Fonts(i).FileName, Fonts(i + gap).FileName

                swapped = -1

            End If

            i = i + 1

        Loop Until i + gap > count

    Loop Until gap = 1 And swapped = 0

End Sub

---

This one does not create the temp_fontlist.txt file on my drive.

What does this single line do when you run it from a command prompt?

Code: (Select All)

Powershell Get-ItemProperty 'HKLM:\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts'|Out-File -Encoding Ascii 'temp_fontlist.txt

This should create the temp_fontlist.txt file for you. If it doesn't, it might be a difference in powershell commands from windows 7 to windows 11? I'll have to dig deeper to see what may have changed with it over the various versions.