FB II Compiler

PG PRO

Debugging

Memory

System

Mathematics

Resources

Disk I/O

Windows

Controls

Menus

Mouse

Keyboard

Text

Fonts

Drawing

Sound

Clipboard

Printing

Communication

ASM

Made with FB

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