home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / FNTPAK32.ZIP / BASIC.EXE / DEMOFNT2.BAS < prev    next >
BASIC Source File  |  1995-08-16  |  3KB  |  84 lines
  1. DEFINT A-Z
  2.  
  3. '$INCLUDE: 'Font_Pak.Inc'           '... For QB/PDS/VB-DOS
  4.  
  5. '======================================================== PowerBasic Users
  6. ''$INCLUDE "Font_Pak.Inc"             '... PB users, UN-REM these lines
  7.  
  8. ''$Link    "ONDISK.PBU"               '... Compile Ondisk.Bas if needed
  9.  
  10. ''$Link    "FontPakP.OBJ"             '... SHAREWARE users
  11.  
  12. ''$Link    "Video.OBJ"                '... REGISTERED users
  13. ''$Link    "Fonts.OBJ"                '... REGISTERED users
  14.  
  15. '======================================================== PowerBasic Users
  16.  
  17. '============================================================ DemoFnt2.Bas
  18. '
  19. ' A Font Pak Demonstration         Copyright 1991-1994 Rob W. Smetana
  20. '
  21. ' Demonstrates how to load Font Pak fonts from disk.  Note how simple it is!
  22. '
  23. ' Requires:  - A valid Font Pak font file.  See "FontFile$ =..." below.
  24. '
  25. '            - One of our OnDisk_? modules.
  26. '
  27. '            - Font_Pak.Lib (Microsoft BASICs) or Font_Pak.Pbl (PowerBasic)
  28. '
  29. ' Note how we check error codes below.  You SHOULD use a File Exist
  30. ' function before you try to load fonts from disk.  This helps ensure
  31. ' that an open drive door (which we can't trap for you) doesn't bring
  32. ' your program to its knees.
  33. '============================================================ DemoFnt2.Bas
  34.  
  35.  
  36.  
  37.     SCREEN 0, 0         '...Useful to ensure QB/QBX/VBDOS restore default
  38.     COLOR 7, 1: CLS
  39.  
  40.     CALL fpInitialize: CLS        '=== SHAREWARE versions ONLY
  41.  
  42.     FontFile$ = "BigSanSr.F16"
  43.  
  44.     Block = 1           '...load font into block 1; leave default font intact!
  45.  
  46.     ErrorCode = LoadFontFile(FontFile$, Block%)
  47.  
  48.     IF ErrorCode THEN
  49.  
  50.        CLS
  51.        PRINT "Sorry, error "; ErrorCode; "occurred.  Check source code to interpret this."
  52.        d$ = INPUT$(1)
  53.        END
  54.  
  55.        'Possible Error Codes:
  56.  
  57.         ' -99  file's signature <> "FONT-P~F" (could mean file didn't exist)
  58.         ' -88  Size of file < 1 (it had no font bitmap data; re-save font)
  59.         ' -77  FirstChar + NumberChars > 256 (error in font file; re-save it)
  60.         ' -66  Too little memory to allocate buffer and read font data
  61.  
  62.     END IF
  63.  
  64.  
  65.     FILES "*.*"                             '...put something on the screen
  66.  
  67.     COLOR 0, 7
  68.     LOCATE 25, 23: PRINT " Here's your NORMAL font.  Press a key.";
  69.     d$ = INPUT$(1)
  70.  
  71.     CALL rsWhichFonts(Block, Block)         '...select block 1 exclusively
  72.  
  73.     LOCATE 25, 23: PRINT " Here's your CUSTOM font.  Press a key.";
  74.     d$ = INPUT$(1)
  75.  
  76.     CALL rsWhichFonts(0, 0)                 '...restore default in block 0
  77.  
  78.     LOCATE 25, 21: PRINT " And back to your NORMAL font.  Press a key.";
  79.     d$ = INPUT$(1)
  80.     COLOR 7, 0
  81.  
  82. END
  83.  
  84.