home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / XFADE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  1.7 KB  |  64 lines
  1.  
  2. program xfade; { XFADE.PAS }
  3. { Cross-fade routine, by Bas van Gaalen }
  4. uses u_vga,u_pal,u_kb;
  5. const
  6.   lines=13;
  7.   creds:array[0..lines-1] of string[20]=(
  8.     {.........|.........|}
  9.     'This cross-fade',
  10.     'routine was made by',
  11.     'Bas van Gaalen',
  12.     'Code and idea',
  13.     'inspired by',
  14.     'David Proper',
  15.     'This routine was',
  16.     'enhanced a bit',
  17.     'in comparison with',
  18.     'David''s one...',
  19.     'cu later',
  20.     'alligator!',
  21.     '');
  22.  
  23. procedure cleartxt(col,new:byte);
  24. var x,y,vofs:word;
  25. begin
  26.   for x:=0 to 319 do for y:=100 to 107 do begin
  27.     vofs:=y*320+x;
  28.     if mem[u_vidseg:vofs]=col then mem[u_vidseg:vofs]:=0
  29.     else if mem[u_vidseg:vofs]<>0 then mem[u_vidseg:vofs]:=new;
  30.   end;
  31. end;
  32.  
  33. procedure writetxt(col,cur:byte; txt:string); { special textroutine }
  34. var x,y,vofs:word; i,j,k:byte;
  35. begin
  36.   x:=(320-8*length(txt)) div 2; y:=100;
  37.   for i:=1 to length(txt) do for j:=0 to 7 do for k:=0 to 7 do
  38.     if ((mem[seg(font^):ofs(font^)+ord(txt[i])*8+j] shl k) and 128) <> 0 then begin
  39.       vofs:=(y+j)*320+(i*8)+x+k;
  40.       if mem[u_vidseg:vofs]=cur then mem[u_vidseg:vofs]:=col+cur else mem[u_vidseg:vofs]:=col;
  41.     end;
  42. end;
  43.  
  44. var txtidx,curcol,i:byte;
  45. begin
  46.   setvideo($13);
  47.   getfont(font8x8);
  48.   setrgb(1,0,0,0); setrgb(2,0,0,0); setrgb(3,63 div 2,63,63 div 2);
  49.   curcol:=1; txtidx:=0;
  50.   repeat
  51.     cleartxt(curcol,3-curcol);
  52.     writetxt(curcol,3-curcol,creds[txtidx]);
  53.     for i:=0 to 63 do begin
  54.       vretrace;
  55.       setrgb(curcol,i div 2,i,i div 2);
  56.       setrgb(3-curcol,(63-i) div 2,63-i,(63-i) div 2);
  57.     end;
  58.     waitkey(1);
  59.     curcol:=succ(curcol mod 2);
  60.     txtidx:=succ(txtidx) mod lines;
  61.   until port[$60]=1; { <ESC> to quit }
  62.   setvideo(u_lm);
  63. end.
  64.