$include "windowssdk.inc"
$INCLUDE "commctrl.inc"

def want:LOGFONT
int InsertPosAt = 0
string LastDiff

type ENUMLOGFONTEX
   def elfLogFont:LOGFONT
   def elfFullName[LF_FULLFACESIZE]:istring
   def elfStyle[LF_FACESIZE]:istring
   def elfScript[LF_FACESIZE]:istring
endtype
declare EnumFontFamExProc(lpelfe:pointer /* ENUMLOGFONTEX 2000/XP Can be ENUMLOGFONTEXDV */,lpntme:pointer /*NEWTEXTMETRICEX*/,FontType:uint,lParam:int),int

autodefine "off"
def w1:window
const ListView2 = 500

openwindow w1,0,0,480,480,0,0,"Fonts and sizes",&hnd
CONTROL w1,@LISTVIEW,"",50,20,355,380,@BORDER|@LVSSHOWSELALWAYS|@LVSSORTASCENDING|@LVSREPORT|@LVSALIGNTOP|@VSCROLL,ListView2
		  SENDMESSAGE w1,LVM_SETEXTENDEDLISTVIEWSTYLE,0,LVS_EX_GRIDLINES|LVS_EX_FULLROWSELECT|LVS_EX_FLATSB|LBS_WANTKEYBOARDINPUT|LVS_EX_ONECLICKACTIVATE,ListView2
		  CONTROLCMD w1,ListView2,@LVINSERTCOLUMN,0,"Font"
		  CONTROLCMD w1,ListView2,@LVSETCOLWIDTH,0,255
		  CONTROLCMD w1,ListView2,@LVINSERTCOLUMN,1,"Size"
		  CONTROLCMD w1,ListView2,@LVSETCOLWIDTH,1,100
        SETFONT w1,"Arial",11,400,0,ListView2

conComboLoadFonts(w1,ListView2,1)

waituntil w1.hwnd=0
end
'-----------------------------------------------------------------------------------
sub hnd
def fn:string
def cx,cy:int
def tx,ty:int
   select @class
		case @IDCREATE			
				Centerwindow w1

      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  ',elfLogFont
            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

   want.lfCharset=DEFAULT_CHARSET
   want.lfFaceName=""
   want.lfPitchAndFamily=0
   want.lfWidth=0
   lastff=""
   lwin=win
   lcid=cid
   hdc=Gethdc(win)
   EnumFontFamiliesExA(hdc,want,&mySub,justtruetype,0)
   releasehdc win,hdc
   return
endsub

sub MySub(Mylf:logfont,lpntme:pointer,FontType:uint,lParam:int)
   if lParam
      if (FontType&TRUETYPE_FONTTYPE)=0
         return 1
      endif
   endif

   if Mylf.lfFaceName <> lastff
      if Mylf.lfFaceName = "Arial"
print Mylf.lfFaceName,"     ",Mylf.lfWidth
      endif
      lastDiff = Mylf.lfFaceName


		 'CONTROLCMD(w1,ListView2,@LVGETTEXT,ComboPos,0,text2)
		 int PositionZ = CONTROLCMD(lwin,lcid,@LVFINDITEM,Mylf.lfFaceName)
print "Pos = ",PositionZ
		 if PositionZ = -1
			InsertPosAt ++
			CONTROLCMD lwin,lcid,@LVINSERTITEM,InsertPosAt,Mylf.lfFaceName 
			'CONTROLCMD lwin,lcid,@LVSETTEXT,InsertPosAt,1,"10" '    ltrim$(str$(Mylf.lfWidth))
		 endif

int a
string text
					    int lvcount2 = CONTROLCMD(lwin,lcid,@LVGETCOUNT)
					    for a = 0 to lvcount2
							  CONTROLCMD(lwin,lcid,@LVGETTEXT,a,0,text)
							  if text = Mylf.lfFaceName
								  CONTROLCMD(lwin,lcid,@LVSETTEXT,a,1,ltrim$(str$(Mylf.lfWidth)))
								  breakfor
							  endif
					    next a 


   endif
return 1
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