BBC BASIC for Windows
Programming >> User Interface >> Enumerating fonts
http://bb4w.conforums.com/index.cgi?board=ui&action=display&num=1247122111
Enumerating fonts
Post by Michael Hutton on Jul 9th, 2009, 06:48am

Here is some code to Enumerate the Fonts your computer. It involves a CALLBACK procedure and as you can see the Structures used are slightly involved.

I'll post the code here for discussion and when all problems are ironed out I'll get a Wiki article going.

Note TRUETYPE_FONTTYPE is not recognised in winconst but _TRUETYPE_FONTTYPE is. I've changed it manually.

Code:
      REM Enumerate fonts
      INSTALL @lib$+"CALLBACK"
      
      REM!WC
      TRUETYPE_FONTTYPE = &4
      MM_MAX_NUMAXES = 16
      LF_FACESIZE = 32
      LF_FULLFACESIZE = 64
      
      REM Windows Structures
      DIM _LOGFONT{ Height%,         \
      \             Width%,          \
      \             Escapement%,     \
      \             Orientation%,    \
      \             Weight%,         \
      \             Italic&,         \
      \             Underline&,      \
      \             StrikeOut&,      \
      \             CharSet&,        \
      \             OutPrecision&,   \
      \             ClipPrecision&,  \
      \             Quality&,        \
      \             PitchAndFamily&, \
      \             FaceName&(LF_FACESIZE-1)    }
      
      
      DIM TEXTMETRIC{     tmHeight%,             \
      \                   tmAscentr%,            \
      \                   tmDescent%,            \
      \                   tmInternalLeading%,    \
      \                   tmExternalLeading%,    \
      \                   tmAveCharWidth%,       \
      \                   tmMaxCharWidth%,       \
      \                   tmWeight%,             \
      \                   tmOverhang%,           \
      \                   tmDigitizedAspectX%,   \
      \                   tmDigitizedAspectY%,   \
      \                   tmFirstChar&,          \
      \                   tmLastChar&,           \
      \                   tmDefaultChar&,        \
      \                   tmBreakChar&,          \
      \                   tmItalic&,             \
      \                   tmUnderlined&,         \
      \                   tmtmStruckOut&,        \
      \                   tmPitchAndFamily&,     \
      \                   tmCharSet&            }
      
      DIM NEWTEXTMETRIC{  tmHeight%,             \
      \                   tmAscentr%,            \
      \                   tmDescent%,            \
      \                   tmInternalLeading%,    \
      \                   tmExternalLeading%,    \
      \                   tmAveCharWidth%,       \
      \                   tmMaxCharWidth%,       \
      \                   tmWeight%,             \
      \                   tmOverhang%,           \
      \                   tmDigitizedAspectX%,   \
      \                   tmDigitizedAspectY%,   \
      \                   tmFirstChar&,          \
      \                   tmLastChar&,           \
      \                   tmDefaultChar&,        \
      \                   tmBreakChar&,          \
      \                   tmItalic&,             \
      \                   tmUnderlined&,         \
      \                   tmtmStruckOut&,        \
      \                   tmPitchAndFamily&,     \
      \                   tmCharSet&,            \
      \                   ntmFlags%,             \
      \                   ntmSizeEM%,            \
      \                   ntmCellHeight%,        \
      \                   ntmAvgWidth%           }
      
      
      DIM FONTSIGNATURE{ fsUsb&(15) , fsCab&(7) }
      
      DIM NEWTEXTMETRICEX{ ntmTm{} = NEWTEXTMETRIC{},      \
      \                    ntmFontSig{} = FONTSIGNATURE{} }
      
      DIM ENUMLOGFONTEX{ elfLogFont{} = _LOGFONT{},              \
      \                  elfFullName&(LF_FULLFACESIZE-1),        \
      \                  elfStyle&(LF_FACESIZE-1),               \
      \                  elfScript(LF_FACESIZE-1)               }
      
      DIM AXESLIST{  axlReserved%,                    \
      \              axlNumAxes%,                     \
      \              axlAxesInfo&(MM_MAX_NUMAXES-1)  }
      
      DIM ENUMTEXTMETRIC{ etmNewTextMetricEx{} = NEWTEXTMETRICEX{}, \
      \                   etmAxesList{} = AXESLIST{}               }
      
      DIM DESIGNVECTOR{ dvReserved%,                 \
      \                 dvNumAxes%,                  \
      \                 dvValues&(MM_MAX_NUMAXES-1)  }
      
      DIM ENUMLOGFONTEXDV{ elfEnumLogfontEx{} = ENUMLOGFONTEX{},  \
      \                    elfDesignVector{} = DESIGNVECTOR{}    }
      
      
      REM Enumerate fonts
      fontcount% = 0
      
      SYS FN_syscalls("EnumFontFamiliesEx"), @memhdc%, _LOGFONT{}, FN_callback(FNenumfonts(),4), 0, 0
      ret% = FN_sysresult
      
      
      
      END
      
      DEF FNenumfonts(pENUMLOGFONTINDEX%, pTEXTMETRIC%, fonttype%, lparam%)
      fontcount% += 1
      REM Show all TRUETYPE fonts
      IF fonttype% = TRUETYPE_FONTTYPE THEN
        PRINT fontcount%, " ",$$(pENUMLOGFONTINDEX%+28)
      ENDIF
      = 1


Michael
Re: Enumerating fonts
Post by Michael Hutton on Jul 9th, 2009, 07:27am

Saying that, here is a procedure to enumerate the fonts on the system and pass them into an array called fontname$(). You don't need to Dimension the array before hand, just make sure the name is fontname$() - I'm working on a way to to make it anything you want.

Code:
      
      PROC_GetFonts(^fontname$())
      
      FOR I%=0 TO DIM(fontname$(),1)
        PRINT I%+1," "fontname$(I%)
      NEXT
      
      END
      
      DEF PROC_GetFonts(P%)
      LOCAL LF_FACESIZE , _LOGFONT{}, fontcount%, ret%
      LF_FACESIZE = 32
      DIM _LOGFONT{ Height%,         \
      \             Width%,          \
      \             Escapement%,     \
      \             Orientation%,    \
      \             Weight%,         \
      \             Italic&,         \
      \             Underline&,      \
      \             StrikeOut&,      \
      \             CharSet&,        \
      \             OutPrecision&,   \
      \             ClipPrecision&,  \
      \             Quality&,        \
      \             PitchAndFamily&, \
      \             FaceName&(LF_FACESIZE-1)    }
      REM Enumerate fonts
      fontcount% = 0
      ON ERROR LOCAL RESTORE ERROR:INSTALL @lib$+"CALLBACK"
      SYS FN_syscalls("EnumFontFamiliesEx"), @memhdc%, _LOGFONT{}, FN_callback(FNenumfontscount(),4), 0, 0
      ret% = FN_sysresult
      DIM fontname$(fontcount%-1)
      fontcount%=-1
      SYS FN_syscalls("EnumFontFamiliesEx"), @memhdc%, _LOGFONT{}, FN_callback(FNenumfontsgetnames(),4), 0, 0
      ret% = FN_sysresult
      ENDPROC
      
      DEF FNenumfontscount(pENUMLOGFONTINDEX%, pTEXTMETRIC%, fonttype%, lparam%)
      fontcount% += 1
      =1
      
      DEF FNenumfontsgetnames(pENUMLOGFONTINDEX%, pTEXTMETRIC%, fonttype%, lparam%)
      fontcount% += 1
      fontname$(fontcount%) = $$(pENUMLOGFONTINDEX%+28)
      = 1


Michael
Re: Enumerating fonts
Post by admin on Jul 9th, 2009, 08:35am

A couple of suggestions:

1. Since you can pass 'user data' (in lParam) to the EnumFontProc, it would be more elegant to have a common function for both 'counting' and 'getting names', with lParam determining which operation is performed.

2. You say "just make sure the name is fontname$()" but you pass the name of the array to PROC_GetFonts anyway! Therefore by using this parameter you can easily arrange that any array name can be used.

3. Initialising fontcount% to -1, and 'pre-incrementing' it in the callback function, is rather inelegant. Better to initialise it to zero and 'post-increment' it.

I've made these changes in the code below.

Richard.

Code:
      PROC_GetFonts(MyFontName$())
      
      FOR I% = 0 TO DIM(MyFontName$(),1)
        PRINT I%+1, " " MyFontName$(I%)
      NEXT
      
      END
      
      DEF PROC_GetFonts(RETURN fontname$())
      LOCAL LF_FACESIZE , _LOGFONT{}, fontcount%, ret%
      LF_FACESIZE = 32
      DIM _LOGFONT{ Height%,         \
      \             Width%,          \
      \             Escapement%,     \
      \             Orientation%,    \
      \             Weight%,         \
      \             Italic&,         \
      \             Underline&,      \
      \             StrikeOut&,      \
      \             CharSet&,        \
      \             OutPrecision&,   \
      \             ClipPrecision&,  \
      \             Quality&,        \
      \             PitchAndFamily&, \
      \             FaceName&(LF_FACESIZE-1) }
      REM Enumerate fonts
      fontcount% = 0
      ON ERROR LOCAL RESTORE ERROR:INSTALL @lib$+"CALLBACK"
      SYS FN_syscalls("EnumFontFamiliesEx"), @memhdc%, _LOGFONT{}, FN_callback(FNenumfonts(),4), 0, 0
      ret% = FN_sysresult
      DIM fontname$(fontcount%-1)
      fontcount% = 0
      SYS FN_syscalls("EnumFontFamiliesEx"), @memhdc%, _LOGFONT{}, FN_callback(FNenumfonts(),4), 1, 0
      ret% = FN_sysresult
      ENDPROC
      
      DEF FNenumfonts(pENUMLOGFONTINDEX%, pTEXTMETRIC%, fonttype%, lparam%)
      IF lparam% fontname$(fontcount%) = $$(pENUMLOGFONTINDEX%+26)
      fontcount% += 1
      = 1
Re: Enumerating fonts
Post by Michael Hutton on Jul 9th, 2009, 10:12am

Great. Thanks. Of course, I just hadn't thought of RETURNing the array address! Thanks for tidying it up.

Of note though

$$(pENUMLOGFONTINDEX%+26

I discovered is wrong. I counted the wrong number, it should be:

$$(pENUMLOGFONTINDEX%+28

I did change the original post but I suspect you had already seen the first one.

Do you think this is good enough code for a small Wiki article? I haven't discovered much more about the other structures yet but this arised out of the necessity of knowing all the available fonts....

Michael

Re: Enumerating fonts
Post by Michael Hutton on Jul 9th, 2009, 12:51pm

Just noticed the code in the wiki. Cancel last statement!
Michael
Re: Enumerating fonts
Post by admin on Jul 9th, 2009, 1:17pm

Quote:
Just noticed the code in the wiki. Cancel last statement!

In some ways your code is more elegant than that in the existing Wiki article (for example you don't have to DIMension the array first, and installing the CALLBACK library is 'automatic'). On the other hand your code is more complicated as a result, so might detract from the primary purpose of the existing article, which is to ilustrate how to use callbacks.

If you do decide to write a new article I would recommending adding a link to it from 'Using callback functions'.

Richard.
Re: Enumerating fonts
Post by admin on Jul 9th, 2009, 5:14pm

Quote:
TRUETYPE_FONTTYPE is not recognised in winconst

The version of WinConst currently available on the BB4W group is documented as "v1.5a . Minor Bug fix. Will recognise variables beginning with allowed BASIC keywords" so shouldn't it now be happy with constants starting with 'TRUE'? Is this something you're hoping to fix soon?

Richard.
Re: Enumerating fonts
Post by Michael Hutton on Jul 9th, 2009, 11:17pm

I think I remember this one, but I haven't looked at the code yet.

In the case of TRUE it would recognise the BB4W key word TRUE as the windows constant TRUE and add the definition which would then be the BB4W keyword TRUE = 1. Which gives a syntax error. I suppose it was a 'quick fix' to insist that the windows constant _TRUE must have an underscore prefix, which also requires that any WC starting with TRUE must have an underscore, even though it is an allowed BB4W keyword at the beginning of a variable.

In theory in the case of TRUE I could test if the variable is longer than 4 letters, but I haven't done yet. It is something I will consider for the next update.

I've added it to the list of 'to do'.

Michael.
Re: Enumerating fonts
Post by admin on Jul 10th, 2009, 08:46am

Quote:
I suppose it was a 'quick fix' to insist that the windows constant _TRUE must have an underscore prefix, which also requires that any WC starting with TRUE must have an underscore

Ah, I'd assumed that your code worked similarly to the 'tokenising' code in the interpreter. That is, 'TRUE' on its own is tokenised (so isn't legal as a constant) but 'TRUE' followed by anything else isn't tokenised (so is legal as a constant).

Indeed you could utilise the built-in tokeniser to create a 'foolproof' function which would tell you whether a constant was valid (without requiring a leading underscore) or not:

Code:
      DEF FNvalid(var$)
      LOCAL dummy%, token$
      dummy% = EVAL("0:" + var$)
      token$ = $(!332+2)
      = (token$ = var$)

This returns TRUE (-1) if the constant is valid and FALSE (0) if it needs to have a leading underscore; no need for any lists of keywords that you check against!

Richard.
Re: Enumerating fonts
Post by Michael Hutton on Jul 10th, 2009, 10:55am

Very neat. Thanks. I'll definitely use that in the next update.

Michael
Re: Enumerating fonts
Post by Michael Hutton on Jul 28th, 2009, 3:08pm

winconst now recognises TRUETYPE_FONTTYPE....

expect the update at the end of the week.

Michael