home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / bmag / custfont.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-26  |  1.9 KB  |  57 lines
  1. '─ Area: F-QUICKBASIC ─────────────────────────────────────────────────────────
  2. '  Msg#: 307                                          Date: 16 Apr 94  23:50:02
  3. '  From: Steve Demo                                   Read: Yes    Replied: No 
  4. '    To: Chris Walker                                 Mark:                     
  5. '  Subj: Custom Fonts Free Code!
  6. '──────────────────────────────────────────────────────────────────────────────
  7.  CW>         I am currently in the process of writing a graphical terminal 
  8.  CW>         Each screen mode (2,3,4,8,10,11,12) has it's own character 
  9.  
  10. DEFINT A-Z 
  11. '**Please Note xx & yy are opposite of what you might expect 
  12. DECLARE SUB ColorPrint (xx, yy, clur, a$, Array()) 
  13. SCREEN 13 
  14. RANDOMIZE TIMER 
  15. DIM Array(20736) 
  16. FOR Letter = 0 TO 255 
  17.  LOCATE 1, 1 
  18.  PRINT CHR$(Letter) 
  19.  FOR x = 0 TO 8            'load the Char Set into an Array 
  20.   FOR y = 0 TO 8 
  21.     Counter = Counter + 1 
  22.     Array(Counter) = POINT(x, y) 
  23.    NEXT: NEXT 
  24. NEXT Letter                ' end loading 
  25. PAINT (1, 1), 82 
  26. FOR x = 1 TO 50            ' Draw some junk 
  27.    C1 = INT(RND * 295) + 1 
  28.    C2 = INT(RND * 165) + 1 
  29.    C3 = INT(RND * 20) 
  30.    C4 = INT(RND * 100) + 1 
  31.    CIRCLE (C1, C2), C3, C4 
  32.    PAINT (C1, C2), C4, C4 
  33. NEXT                       'end drawing 
  34. ' ****************** Test routine *********************** 
  35.  
  36. ColorPrint 20, 20, 12, "Hello My Name is Steve Demo", Array() 
  37. ColorPrint 20, 50, 1, "Don't you Think this is Cool!", Array() 
  38. ColorPrint 20, 80, 9, "Well get busy codeing already Dude!", Array() 
  39. ColorPrint 20, 100, 190, "1234567890" + CHR$(184), Array() 
  40.  
  41. ' I guess it works 
  42. ' Steve Demo 
  43.  
  44.  
  45. SUB ColorPrint (xx, yy, clur, a$, Array()) 
  46. FOR WordList = 1 TO LEN(a$) 
  47.  kt = (ASC(MID$(a$, WordList, 1))) * 81 
  48.  FOR xt = 0 TO 8 
  49.   FOR yt = 0 TO 8 
  50.    kt = kt + 1 
  51.    IF Array(kt) <> 0 THEN PSET (xt + xx + NxtLtr, yt + yy), clur 
  52.   NEXT: NEXT 
  53.  kt = 0 
  54.  NxtLtr = NxtLtr + 8 
  55. NEXT WordList 
  56. END SUB 
  57.