home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 576-600 / apd600 / ldos_demo / examples / font_proc.amos / font_proc.amosSourceCode
AMOS Source Code  |  1994-02-02  |  1KB  |  55 lines
  1. ' Use Lword to simplify font-searching. Use can this procedure in your 
  2. ' own programs.
  3. Screen Open 1,640,256,8,Hires : Paper 6 : Cls 
  4. Do 
  5.    Input "Font:";N$
  6.    Input "Size:";A
  7.    Cls 6 : Home 
  8.    If N$=""
  9.       End 
  10.    End If 
  11.    _SETFONT[N$,A]
  12.    If Param
  13.       Print "Font set!"
  14.    Else 
  15.       Print "Font not available"
  16.    End If 
  17.    Text 10,150,"The quick brown fox jumps over the lazy dog"
  18. Loop 
  19. Procedure _SETFONT[NAME$,SIZE]
  20.    ' You may call this procedure either with or without '.font' 
  21.    ' included in the fontname. If the font first isn't found in 
  22.    ' RAM (or ROM as AMOS sees it) it (tries to) load it from disk 
  23.    ' and do another scan. If the font still isn't available Param 
  24.    ' will be FALSE. The loading from disk is done by Ldisk font so
  25.    ' the user hardly notices any delay. 
  26.    ' IF the font is found, Param will be true and the font set to the 
  27.    ' current using Set Font.
  28.    '
  29.    NAME$=Upper$(NAME$)
  30.    If Right$(NAME$,5)<>".FONT"
  31.       NAME$=NAME$+".FONT"
  32.    End If 
  33.    TIMES=1
  34.    _TRY_AGAIN:
  35.    Get Rom Fonts : A=1
  36.    While Font$(A)<>""
  37.       F$=Upper$( Extension_10_0520(1,Font$(A)))
  38.       S=Val( Extension_10_0520(2,Font$(A)))
  39.       If F$=NAME$ and SIZE=S
  40.          FOUND=True
  41.          Exit 1
  42.       End If 
  43.       Inc A
  44.    Wend 
  45.    If FOUND
  46.       Set Font A
  47.       Goto UT
  48.    End If 
  49.    If TIMES<>2
  50.       L= Extension_10_0326(NAME$,SIZE)
  51.       Inc TIMES
  52.       Goto _TRY_AGAIN
  53.    End If 
  54.    UT:
  55. End Proc[FOUND]