Obtaining a list of fonts

[Danny Faris]

Semen and Borje:

Thank you so much for your tips. It seems that when I get my mind
set on one way of doing something, it doesn't usually occur to me
to try it another way. I never even thought of a function
specifically designed to retrieve a list of available fonts.

Borje, your code works great, as usual. Thank you for spelling it
out to me, the more parameters there are to a function, the more
lost I get. I suppose I'm spoiled with the simplisity of
PowerBASIC's built-in commands, like DDT for example.

Again, thank you both for all your help. My font dialog is now
complete!

Danny.

[Borje Hagsten]

I use the following in a PB editor I'm working on. Works fine for me.

'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Fill a combo box with the names of all fonts of a certain type
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB FillFontCombo(BYVAL hWnd AS LONG)
  LOCAL hDC AS LONG
 
  SendMessage hWnd, %CB_RESETCONTENT, 0, 0
  hDC = GetDC(%HWND_DESKTOP)
    EnumFonts hDC, BYVAL %NULL, CODEPTR(EnumFontName), BYVAL VARPTR(hWnd)
  ReleaseDC %HWND_DESKTOP, hDC
END SUB
 
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Enumerate the names of all fonts of a certain type.
' %TMPF_FIXED_PITCH for fixed pitch fonts (like in PB edit)     (bit is zero)
' %TMPF_TRUETYPE OR %TMPF_VECTOR for True type and vector fonts (bit is set)
' %TMPF_DEVICE for device fonts, like printer. Often combined.  (bit is set)
' Note the difference between how to enumerate them.
' Comment out / uncomment the type you need, or combine them.
' See Win32.hlp for more info about tmPitchAndFamily under TEXTMETRIC
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION EnumFontName(lf AS LOGFONT, tm AS TEXTMETRIC, BYVAL FontType AS LONG, hWnd AS LONG) AS LONG
  'IF (tm.tmPitchAndFamily AND %TMPF_FIXED_PITCH) = 0 THEN          ' for fixed-pitch fonts
  IF (tm.tmPitchAndFamily AND (%TMPF_VECTOR or %TMPF_VECTOR) ) THEN ' for true type and vector fonts
     SendMessage hWnd , %CB_ADDSTRING, 0, VARPTR(lf.lfFaceName)
  END IF
  FUNCTION = 1
END FUNCTION

------------------

[Semen Matusovski]

What's wrong with EnumFontFamiliesEx ?

------------------
E-MAIL: [email protected]

[Danny Faris]

Good evening, everyone.

I am, as usual, doing something strange and completely unexpected.
I'm creating my own dialog to set the current font in my program.
I know that there's a standard font dialog, which is usually
called in these situations, but I'd rather use my own as I
personally find its layout less confusing. Anyway, my problem is
getting a list of all available fonts on a paticular PC. I found
the list in the registry, under
HKEY_Local_Machine\Software\Microsoft\Windows\CurrentVersion\Fonts.

My job now is to retrieve all the values under this key, Right? If
I'm right on that, the RegEnumValue function has got to be the
answer. Or so I thought.

I put together the below program, but it just returns error code
234, which is %ERROR_MORE_DATA. I've puzzled over that one for a
while, but can't figure out what that could possibly mean. Anyway,
I'm hoping I've done something obviously wrong in the below
program.

#COMPILE EXE
#INCLUDE "WIN32API.INC"
GLOBAL hKey AS LONG, Ended AS LONG, Dud AS LONG, Ti AS INTEGER

FUNCTION RegOpenSection (BYVAL Key AS LONG, Section AS ASCIIZ) AS LONG
IF RegCreateKeyEx(Key, Section, 0, "", %REG_OPTION_NON_VOLATILE, _
%KEY_ALL_ACCESS, BYVAL %NULL, hKey, Dud) <> %ERROR_SUCCESS THEN
'Failed
END IF
END FUNCTION

FUNCTION RegClose() AS LONG
RegCloseKey hKey
END FUNCTION

FUNCTION RegGetValues(Key AS LONG, Txt AS ASCIIZ, mAray() AS STRING) EXPORT AS INTEGER
LOCAL zBuffer AS ASCIIZ*300
CALL RegOpenKey(Key, Txt, hKey)
IF ISFALSE(hKey) THEN EXIT FUNCTION
FOR Dud=0 TO 1001
Ended=RegENumValue(hKey, Dud, zBuffer, SIZEOF(zBuffer)-1, %NULL, 0, 0, 0)
IF Ended=%ERROR_Success THEN
mAray(Dud+1)=zBuffer
ELSEIF Ended=%ERROR_NO_MORE_ITEMS THEN
EXIT
ELSE
MSGBOX "Error code" & STR$(Ended)
EXIT
END IF
NEXT
RegClose
FUNCTION=Dud
END FUNCTION

FUNCTION PBMAIN
DIM tAray(1:1000) AS STRING
Ti=RegGetValues(%HKLM, "Software\Microsoft\Windows\CurrentVersion\Fonts", tAray())
MSGBOX "Retrieved" & STR$(Ti) & " fonts:" & $CRLF & _
"First font is " & tAray(1) & $CRLF & _
"Second font is " & tAray(2) & $CRLF & _
"Third font is " & tAray(3)
END FUNCTION

Thank you so much for your help. All this registry stuff has a
disterbing way of getting me really confused really fast.

Danny.