-
Zachary Curtis
- PowerBuilder
- Wednesday, 26 February 2025 10:35 PM UTC
I'm trying to populate a dropdown with a list of all installed fonts, but I'm having trouble getting something that works well.
I got pretty close by looking at the Windows registry (HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts and HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts) which gets me all the .ttf file locations. Then, I use OLEObjects to get the titles of the .ttf files, which match up with the actual font names. However, I'm not able to get the title of any .ttf files in C:\Windows\Fonts, I think it's a permission issue. But I can copy the .ttf file somewhere else, then get the title from that. It works, but it's ugly and it slows down my program. Code snippet attached below (I'm just throwing all the font titles into the instance variable isFontTitles[]). Maybe there's a way to get the title of the .ttf while it's in C:\Windows\Fonts?
Another approach that sounds tempting is the Windows API call EnumFontFamiliesExA. If I could get that working, that would be very clean - but it requires a callback function, which I don't know if PowerBuilder supports or not.
I'm totally open to other approaches, so if there's some other way I can get the list, I'd appreciate the help.
My current code snippet:
String lsHKLMFonts[], lsHKCUFonts[], lsFontFilePaths[], lsFontFile, lsPath, lsFile, lsFontTitle, lsTempDir
Long lli
OLEObject loleShell, loleFolder, loleItem
Boolean lbCopied
// Local machine fonts
RegistryValues("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", lsHKLMFonts)
FOR lli = 1 TO UpperBound(lsHKLMFonts)
RegistryGet("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", lsHKLMFonts[lli], RegString!, lsFontFile)
IF Pos(lsFontFile, '\') < 1 THEN
lsFontFile = 'C:\Windows\Fonts\' + lsFontFile
END IF
IF FileExists(lsFontFile) THEN
lsFontFilePaths[UpperBound(lsFontFilePaths) + 1] = lsFontFile
END IF
NEXT
// Current user fonts
RegistryValues("HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", lsHKCUFonts)
FOR lli = 1 TO UpperBound(lsHKCUFonts)
RegistryGet("HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts", lsHKCUFonts[lli], RegString!, lsFontFile)
IF FileExists(lsFontFile) THEN
lsFontFilePaths[UpperBound(lsFontFilePaths) + 1] = lsFontFile
END IF
NEXT
// Get font titles
loleShell = CREATE OLEObject
loleShell.ConnectToNewObject('shell.application')
lsTempDir = guOS.GetFolderPath(guOS.FOLDER_LOCAL_TEMP_FAMOUS)
FOR lli = 1 TO UpperBound(lsFontFilePaths)
IF Pos(lsFontFilePaths[lli], 'C:\Windows\Fonts\') > 0 THEN
lsPath = lsTempDir
lsFile = Mid(lsFontFilePaths[lli], LastPos(lsFontFilePaths[lli], "\") + 1)
FileCopy(lsFontFilePaths[lli], lsPath + lsFile)
lbCopied = TRUE
ELSE
lsPath = Left(lsFontFilePaths[lli], LastPos(lsFontFilePaths[lli], "\"))
lsFile = Mid(lsFontFilePaths[lli], LastPos(lsFontFilePaths[lli], "\") + 1)
lbCopied = FALSE
END IF
IF FileExists(lsFontFilePaths[lli]) THEN
loleFolder = loleShell.NameSpace(lsPath)
IF IsValid(loleFolder) THEN
loleItem = loleFolder.ParseName(lsFile)
IF IsValid(loleItem) THEN
lsFontTitle = loleFolder.GetDetailsOf(loleItem, 21)
isFontTitles[UpperBound(isFontTitles) + 1] = lsFontTitle
END IF
END IF
END IF
IF lbCopied AND FileExists(lsTempDir + lsFile) THEN
FileDelete(lsTempDir + lsFile)
END IF
NEXT
Find Questions by Tag
Helpful?
If a reply or comment is helpful for you, please don’t hesitate to click the Helpful button. This action is further confirmation of their invaluable contribution to the Appeon Community.