home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 25 / CD_ASCQ_25_1095.iso / dos / prg / fntpak32 / pascal.exe / DEMOFNT2.PAS < prev    next >
Pascal/Delphi Source File  |  1995-08-16  |  7KB  |  188 lines
  1. {*************************************************************************
  2.  
  3.   DemoFnt2.Pas                          Copyright 1994, Rob W. Smetana
  4.  
  5.   REGISTERED users:  UN-REM the first "Uses" statement below.
  6.  
  7.   SHAREWARE users:   UN-REM one of the "uses" statements you'll see
  8.                      below under "SHAREWARE."
  9.  
  10.   Demonstrate:
  11.  
  12.      1. Using GetMonitor (in Video.OBJ) to see if we're using EGA/VGA.
  13.  
  14.      2. How easy it is to load Font Pak fonts FROM DISK.
  15.  
  16.      3. Using other font-management procedures:  rsWhichFonts & rsLoadDefault.
  17.  
  18.      4. Using Font_Pak.Pas to declare all Font Pak routines -- except
  19.         callable OBJ fonts.
  20.  
  21.   USES  Ondisk_P.TPU which contains:
  22.  
  23.         Function LoadFontFile (FontFile : String; Block : Integer): Integer;
  24.  
  25.   REQUIRES:
  26.  
  27.       A Font Pak font file on disk (path and file name MUST be correct!)
  28.  
  29.       OnDisk_P.Pas // OnDisk_P.TPU  which contains function LoadFontFile
  30.  
  31.       Fonts.Obj     a set of font-related ASM routines.
  32.  
  33. *************************************************************************** }
  34.  
  35. {REGISTERED users:  use the next line.}
  36.  
  37. (*Uses Crt, DOS, Font_Pak, Ondisk_P;  {Unit Font_Pak declares everything} *)
  38.  
  39.  
  40. {SHAREWARE users:  un-rem ONE of the next lines.}
  41.  
  42. (*Uses Crt, DOS, Font_Pak, Ondisk_7;    { for TP 7.x }  *)
  43. (*Uses Crt, DOS, Font_Pak, Ondisk_6;    { for TP 6.x }  *)
  44.  
  45.  
  46. Var
  47.    Ch : Char;
  48.    ErrorCode, Block: Integer;    {load font into the block you specify (0-7)}
  49.    WhichSize: Integer;           {to restore the Default Font; must be 16 or 14.}
  50.    FontFile : String;            {be sure to include drive/directory if needed}
  51.  
  52.    WhichMonitor: Integer;        {for GetMonitor}
  53.  
  54.  
  55.  
  56. function fileExists (var s:string): boolean;
  57.  
  58. {************************************ Does the font file exist?  Thanks    }
  59. {to Sean Palmer for this function.  Requires DOS, which OnDisk also needs. }
  60.  
  61.   begin
  62.      fileExists:=fSearch(s,'')<>'';
  63.   end;
  64.  
  65.  
  66. Procedure Is_it_EGA_or_VGA;
  67. {************************************ Demonstrate GetMonitor          }
  68. {                                     Bail out if not EGA or VGA      }
  69.  
  70. Begin
  71.  
  72.      TextAttr := 23; ClrScr;
  73.  
  74.      fpInitialize; ClrScr;      { useful for shareware versions only }
  75.  
  76.      Write (' GetMonitor reports you have ');
  77.  
  78.      WhichMonitor := GetMonitor;
  79.  
  80.      { bail out if there's no EGA or VGA }
  81.      case WhichMonitor of
  82.           0, 4, 5:              { 0=No monitor, 4 = CGA, 5 = Monochrome }
  83.              Begin
  84.                  ClrScr;
  85.                  WriteLn('     This demo requires an EGA or VGA monitor.  Sorry, I have to end.');
  86.                  halt;
  87.              end;
  88.           3: Begin
  89.                 Write ('an EGA');
  90.                 WhichSize := 14;
  91.              end;
  92.  
  93.         7,8: Begin
  94.                 Write ('a VGA');
  95.                 WhichSize := 16;
  96.              end;
  97.      end; {case}
  98.  
  99.      Write (' monitor.   OK to proceed.  Press <SPACE>.');
  100.      Ch := ReadKey;
  101. End;
  102.  
  103. Procedure DisplayText;       { Put some text on the screen }
  104.  
  105. Begin
  106.    Writeln('');
  107.    Writeln('');
  108.    Writeln('  ┌─░░░░░░░░░▒▒▒▒▒▒▒▒▒▒▒▓▓▓▓▓▓▓▓▓▓▓ FONT DEMO ▓▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒▒▒░░░░░░░░─┐ ');
  109.    Writeln(' ░│ We''ll display this once.  Then, as we call different fonts, the appear-  │ ');
  110.    Writeln(' ░│ ance changes.  Note that we''re using partial fonts to re-map just some   │ ');
  111.    Writeln(' ░│ characters.  This lets us load different subsets of fonts, then change   │ ');
  112.    Writeln(' ░│ them whenever we want (without disturbing other subsets).                │ ');
  113.    Writeln(' ░│                                           ╒═══════╕   ╔══╦═══╗    ╓───╖  │ ');
  114.    Writeln(' ░│ ┌──────┼─────┐ ╔══════╦═══════╗     ╒═════╧═════╕ │   ║ ─╫───╫────╜   ║  │ ');
  115.    Writeln(' ░│ └──────┼─────┘ ╚═══════════╬══╝ ║   ╘═════╪═════╛     ║  ╙───╫────────╜  │ ');
  116.    Writeln(' ░│        │                   ╚════╝         ╘═════════  ╙──────╜           │ ');
  117.    Writeln(' ░└──────────────────────────────────────────────────────────────────────────┘ ');
  118.    Writeln(' ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░   ');
  119. end;
  120.  
  121.  
  122. Begin
  123.  
  124.    
  125.    TextAttr := 30; ClrScr;       {start with a clear screen}
  126.  
  127.    {============================= Edit to try different fonts           }
  128.  
  129.    FontFile := 'Script_3.F16';   {You MUST include the path AND extension!}
  130.  
  131.    {============================= Does FontFile exist?                    }
  132.    If not fileExists(FontFile) then
  133.       begin
  134.          Writeln('');
  135.          Writeln('File not found: ', FontFile );
  136.          Writeln('');
  137.          Writeln('Press a key, then check the spelling and drive/directory in "FontFile".' );
  138.          Ch := ReadKey;  Halt;
  139.       end;
  140.  
  141.    Is_it_EGA_or_VGA;             {abort if there's no EGA/VGA}
  142.  
  143.    DisplayText;                  {put anything on the screen}
  144.  
  145.    GotoXY(12,22);
  146.    Write(' Here''s the default font.  Press <Space> to change fonts.');
  147.    Ch := ReadKey;
  148.  
  149.  
  150.    Block := 0;                   {remap the default font; use block 0 exclusively   }
  151.                                  {NOTE:  If you use block 1-7, lines will disappear!}
  152.                                  {That's because we're loading partial fonts        }
  153.                                  {which DON'T have line draw characters.            }
  154.  
  155.    ErrorCode := LoadFontFile (FontFile, Block);
  156.  
  157.    If ErrorCode <> 0 then
  158.       Begin
  159.          ClrScr;
  160.          WriteLn ('Error ', ErrorCode, ' occurred.  See source code to interpret this.');
  161.          Ch := ReadKey;
  162.          Exit;
  163.          { Possible error codes:
  164.             -99  Font file 'Signature' <> "FONT-P~F"  (file may not exist)
  165.             -88  SizeOfFile <1 (nothing in file) -OR- an I/O error occurred reading font
  166.             -77  FirstChar + NumberChars > 256  (error in header; re-save font)
  167.             -66  Not enough memory to allocate file-read buffer       }
  168.       End;
  169.  
  170.  
  171.    rsWhichFonts (Block, Block);    {not needed if you remap Block 0}
  172.  
  173.    GotoXY(10,22);
  174.    Write('Here''s your custom font.  Press <Space> to restore the default.');
  175.    Ch := ReadKey;
  176.  
  177.    {============================= WhichSize should be 14 (EGA) or 16 (VGA)}
  178.    {                              It was set when we checked monitor type.}
  179.  
  180.    {restore the default font}
  181.    rsLoadDefault (WhichSize, Block);
  182.  
  183.    GotoXY(10,22);
  184.    Write('               And back to normal.  Press <Space>.              ');
  185.    Ch := ReadKey;
  186.  
  187. End.
  188.