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.
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