home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / graphics.swg / 0050_Fading.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-02  |  1.3 KB  |  77 lines
  1. { KEVIN OTTO }
  2.  
  3. Unit Fade;
  4.  
  5. { Change DelayAmt and Steps to change the speed of fading. }
  6.  
  7. Interface
  8.  
  9. Uses
  10.   Dos, Crt;
  11.  
  12. Const
  13.   Colors   = 64;
  14.   DelayAmt = 15;
  15.   Steps    = 24;
  16.  
  17. Type
  18.   PalType = Array [0..Colors - 1] of Record
  19.     R, G, B : Byte;
  20.   end;
  21.  
  22. Var
  23.   OrigPal : palType;
  24.  
  25. Procedure GetPal(Var OrigPal : PalType);
  26. Procedure FadePal(OrigPal : PalType; FadeOut : Boolean);
  27.  
  28. Implementation
  29.  
  30. Procedure GetPal(Var OrigPal : PalType);
  31. Var
  32.   Reg : Registers;
  33. begin
  34.   With Reg do
  35.   begin
  36.     AX := $1017;
  37.     BX := 0;
  38.     CX := colors;
  39.     ES := seg(OrigPal);
  40.     DX := ofs(OrigPal);
  41.     intr ($10, Reg);
  42.   end;
  43. end;
  44.  
  45. Procedure FadePal(OrigPal : PalType; FadeOut : Boolean);
  46. Var
  47.   Reg     : Registers;
  48.   WorkPal : PalType;
  49.   Fade    : Word;
  50.   Pct     : Real;
  51.   I       : Word;
  52. begin
  53.   With Reg do
  54.   For Fade := 0 to Steps do
  55.   begin
  56.     Pct := Fade / Steps;
  57.     if FadeOut then
  58.       Pct := 1 - Pct;
  59.     For I := 0 to Colors - 1 do
  60.     With WorkPal[I] do
  61.     begin
  62.       R := round(OrigPal[I].R * Pct);
  63.       G := round(OrigPal[I].G * Pct);
  64.       B := round(OrigPal[I].B * Pct);
  65.     end;
  66.     AX := $1012;
  67.     BX := 0;
  68.     CX := Colors;
  69.     ES := seg (WorkPal);
  70.     DX := ofs (WorkPal);
  71.     intr ($10, Reg);
  72.     Delay (DelayAmt);
  73.   end;
  74. end;
  75.  
  76. end.
  77.