home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / fonts / tpfont / fntdemo4.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-02-08  |  11.7 KB  |  273 lines
  1.  
  2.  
  3.    (* ***************************************************************** *)
  4.    (*                                                                   *)
  5.    (*                    NewFonts.Pas  Demo4                            *)
  6.    (*                                                                   *)
  7.    (*     This program writes same screen as the previous one, except   *)
  8.    (*  this version of it shows how to write a procedure that avoids    *)
  9.    (*  having to call all the redesigned ascii fonts by  NUMBER.  The   *)
  10.    (*  relevant procedure is called WriteString. Using WriteString,     *)
  11.    (*  one simply types a statement similar in form to the Pascal write *)
  12.    (*  statement, however, WriteString takes two additional parameters  *)
  13.    (*  which locate the cursor prior to writing the translated string.  *)
  14.    (*  Following the first screen, a second screen of chemistry and     *)
  15.    (*  math symbols is drawn. When using the procedure WriteString,     *)
  16.    (*  no checks on the length of the string are made, it is up to      *)
  17.    (*  the programmer to avoid writing beyond the edge of the screen.   *)
  18.    (*                                                                   *)
  19.    (*                                        (c) Donald L. Pavia        *)
  20.    (*                                        Department of Chemistry    *)
  21.    (*        FONTDEMO4.PAS                   Western Washington Univ.   *)
  22.    (*                                        Bellingham, WA. 98225      *)
  23.    (*                                                                   *)
  24.    (*                                             February  1986        *)
  25.    (*                                                                   *)
  26.    (* ***************************************************************** *)
  27.  
  28. program FontDemo4;
  29.  
  30. {----------------------------------------------------------------------------}
  31. const FrameFonts : array[1..80] of byte =
  32.    ( 127,64,95,81,93,69,125,1,223,80,87,85,93,65,127,0,
  33.      253,5,117,85,93,65,127,0,255,1,125,69,93,81,95,64,
  34.      127,64,95,81,93,69,125,1,127,1,125,69,93,81,95,64,
  35.      127,64,95,81,93,69,125,0,127,65,93,85,87,80,223,0,
  36.      127,65,93,85,117,5,253,0,127,1,125,69,93,81,223,0 );
  37. {----------------------------------------------------------------------------}
  38. const ShadowFonts : array[1..208] of byte =
  39.    ( 254,82,82,94,82,82,243,0,254,82,82,94,82,82,254,0,
  40.      254,162,160,160,160,162,254,0,254,82,82,82,82,82,254,0,
  41.      254,82,80,92,80,82,254,0,254,82,80,92,80,80,248,0,
  42.      254,162,160,174,162,162,254,0,243,82,82,94,82,82,243,0,
  43.      124,40,40,40,40,40,124,0,127,20,20,20,20,148,252,0,
  44.      243,82,86,92,94,82,243,0,248,80,80,80,82,86,254,0,
  45.      231,166,182,190,170,162,227,0,231,162,178,186,174,166,227,0,
  46.      254,162,162,162,162,162,254,0,254,82,82,94,80,80,248,0,
  47.      254,162,162,162,162,174,254,7,254,82,82,92,82,82,243,0,
  48.      254,162,160,254,10,138,254,0,254,170,40,40,40,40,124,0,
  49.      242,82,82,82,82,82,127,0,238,164,164,164,172,120,16,0,
  50.      227,170,170,190,182,162,227,0,198,106,52,40,88,172,198,0,
  51.      206,74,74,122,10,74,126,0,254,138,20,40,80,162,254,0 );
  52. {----------------------------------------------------------------------------}
  53. const RomanFonts : array[1..208] of byte =
  54.    ( 24,60,66,66,126,66,66,0,252,66,66,124,66,66,252,0,
  55.      60,66,64,64,64,66,60,0,252,66,66,66,66,66,252,0,
  56.      254,66,64,120,64,66,254,0,254,66,64,120,64,64,224,0,
  57.      60,66,64,78,66,66,60,0,66,66,66,126,66,66,66,0,
  58.      62,8,8,8,8,8,62,0,14,4,4,4,4,68,56,0,
  59.      198,68,72,112,72,68,198,0,224,64,64,64,66,70,254,0,
  60.      99,119,93,73,65,65,65,0,195,98,114,90,78,70,194,0,
  61.      60,66,66,66,66,66,60,0,252,66,66,124,64,64,240,0,
  62.      60,66,66,66,66,74,60,2,252,66,66,124,66,66,231,0,
  63.      126,66,64,126,2,66,126,0,254,146,16,16,16,16,56,0,
  64.      66,66,66,66,66,66,60,0,66,66,66,66,66,60,24,0,
  65.      65,65,65,73,93,119,99,0,66,66,36,24,24,36,66,0,
  66.      198,68,68,56,16,16,56,0,126,66,4,8,16,34,126,0 );
  67. {----------------------------------------------------------------------------}
  68. const FatFonts : array[1..208] of byte =
  69.    ( 16,56,108,108,254,238,238,0,252,246,246,252,246,246,252,0,
  70.      62,118,246,240,246,118,62,0,252,254,246,246,246,254,252,0,
  71.      254,254,240,252,240,254,254,0,254,254,240,252,240,240,240,0,
  72.      62,126,224,238,226,126,62,0,230,230,254,254,254,230,230,0,
  73.      60,60,60,60,60,60,60,0,30,30,30,222,222,254,124,0,
  74.      230,236,248,240,248,236,230,0,240,240,240,240,240,254,254,0,
  75.      226,246,234,226,226,226,226,0,230,230,246,254,238,230,230,0,
  76.      124,246,246,246,246,246,124,0,252,254,226,254,252,240,240,0,
  77.      124,246,246,246,246,246,126,3,252,254,226,254,252,246,243,0,
  78.      126,254,240,120,30,254,252,0,255,255,60,60,60,60,60,0,
  79.      238,238,238,238,238,254,124,0,238,238,108,124,56,56,16,0,
  80.      226,226,226,226,234,246,230,0,198,238,124,56,124,238,198,0,
  81.      198,238,124,56,56,56,56,0,254,254,252,24,62,126,254,0 );
  82. {----------------------------------------------------------------------------}
  83. const SmallFonts : array[1..208] of byte =
  84.    ( 0,56,68,124,68,68,0,0,0,124,68,124,68,124,0,0,
  85.      0,124,64,64,64,124,0,0,0,120,68,68,68,120,0,0,
  86.      0,124,64,120,64,124,0,0,0,124,64,120,64,64,0,0,
  87.      0,124,64,92,68,124,0,0,0,68,68,124,68,68,0,0,
  88.      0,56,16,16,16,56,0,0,0,4,4,4,68,124,0,0,
  89.      0,68,72,112,88,68,0,0,0,64,64,64,64,124,0,0,
  90.      0,66,102,90,66,66,0,0,0,68,100,84,76,68,0,0,
  91.      0,56,68,68,68,56,0,0,0,124,68,124,64,64,0,0,
  92.      0,56,68,68,84,60,4,0,0,124,68,120,76,68,0,0,
  93.      0,124,64,124,4,124,0,0,0,124,16,16,16,16,0,0,
  94.      0,68,68,68,68,56,0,0,0,68,68,40,16,16,0,0,
  95.      0,66,66,90,102,66,0,0,0,68,40,16,40,68,0,0,
  96.      0,68,40,16,16,16,0,0,0,124,8,16,32,124,0,0 );
  97. {----------------------------------------------------------------------------}
  98. const ChemFonts : array[1..288] of byte =
  99.    ( 0,0,0,0,0,0,255,255,8,4,254,0,254,64,32,0,
  100.      0,0,120,204,204,204,204,120,0,0,48,112,48,48,48,120,
  101.      0,0,120,204,24,96,192,252,0,0,120,204,24,12,204,120,
  102.      0,0,60,108,204,254,12,12,0,0,248,192,248,12,12,248,
  103.      0,0,120,128,248,204,204,120,0,0,248,24,48,48,96,96,
  104.      0,0,120,204,120,204,204,120,0,0,120,204,204,124,24,112,
  105.      96,144,144,144,96,0,0,0,32,96,32,32,32,0,0,0,
  106.      112,152,48,96,248,0,0,0,112,152,48,152,112,0,0,0,
  107.      48,80,144,248,16,0,0,0,240,128,224,16,224,0,0,0,
  108.      96,128,224,144,96,0,0,0,240,16,32,64,128,0,0,0,
  109.      96,144,96,144,96,0,0,0,96,144,112,16,96,0,0,0,
  110.      32,32,248,32,32,0,0,0,0,0,240,0,0,0,0,0,
  111.      0,0,0,60,6,62,102,59,0,0,96,32,60,38,38,92,
  112.      0,118,220,0,118,220,0,0,16,16,16,16,16,16,16,0,
  113.      72,72,72,72,72,72,72,0,252,0,0,252,0,0,252,0,
  114.      128,64,32,16,8,4,2,1,1,2,4,8,16,32,64,128,
  115.      0,0,0,204,204,0,0,0,255,255,0,0,0,0,0,0,
  116.      32,112,248,248,0,0,0,0,0,255,255,255,255,255,255,0 );
  117. {----------------------------------------------------------------------------}
  118. procedure UseFrameFonts;
  119.  
  120. begin
  121.  memw[$0000:$007E] := seg(FrameFonts); memw[$0000:$007C] := ofs(FrameFonts);
  122.  
  123. end; { procedure UseFrameFonts }
  124. {----------------------------------------------------------------------------}
  125. procedure UseShadowFonts;
  126.  
  127. begin
  128.  memw[$0000:$007E] := seg(ShadowFonts); memw[$0000:$007C] := ofs(ShadowFonts);
  129.  
  130. end; { procedure UseShadowFonts }
  131. {----------------------------------------------------------------------------}
  132. procedure UseRomanFonts;
  133.  
  134. begin
  135.  memw[$0000:$007E] := seg(RomanFonts); memw[$0000:$007C] := ofs(RomanFonts);
  136.  
  137. end; { procedure UseRomanFonts }
  138. {----------------------------------------------------------------------------}
  139. procedure UseFatFonts;
  140.  
  141. begin
  142.  memw[$0000:$007E] := seg(FatFonts); memw[$0000:$007C] := ofs(FatFonts);
  143.  
  144. end; { procedure UseFatFonts }
  145. {----------------------------------------------------------------------------}
  146. procedure UseSmallFonts;
  147.  
  148. begin
  149.  memw[$0000:$007E] := seg(SmallFonts); memw[$0000:$007C] := ofs(SmallFonts);
  150.  
  151. end; { procedure UseSmallFonts }
  152. {----------------------------------------------------------------------------}
  153. procedure UseChemFonts;
  154.  
  155. begin
  156.  memw[$0000:$007E] := seg(ChemFonts); memw[$0000:$007C] := ofs(ChemFonts);
  157.  
  158. end; { procedure UseChemFonts }
  159. {----------------------------------------------------------------------------}
  160.  
  161. type  str80 = string[80];
  162. var   q : integer; Wait : char;
  163.  
  164. {----------------------------------------------------------------------------}
  165. procedure WriteString (xpos,ypos : integer; Strg : str80);
  166.  
  167. var  i,Len : integer; Character : char;
  168.  
  169. begin
  170.      Len := Length (Strg); gotoxy (xpos,ypos);
  171.      for i := 1 to Len do begin
  172.          if Strg[i] in ['A'..'Z'] then
  173.             Character := (chr (ord(Strg[i]) + 63))
  174.          else Character := Strg[i];
  175.          write (Character);
  176.      end;
  177.  
  178. end; { procedure WriteString }
  179. {----------------------------------------------------------------------------}
  180. procedure DrawFrameBorder;
  181.  
  182. begin
  183.       Draw (0,0,319,0,1);     Draw (319,0,319,199,1);
  184.       Draw (319,199,0,199,1); Draw (0,199,0,0,1);
  185.  
  186.       UseFrameFonts;
  187.  
  188.       TextColor (2);
  189.       gotoxy (2,2); write (#128);
  190.       for q := 3  to 19 do begin gotoxy (q,2); write (#129); end;
  191.       for q := 20 to 38 do begin gotoxy (q,2); write (#130); end;
  192.       gotoxy (39,2); write (#131);
  193.       for q := 3 to 23 do begin
  194.            gotoxy (2,q);  write (#132);
  195.            gotoxy (39,q); write (#133);
  196.       end;
  197.       gotoxy (2,24); write (#134);
  198.       for q := 3  to 19 do begin gotoxy (q,24); write (#135); end;
  199.       for q := 20 to 38 do begin gotoxy (q,24); write (#136); end;
  200.       gotoxy (39,24); write (#137);
  201.  
  202. end;  { procedure DrawFrameBorder }
  203. {----------------------------------------------------------------------------}
  204.  
  205. BEGIN
  206.       clrscr; GraphColorMode; GraphBackGround (1); Palette (2);
  207.       DrawFrameBorder;
  208.  
  209.       UseShadowFonts;
  210.  
  211.       TextColor (3);
  212.       WriteString (15,6,'TURBO PASCAL');
  213.  
  214.       UseRomanFonts;
  215.  
  216.       TextColor (1);
  217.       WriteString (10,9,'GRAPHICS FONT DESIGNER');
  218.  
  219.       UseFatFonts;
  220.  
  221.       TextColor (3);
  222.       WriteString (11,12,'PROGRAMMER''S UTILITY');
  223.  
  224.       { regular lo-ascii fonts }
  225.  
  226.       TextColor (1);
  227.       gotoxy (13,16);  write ('Donald L. Pavia');
  228.  
  229.       UseSmallFonts;
  230.  
  231.       TextColor (3);
  232.       WriteString (10,19,'DEPARTMENT OF CHEMISTRY');
  233.       WriteString (7,20,'WESTERN WASHINGTON UNIVERSITY');
  234.       WriteString (10,21,'BELLINGHAM  WASHINGTON');
  235.  
  236.       read (Kbd,Wait);
  237.       {--------------------------------------------------------------}
  238.  
  239.       GraphColorMode; GraphBackGround (1); Palette (2);
  240.  
  241.       UseChemFonts;
  242.  
  243.       TextColor (1);
  244.       gotoxy (5,5);   write ('CH',#133,'CH',#132,'CO',#132,'H');
  245.       TextColor (2);
  246.       gotoxy (20,5);  write ('K',#152,' = 3.62 x 10',#151,#148);
  247.       TextColor (3);
  248.       gotoxy (14,9);  write ('x',#142,' + y',#143,' = z',#145);
  249.       TextColor (1);
  250.       gotoxy (5,12);  write ('CH',#133,'-CH-C',#157,'C-H');
  251.       gotoxy (5,13);  write ('    '#155);
  252.       gotoxy (5,14);  write ('    CH',#133);
  253.       TextColor (1);
  254.       gotoxy (25,13); write ('      ',#160);
  255.       gotoxy (25,14); write (' Na',#150,' :Cl:',#151);
  256.       gotoxy (25,15); write ('      ',#160);
  257.       TextColor (2);
  258.       gotoxy (3,17);  write ('      ',#160);
  259.       gotoxy (3,18);  write ('      O:');
  260.       gotoxy (3,19);  write ('      ',#156);
  261.       gotoxy (3,20);  write ('      C ');
  262.       gotoxy (3,21);  write ('     ',#159,' ',#158);
  263.       gotoxy (3,22);  write ('   CH',#133,'  CO',#132,'CH',#132,'CH',#133);
  264.       TextColor (3);
  265.       gotoxy (23,18); write (' CH',#133,'     H');
  266.       gotoxy (23,19); write ('    ',#158,'   ',#159);
  267.       gotoxy (23,20); write ('     C=C    ');
  268.       gotoxy (23,21); write ('    ',#159,'   ',#158);
  269.       gotoxy (23,22); write ('   H     CH',#133);
  270.  
  271.       read (Kbd,Wait); TextMode (c80);
  272. END.
  273.