Listing all available fonts in a combobox.

[Ionic Wind Support Team]

Another one from Fletchie from the old Pyxia forums.  Tested in Emergence OK.
-----------------------------------------------------------

The prog below will list the currently available fonts into a ComboBox.

conComboLoadFonts(win,controlid,tt)

-where tt is 1 if you only require TrueType fonts.

Code Select Expand


const ANSI_CHARSET         =0
const DEFAULT_CHARSET      =1
const SYMBOL_CHARSET         =2
const SHIFTJIS_CHARSET      =128
const HANGEUL_CHARSET      =129
const HANGUL_CHARSET         =129
const GB2312_CHARSET         =134
const CHINESEBIG5_CHARSET   =136
const OEM_CHARSET         =255
const JOHAB_CHARSET         =130
const HEBREW_CHARSET      =177
const ARABIC_CHARSET         =178
const GREEK_CHARSET         =161
const TURKISH_CHARSET      =162
const VIETNAMESE_CHARSET   =163
const THAI_CHARSET         =222
const EASTEUROPE_CHARSET   =238
const RUSSIAN_CHARSET      =204
const MAC_CHARSET         =77
const BALTIC_CHARSET         =186
const LF_FULLFACESIZE   =64
const LF_FACESIZE      =32
const RASTER_FONTTYPE   =0x001
const DEVICE_FONTTYPE   =0x002
const TRUETYPE_FONTTYPE   =0x004
type ENUMLOGFONTEX
   def elfLogFont:LOGFONT
   def elfFullName[LF_FULLFACESIZE]:istring
   def elfStyle[LF_FACESIZE]:istring
   def elfScript[LF_FACESIZE]:istring
endtype
declare "gdi32",EnumFontFamiliesExA(hdc:int,lpLogfont:LOGFONT,lpEnumFontFamExProc:uint,lParam:int,dwFlags:uint),int
'Template for the callback EnumFontFamiliesEx Calls..
declare EnumFontFamExProc(lpelfe:pointer /* ENUMLOGFONTEX 2000/XP Can be ENUMLOGFONTEXDV */,lpntme:pointer /*NEWTEXTMETRICEX*/,FontType:uint,lParam:int),int
'-----------------------------------------------------------------------------------------------------------------
autodefine "off"
def w1:window
openwindow w1,0,0,600,400,0,0,"",&hnd
control w1,@COMBOBOX,"",10,10,210,150,0x50800603|@vscroll|@CTCOMBOSORT,10
setfont w1,"Verdana",8,400,0,10
conComboLoadFonts(w1,10,1)
waituntil w1.hwnd=0
end
'-----------------------------------------------------------------------------------
sub hnd
def fn:string
def cx,cy:int
def tx,ty:int
   select @class
      case @idclosewindow
         closewindow w1
      case @idcontrol
         if @controlid=10
            if @notifycode=@CBNSELCHANGE
               setwindowcolor w1,rgb(255,255,255)
               fn=getstring(w1,10,getselected(w1,10))
               setfont w1,fn,50,400
               getclientsize w1,cx,cx,cx,cy
               gettextsize w1,fn,tx,ty
               move w1,(cx-tx)/2,(cy-ty)/2
               print w1,fn
            endif
         endif
   endselect
   return
endsub
end
'-----------------------------------------------------------------------------------
def lastff[LF_FULLFACESIZE]:istring
def lwin:window
def lcid:int
sub conComboLoadFonts(win:window,cid:int,justtruetype:int)
def hdc:int
def want:LOGFONT
   want.lfCharset=DEFAULT_CHARSET
   want.lfFaceName=""
   want.lfPitchAndFamily=0
   lastff=""
   lwin=win
   lcid=cid
   hdc=Gethdc(win)
   EnumFontFamiliesExA(hdc,want,&myfunc,justtruetype,0)
   releasehdc win,hdc
   return
endsub
'-----------------------------------------------------------------------------------
sub myfunc(lpelfe:ENUMLOGFONTEX,lpntme:pointer,FontType:uint,lParam:int),int
   if lParam
      if (FontType&TRUETYPE_FONTTYPE)=0
         return 1
      endif
   endif
   if lpelfe.elfFullName<>lastff
      addstring lwin,lcid,lpelfe.elfFullName
      lastff=lpelfe.elfFullName
   endif
   return 1
endsub