ChooseRawFile() cannot access Windows System Fonts (ie, C:\Windows\Fonts) while
GetRawFolderNumFiles() does enumerate and
GetRawFolderFileName() is functional allowing us to build a list of system fonts and load via
LoadFont("raw:" + FullPath$)
If there is a native manner that i didn't consider, please advise. Otherwise:
// Project: System Fonts
// By: Virtual Nomad
// Created: 2023-05-29
// show all errors
SetErrorMode(2)
// set window properties
SetWindowTitle( "System Fonts" )
SetWindowSize( 1280,720, 0 )
SetWindowAllowResize( 1 )
// set display properties
SetVirtualResolution( 1280,720 )
SetOrientationAllowed( 1, 1, 1, 1 ) // portrait, portrait2, landscape, landscape2
SetSyncRate( 30, 0 )
SetScissor( 0,0,0,0 )
UseNewDefaultFonts( 1 )
CenterWindow()
GLOBAL FontsDIR$, Start, Finish, LastKey#, Preview, cstring$, Font, Fonts as String []
FontsDIR$ = "c:\windows\fonts\" //set to your own
cstring$ = "" //preview text
For x = 32 to 126
cstring$ = cstring$ + CHR(x)
Next x
FillFonts() //enumerate system fonts
MakePreview()
do
If GetPointerPressed() then OpenBrowser(FontsDIR$)
If GetRawKeyPressed(27) then End //[ESC]
If GetRawKeyPressed(36) //[Home]
Start = 0 :
MakePreview()
EndIf
If GetRawKeyPressed(35) //[End]
Start = Fonts.Length
MakePreview()
EndIf
If LastKey# + 0.1 <= Timer()
UD = GetRawKeyState(38) - GetRawKeyState(40) // [Up/Downkey]
LastKey# = Timer()
Else
UD = 0
EndIf
MMZ = GetRawMouseWheelDelta() + UD
If MMZ <> 0
If MMZ > 0 then DEC Start Else INC Start
If Start < 0 then Start = 0
If Start > Fonts.Length then Start = Fonts.Length
MakePreview()
EndIf
Finish = Start+14
If Finish > Fonts.Length then Finish = Fonts.Length
Print(STR(Start) + "/" + STR(Fonts.Length) + " Fonts")
For x = Start to Finish
If x = Start
Print(Fonts[x] + " <" )
Else
Print(Fonts[ x ] )
EndIf
Next x
Sync()
loop
Function FillFonts()
ThisFolder = OpenRawFolder(FontsDIR$)
ThisNum = GetRawFolderNumFiles( ThisFolder )
For x = 1 to ThisNum
ThisFile$ = GetRawFolderFileName( ThisFolder, x )
RGT$ = LOWER( RIGHT(ThisFile$,3) )
If RGT$ = "ttf" or RGT$ = "otf" //.FON, etc, = less-desirable. YMMV
Fonts.Insert( UPPER(ThisFile$) ) //UP'd for sorting/.find purposes; desktop will load regardless of case
EndIf
Next x
Fonts.Sort()
EndFunction
Function MakePreview()
If GetTextExists(Preview) then DeleteText(Preview)
If GetFontExists(font) then DeleteFont(font)
Font = LoadFont("raw:" + FontsDIR$+Fonts[Start]) //raw: required
Preview = CreateText(cstring$)
SetTextFont(Preview,font)
SetTextSize(Preview,64)
SetTextMaxWidth(Preview,700)
SetTextPosition(Preview,550,0)
EndFunction
Function CenterWindow()
X = GetMaxDeviceWidth()/2.0 - GetWindowWidth()/2.0
Y = GetMaxDeviceHeight()/2.0 - GetWindowHeight()/2.0
SetWindowPosition( X,Y)
EndFunction
MWheel/[Up|Down] to scroll through/preview font + [Home|End]
Tested Classic V2023.01.16 on WIN10
Note: Fonts located
outside of the System folder (including ...\Username\AppData\Local\Microsoft\Windows\Fonts)
are accessible via ChooseRawFile() otherwise.
Add: could others on other OSs advise if ChooseRawFile()
can select a System font and report? ie, is this a win-only issue? (i've tried running as Admin, etc).
And, does the code provided work as expected on other operating systems?
