'Enumerate fonts - compile as window

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 IMPORT,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

STRING fn
INT cx,cy,tx,ty
WINDOW w1

autodefine "off"

OPENWINDOW w1,0,0,640,480,0,0,"Font Enumerator",&main
	CONTROL w1,@COMBOBOX,"",10,10,210,150,0x50800603|@VSCROLL|@CTCOMBOSORT,10
	SETFONT w1,"Verdana",8,400,0,10

conComboLoadFonts(w1,10,1)
	SETSELECTED w1,10,0
	GetFont()
	SETFOCUS w1,10

SUB main
	SELECT @CLASS
CASE @IDCREATE
	CENTERWINDOW w1
CASE @idclosewindow
         closewindow w1
CASE @idcontrol
if @controlid=10
if @notifycode=@CBNSELCHANGE
	setwindowcolor w1,rgb(255,255,255)
	GetFont()
endif:endif
endselect
endsub

WAITUNTIL w1.hwnd=0
	END

SUB GetFont
	fn=getstring(w1,10,getselected(w1,10))
	setfont w1,fn,42,400
	getclientsize w1,cx,cx,cx,cy
	gettextsize w1,fn,tx,ty
	move w1,(cx-tx)/2,(cy-ty)/2
	print w1,fn
ENDSUB

ISTRING lastff[LF_FULLFACESIZE]
WINDOW lwin
INT lcid,count

SUB conComboLoadFonts(win:window,cid:int,justtruetype:int)
	INT hdc
	DEF want:LOGFONT
	want.lfCharset=DEFAULT_CHARSET
	want.lfFaceName=""
	want.lfPitchAndFamily=0
	lastff[0]=NULL
	lwin=win
	lcid=cid
	hdc=Gethdc(win)
	EnumFontFamiliesExA(hdc,want,&myfunc,justtruetype,0)
	RELEASEHDC win,hdc
ENDSUB

SUB myfunc(lpelfe:ENUMLOGFONTEX,lpntme:pointer,FontType:uint,lParam:int),int
if lParam
if (FontType&RASTER_FONTTYPE|DEVICE_FONTTYPE|TRUETYPE_FONTTYPE)=0
return 1
endif:endif
if lpelfe.elfFullName<>lastff
	addstring lwin,lcid,lpelfe.elfFullName
	lastff=lpelfe.elfFullName
endif
	count=0
	count=GETSTRINGCOUNT(w1,10)
IF count>0
	SETCAPTION w1,"Font Enumerator [All Fonts:"+STR$(count)+"]"
ELSE
	SETCAPTION w1,"Font Enumerator"
ENDIF
return 1
endsub