Font list - Socoder

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 0\|568\|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
Socoder -> Blitz -> Font list
Mon, 24 Jul 2023, 04:42
spinal	Font list I'm doing a font maker to go with my watch project, but having a couple of issues. I'm trying to get a list of all fonts installed on my computer. I do this by reading the registry and creating a text file with a list of fonts. Then I go through the list and grab the first characters up to "(". But when I go through the list, I get occasional 'failed to load font' or MAV errors. Is ther a better way thamy this? ; Bitmap font maker Graphics 640,480,0,2 SetBuffer BackBuffer() ; List all installed fonts to fonts.txt ; Reg Query "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" > fonts.txt file = WriteFile("getfonts.bat") exeString$ = "Reg Query " + Chr$(34) + "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" + Chr$(34) + " > fonts.txt" WriteLine(file,exeString$) CloseFile file ExecFile("getFonts.bat") Dim fontList$(2048) ; only the first 2048 installed fonts will be usable. listFile = ReadFile ("fonts.txt") ; find the start of the list startoflist = 0 While startoflist = 0 templine$ = ReadLine(listFile) If templine = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" Then startoflist = 1 Wend numFonts = 0 While numFont < 2048 And (Not Eof(listFile)) templine$ = ReadLine(listFile) stringlength = 255 For t = 1 To Len(templine$) If Mid$(templine,t,1) = "(" Then stringlength = t - 1 Next fontList$(numFonts) = Trim$(Left$(templine$, stringlength)) numFonts = numFonts + 1 Wend CloseFile listFile DeleteFile "getfonts.bat" DeleteFile "fonts.txt" listoffset = 0 fHeight = 24 While Not KeyHit(1) Color 0,0,0 Rect 0,0,640,800,1 Locate 0,0 Color 255,255,255 For s = 0 To 15 font01 = LoadFont(fontList$(listoffset+s), fHeight, False, False, False) SetFont font01 Text 0,s*fHeight,fontList$(listoffset+s) Next If KeyHit(200) Then listoffset = listoffset - 1 If KeyHit(208) Then listoffset = listoffset + 1 Flip(1) Wend End --v -=-=- Check out my excellent homepage!
Mon, 24 Jul 2023, 04:50
Jayenkai	On Blitz2D/3D, the filename has to be the same as "font name" , so if it's "Fizzy Bubbles", the filename has to be "Fizzy Bubbles.ttf" * I think.. It was some weird complication like that. -=-=- ''Load, Next List!''
Mon, 24 Jul 2023, 07:14
spinal	I can grab the file name from my list, but, I can't find out where it might be installed. When I read the installed fonts from registry, I get about 3 times the amount of fonts that are in the windows/fonts folder. -=-=- Check out my excellent homepage!
Mon, 24 Jul 2023, 07:49
spinal	OK, I tried a little something to verify the font before adding to the list. Simply attempt to load it, apparently if the font system fails to load for whatever reason or returns 0. However, some fonts seem to not load, but don't return 0, it does say in the blitz docs that symbol type fonts just don't work, so maybe the ARE loaded, but can't be set? either way, no errors. Here is fully functioning blitz3d code to list all(?) of the font's installed in windows. ; Bitmap font maker Graphics 640,480,0,2 SetBuffer BackBuffer() ; List all installed fonts to fonts.txt ; Reg Query "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" > fonts.txt file = WriteFile("getfonts.bat") exeString$ = "Reg Query " + Chr$(34) + "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" + Chr$(34) + " > fonts.txt" WriteLine(file,exeString$) CloseFile file ExecFile("getFonts.bat") Dim fontList$(2048) ; only the first 2048 installed fonts will be usable. listFile = ReadFile ("fonts.txt") ; find the start of the list startoflist = 0 While startoflist = 0 templine$ = ReadLine(listFile) If templine = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" Then startoflist = 1 Wend numFonts = 0 While numFont < 2048 And (Not Eof(listFile)) templine$ = ReadLine(listFile) stringlength = 255 For t = 1 To Len(templine$) If Mid$(templine,t,1) = "(" Then stringlength = t - 1 Next font01 = LoadFont(fontList$(listoffset+s), fHeight, False, False, False) If font01 <> 0 Then fontList$(numFonts) = Trim$(Left$(templine$, stringlength)) numFonts = numFonts + 1 FreeFont font01 EndIf Wend CloseFile listFile DeleteFile "getfonts.bat" DeleteFile "fonts.txt" listoffset = 0 fHeight = 24 While Not KeyHit(1) Color 0,0,0 Rect 0,0,640,800,1 Locate 0,0 Color 255,255,255 For s = 0 To 15 font01 = LoadFont(fontList$(listoffset+s), fHeight, False, False, False) SetFont font01 Text 0,s*fHeight,fontList$(listoffset+s) FreeFont font01 Next If KeyHit(200) Then listoffset = listoffset - 1 If KeyHit(208) Then listoffset = listoffset + 1 If listoffset <0 Then listoffset = 0 If listoffset > numFonts-20 Then listoffset = numFonts-20 Flip(1) Wend End fHeight = 32 font01 = LoadFont("Arial", fHeight, False, False, False) ;SetFont font01 For t = 32 To 127 Cls Locate 0,0 Print Chr$(t) t=t+1 Delay(100) Flip(1) Next While Not KeyHit(1) Delay(1) Wend --v does blitz have any way to sort strings alphabetically? -=-=- Check out my excellent homepage!