home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 5 / FreshFish_July-August1994.bin / bbs / dev / ace-2.0.lha / ACE-2.0 / include / font.h < prev    next >
Encoding:
Text File  |  1994-01-13  |  1.1 KB  |  49 lines
  1. { change font for the current window/screen. }
  2.          
  3. SUB FontSet(FontName$,FontHeight%)
  4. dim tAttr&(2)
  5.  
  6. DECLARE FUNCTION OpenDiskFont& LIBRARY diskfont
  7. DECLARE FUNCTION CloseFont LIBRARY graphics
  8. DECLARE FUNCTION OpenFont& LIBRARY graphics
  9. DECLARE FUNCTION SetFont LIBRARY graphics
  10.  
  11. CONST Font=52
  12. CONST TxWidth=60
  13.  
  14. LIBRARY diskfont
  15. LIBRARY graphics
  16.  
  17.   f.old&     = *&(WINDOW(8)+Font)
  18.   f.pref%    = 0
  19.   FontName0$ = FontName$ + ".font"
  20.   tAttr&(0)  = SADD(FontName0$)
  21.   tAttr&(1)  = FontHeight%*2^16 + f.pref%
  22.   f.new&     = OpenFont&(@tAttr&)  '..ROM font?
  23.   f.check%   = *%(WINDOW(8)+TxWidth)
  24.   
  25.   '..disk font -> open it
  26.   IF f.new& = 0& THEN
  27.     f.new& = OpenDiskFont&(@tAttr&)
  28.   ELSE
  29.    IF f.check% <> FontHeight% THEN
  30.     CloseFont(f.new&)
  31.     f.new& = OpenDiskFont&(@tAttr&)
  32.    END IF
  33.   END IF
  34.   
  35.   '..font OK -> set it for current rastport.
  36.   IF f.new& <> 0& THEN
  37.     CloseFont(f.old&)
  38.     SetFont(WINDOW(8),f.new&)
  39.   ELSE
  40.     IF UCASE$(FontName$) = "UNDO" THEN
  41.       CloseFont(f.old&)
  42.       SetFont(WINDOW(8),original&)
  43.     END IF
  44.   END IF
  45.  
  46.   LIBRARY CLOSE graphics
  47.   LIBRARY CLOSE diskfont
  48. END SUB
  49.