home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / FASTVGA / FONTDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-13  |  3.0 KB  |  147 lines
  1. uses FastVGA,FastFonts,FastTimer,Crt;
  2.  
  3. var x,y:Integer;
  4.     P:PaletteType;
  5.     Er:Byte;
  6.  
  7. procedure Intro;
  8.  procedure EnWhite (n:Byte); { Procedure to fade a given color to white }
  9.   var C:PaletteType;
  10.       Done:Boolean;
  11.  
  12.   begin
  13.    C[n][RGBRed]:=63;    { Set color "n" of palette "C" to white }
  14.    C[n][RGBGreen]:=63;
  15.    C[n][RGBBlue]:=63;
  16.    repeat
  17.     StartTimer;
  18.     PullToPalette (P,C,n,n,Done);
  19.     SetActivePalette (P,n,n);
  20.     WaitFor (25);
  21.    until Done;
  22.   end;
  23.  
  24.  procedure RevealLine (y:Integer; c:Byte; S:String);
  25.   var x:Integer;
  26.  
  27.   begin
  28.    VGAColor:=c;
  29.    x:=(320-Length(S)*9) div 2;
  30.    Font16Write (x,y,S);
  31.    EnWhite (c);
  32.   end;
  33.  
  34.  begin
  35.   FillChar (P,SizeOf(P),0);
  36.   SetActivePalette (P,0,255);
  37.   RevealLine ( 50, 1,'Hello, and welcome to the FastVGA');
  38.   RevealLine ( 66, 2,'Fonts demo. This short and simple');
  39.   RevealLine ( 82, 3,'demo will show you just some of');
  40.   RevealLine ( 98, 4,'the things you can do with the');
  41.   RevealLine (114, 5,'FastFonts unit of FastVGA. Watch');
  42.   RevealLine (130, 6,'and enjoy!');
  43.   ReadKey;
  44.  end;
  45.  
  46. procedure Welcome;
  47.  begin
  48.   GoVGA256; { Restore the original color palette }
  49.   for x:=0 to 130 do
  50.    begin
  51.     VGAColor:=x;
  52.     Font16Write (x,x,'Welcome to FastVGA!');
  53.    end;
  54.   VGAColor:=15;  { Final time, in pure white: }
  55.   Font16Write (131,131,'Welcome to FastVGA!');
  56.   ReadKey;
  57.  end;
  58.  
  59. procedure SineWave;
  60.  const S:String = ' Sine Wave!■';
  61.  
  62.  var Ch,Line:Byte;
  63.      Rad:Integer;
  64.  
  65.  begin
  66.   Rad:=-75;
  67.   while Rad<=80 do
  68.    begin
  69.     Ch:=1;
  70.     Line:=0;
  71.     VGAColor:=30-Abs(Rad div 10);
  72.     for x:=0 to 319 do
  73.      begin
  74.       y:=100+Round(Rad*Sin(x*Pi/180));
  75.       if Line<>0 then Font16VLine (x,y,S[Ch],Line);
  76.       Inc (Line);
  77.       if Line=9 then
  78.        begin
  79.         Line:=0;
  80.         Inc (Ch);
  81.         if Ch>Length(S) then Ch:=1;
  82.        end;
  83.      end;
  84.     Inc (Rad,15);
  85.     ReadKey;
  86.    end;
  87.  end;
  88.  
  89. procedure Scroll;
  90.  const S:String ='Scrolling ';
  91.  
  92.  var Ch,Line:Byte;
  93.  
  94.  begin
  95.   Ch:=1;
  96.   Line:=0;
  97.   repeat
  98.    VGAColor:=15;
  99.    if Line<>0 then
  100.     begin
  101.      Font16VLine (319,120,S[Ch],Line);
  102.      Font16VLine (0,80,S[Ch],Line);
  103.     end;
  104.    VSync;        { Wait for syncronization - important for scrolling! }
  105.    ScrollLeft (0,120,319,135);
  106.    VSync;
  107.    ScrollRight (0,80,319,95);
  108.    VGAColor:=0;
  109.    VLine (319,120,135);
  110.    VLine (0,80,95);
  111.    Inc (Line);
  112.    if Line=9 then
  113.     begin
  114.      Line:=0;
  115.      Inc (Ch);
  116.      if Ch>Length(S) then Ch:=1;
  117.     end;
  118.   until KeyPressed;
  119.  end;
  120.  
  121. begin
  122.  if TestVGA=0 then
  123.   begin
  124.    WriteLn ('This program requires a VGA/MCGA card.');
  125.    Halt;
  126.   end;
  127.  GoVGA256;
  128.  InstallFastTimer;
  129.  Font16Init;
  130.  LoadBIN16 (ActiveFont16^,'COMPUTER.BIN',Er);
  131.  Intro;
  132.  {$IFNDEF DPMI}
  133.  LoadSystemFont16 (ActiveFont16^); { Restore default font, if we are NOT in
  134.                                      protected mode }
  135.  {$ENDIF}
  136.  Welcome;
  137.  ClrVGAScr;
  138.  SineWave;
  139.  ClrVGAScr;
  140.  Scroll;
  141.  Font16Done;
  142.  RestoreTimer;
  143.  TextMode (Co80);
  144.  WriteLn ('That''s all folks!');
  145.  WriteLn;
  146. end.
  147.