TEXT
Display all available fonts in an Edit Field
If you have an "empty" (no items) menu titled "Font" in a menu resource, the following code will display the system fonts in an edit field:
RESOURCES "app.rsrc" 'Contains menu resource
COMPILE 0, _caseInsensitive 'with "empty" menu titled "Font".
LOCAL FN displayFonts
teHndl&=TEHANDLE(1)
fontHndl&=FN GETMHANDLE(20)
FOR item% = 1 TO FN COUNTMITEMS(fontHndl&)
CALL GETITEM(fontHndl&,item%,title$)
length%=LEN(title$)
CALL TEINSERT(@title$+1,length%,teHndl&) 'Inserts font name
CALL TEKEY(13,teHndl&) 'followed by carriage return.
NEXT
END FN
LOCAL FN buildWnd
WINDOW#1,"Font Display.Demo",(30,40)-(400,600)
EDIT FIELD#1,"",(40,30)-(230,470),_statframed,_centerJust'room for 40 fonts
MENU 20,_resSubMenu,1,"FONT" 'Font menuID
END FN
FN buildWnd
FN displayFonts
DO
HANDLEEVENTS
UNTIL FN STILLDOWN 'mouse down to quit
Steve Van Voorst
This is a "brute force" method... you'd do better by counting the available "FOND" resources and getting their id's one at a time, the using that id instead of the "i%" below;
EDIT FIELD -1,"Fonts",(14,52)-(495,297),_statFramed,_leftJust
hdl& = TEHANDLE(WINDOW(_efNum))
LONG IF hdl&
BLOCKMOVE [hdl&],@rect,8
FOR i% = 0 TO 32766
CALL GETFONTNAME(i%,fntNm$)
LONG IF fntNm$ <> ""
TEXT i%,12
fntNm$ = fntNm$ + CHR$(13)
CALL TESETSELECT(32767,32767,hdl&)
CALL TEINSERT(@fntNm$+1,LEN(fntNm$),hdl&)
END IF
NEXT temp%
TEKEY$ = CHR$(13)
CALL TESETSELECT(0,32767,hdl&)
AUTOCLIP = _false
CALL TEUPDATE(rect,hdl&)
AUTOCLIP = _true
CALL TEAUTOVIEW(_zTrue,hdl&)
END IF
Note: I did _not_ compile and test this... it may not work "as written", so be careful...
Bill