home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / fonts / tpfont / fntdemo1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-02-01  |  5.2 KB  |  121 lines
  1.  
  2.                  (* ****************************** *)
  3.                  (*                                *)
  4.                  (*      NewFonts.pas Demo1        *)
  5.                  (*                                *)
  6.                  (*  This Demo Shows How to Use    *)
  7.                  (*  Font Files That Are Stored    *)
  8.                  (*  In Disk Files External To     *)
  9.                  (*  Your Program. That is, How    *)
  10.                  (*  To Transfer Them Into Your    *)
  11.                  (*  Program and Use Them.         *)
  12.                  (*                                *)
  13.                  (*  (c) Donald L. Pavia           *)
  14.                  (*  Department of Chemistry       *)
  15.                  (*  Western Washington University *)
  16.                  (*  Bellingham, WA   98225        *)
  17.                  (*                                *)
  18.                  (*               February 1, 1986 *)
  19.                  (*                                *)
  20.                  (* ****************************** *)
  21.  
  22. program FontDemo1;
  23.  
  24. type FontType = array[1..1024] of byte;   { required global variables for    }
  25.      str14 = string[14];                  { the UseFonts.Lib library         }
  26.  
  27. var  i,j,k,m : integer;
  28.      TempFonts : FontType;                { required global variable for Lib }
  29.      HiAscii   : FontType;                { var to store a loaded font set   }
  30.      ChemMath  : FontType;                {  "   "   "    "     "   "   "    }
  31.  
  32. {----------------------------------------------------------------------------}
  33. {$I UseFonts.Lib}                          { procedures to load font files   }
  34. {----------------------------------------------------------------------------}
  35.  
  36. {----------------------------------------------------------------------------}
  37. procedure ChemMathFonts;                   { A procedure of this type must   }
  38.                                            { be written for each fonttype    }
  39. begin                                      { variable. Trying to pass a      }
  40.      memw[$0000:$007E] := seg(ChemMath);   { structured variable to a single }
  41.      memw[$0000:$007C] := ofs(ChemMath);   { procedure did not work reliably }
  42.                                            { in earlier coding attempts.     }
  43. end; { procedure ChangeFont }              {      I don't know why.          }
  44. {----------------------------------------------------------------------------}
  45. procedure HiAsciiFonts;                    { procedure sets interrupt vector }
  46.                                            { (7C) to point to memory location}
  47. begin                                      { of new pel maps - calls to high }
  48.      memw[$0000:$007E] := seg(HiAscii);    { ascii nos 128 - 255 will use    }
  49.      memw[$0000:$007C] := ofs(HiAscii);    { the maps this vector points to  }
  50.  
  51. end; { procedure HiAscii }
  52. {----------------------------------------------------------------------------}
  53. BEGIN
  54.  
  55.      (* *********************** MED RES MODE *************************** *)
  56.  
  57.      GraphColorMode; GraphBackGround (1); Palette (0);
  58.  
  59.      LoadFontFile ('HI_ASCII.FNT');      { load a copy of high ascii }
  60.      {HiAsciiFonts := TempFonts;}        { and save them for reuse   }
  61.      move (TempFonts,HiAscii,1024);      { either method shown works }
  62.  
  63.      LoadFontFile ('CHEMMATH.FNT');      { load redefined char file  }
  64.      {ChemMathFonts := TempFonts;}       { and save in memory        }
  65.      move (TempFonts,ChemMath,1024);
  66.  
  67.      ChemMathFonts;                      {  use redefined characters }
  68.  
  69.      TextColor (1);
  70.      gotoxy (5,2);   write ('CH',#133,'CH',#132,'CO',#132,'H');
  71.      TextColor (2);
  72.      gotoxy (10,5);  write ('x',#143,' + y',#146,' = z',#142);
  73.      TextColor (3);
  74.      gotoxy (15,8);  write ('Na',#150,' HCO',#133,#151);
  75.  
  76.      HiAsciiFonts;                 { return to orig high ascii chars }
  77.  
  78.      TextColor (1); i := 11; m := 0;
  79.      for j := 1 to 4 do begin
  80.          gotoxy (1,i); for K := 0 to 35 do
  81.          if ((128+k+m) < 256) then write (chr(128 + k + m));
  82.          i := i + 2; m := m + 36;
  83.      end;
  84.  
  85.      ChemMathFonts;                     { redefined characters again }
  86.  
  87.      TextColor (3);
  88.      gotoxy (5,20); write ('CH',#133,'CH',#132,'(CH',#132,')',#138,'COOH');
  89.      TextColor (2);
  90.      gotoxy (10,22); write ('x',#142,' + y',#142,' = a',#143,' x b',#144);
  91.  
  92.      TextColor (1);
  93.      gotoxy (25,25); write ('Press Enter');
  94.      readln;
  95.  
  96.      (* ************************ HI RES MODE *************************** *)
  97.  
  98.      HiRes; HiResColor (1);                  { still redefined fonts }
  99.  
  100.      gotoxy (1,7); write ('CH',#133,'CH',#132,'(CH',#132,')',#138,'COOH');
  101.  
  102.      HiAsciiFonts;                             { regular fonts again }
  103.  
  104.      i := 12; m := 0;
  105.      for j := 1 to 2 do begin
  106.           gotoxy (1,i); for k := 0 to 71 do
  107.           if ((128+k+m) < 256) then write (chr(128+k+m));
  108.           i := i + 2; M := m + 72;
  109.      end;
  110.  
  111.      ChemMathFonts;                                { redefined fonts }
  112.  
  113.      gotoxy (25,20); write ('x',#142,' + y',#142,' = a',#143,' x b',#144);
  114.  
  115.      HiAsciiFonts;                             { regular fonts again }
  116.  
  117.      gotoxy (50,25); write ('Press <ENTER> to Continue');
  118.      readln; TextMode (c80);
  119. END.
  120.  
  121.