[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]

    unit Fading;
    interface
    uses Crt;

    type
      Palette256 = array[0..255, 0..2] of Byte;
      Palette16 = array[0..15, 0..2] of Byte;

    procedure SetVGAPalette256(PalBuf: Palette256);
    procedure GetVGAPalette256(var PalBuf: Palette256);
    procedure SetVGAPalette16(PalBuf: Palette16);
    procedure GetVGAPalette16(var PalBuf: Palette16);
    procedure FadeOutScreen256;
    procedure FadeOutScreen16;
    procedure FadeInScreen256(PalToMake: Palette256);
    procedure FadeInScreen16(PalToMake: Palette16);

    implementation

    procedure SetVGAPalette256(PalBuf: Palette256);
    var
      ColorOn : byte;

    begin
      Port[$3C8] := 0;
      for ColorOn := 0 to 255 do
          begin
          Port[$3C9] := PalBuf[ColorOn, 0];
          Port[$3C9] := PalBuf[ColorOn, 1];
          Port[$3C9] := PalBuf[ColorOn, 2];
          end;
    end; {Sets entire VGA palette.}

    procedure GetVGAPalette256(var PalBuf: Palette256);
    var
      ColorOn : byte;

    begin
      Port[$3C8] := 1;
      for ColorOn := 0 to 255 do
          begin
          PalBuf[ColorOn, 0] := Port[$3C9];
          PalBuf[ColorOn, 1] := Port[$3C9];
          PalBuf[ColorOn, 2] := Port[$3C9];
          end;
      PalBuf[0, 0] := 0; {Color 0 doesn't read right.  I've tried}
      PalBuf[0, 1] := 0; {Changing the $3C8 assigment and fooling with}
      PalBuf[0, 2] := 0; {the loop, with no success.   Help!}
    end; {Reads entire VGA palette (except color 0)}

    procedure SetVGAPalette16(PalBuf: Palette16);
    {I find this a convenient seperate procedure.  You may not need it.}
    var
      ColorOn : byte;

    begin
      Port[$3C8] := 0;
      for ColorOn := 0 to 15 do
          begin
          Port[$3C9] := PalBuf[ColorOn, 0];
          Port[$3C9] := PalBuf[ColorOn, 1];
          Port[$3C9] := PalBuf[ColorOn, 2];
          end;
    end; {Sets entire palette for 16 colors}

    procedure GetVGAPalette16(var PalBuf: Palette16);
    var
      ColorOn : byte;

    begin
      Port[$3C8] := 1;
      for ColorOn := 0 to 15 do
          begin
          PalBuf[ColorOn, 0] := Port[$3C9];
          PalBuf[ColorOn, 1] := Port[$3C9];
          PalBuf[ColorOn, 2] := Port[$3C9];
          end;
      PalBuf[0, 0] := 0; {Same deal as GetVGAPalette256.}
      PalBuf[0, 1] := 0;
      PalBuf[0, 2] := 0;
    end; {Reads entire 16 color palette}

    procedure FadeOutScreen256;
       var
         Count        : word;
         ColorOn      : byte;
         PalToMake    : Palette256;
         PaletteStuff : Palette256;

       begin
       GetVGAPalette256(PaletteStuff);
       PalToMake := PaletteStuff;
       for Count := 63 downto 0 do
           begin
           Port[$3C8] := 0;
           PaletteStuff := PalToMake;
           Delay(1);
           for ColorOn := 0 to 255 do
               begin
               PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div
    63;           PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count)
    div 63;           PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] *
    Count) div 63;           Port[$3C9] := PaletteStuff[ColorOn, 0];
               Port[$3C9] := PaletteStuff[ColorOn, 1];
               Port[$3C9] := PaletteStuff[ColorOn, 2];
               end;
           end;
       end; {Fades out 256 color screen to black}

    procedure FadeInScreen256(PalToMake: Palette256);
       var
         Count        : byte;
         ColorOn      : byte;
         PaletteStuff : Palette256;
         FastPal      : Palette256;

       begin
       GetVGAPalette256(PaletteStuff);
       for Count := 0 to 63 do
           begin
           Port[$3C8] := 0;
           PaletteStuff := PalToMake;
           Delay(1);
           for ColorOn := 0 to 255 do
               begin
               PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div
    63;           PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count)
    div 63;           PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] *
    Count) div 63;           Port[$3C9] := PaletteStuff[ColorOn, 0];
               Port[$3C9] := PaletteStuff[ColorOn, 1];
               Port[$3C9] := PaletteStuff[ColorOn, 2];
               end;
           end;
       end; {Fades in 256 color screen from black to the given palette}

     procedure FadeOutScreen16;
       var
         Count        : word;
         ColorOn      : byte;
         PalToMake    : Palette16;
         PaletteStuff : Palette16;

       begin
       GetVGAPalette16(PaletteStuff);
       PalToMake := PaletteStuff;
       for Count := 63 downto 0 do
           begin
           Port[$3C8] := 0;
           PaletteStuff := PalToMake;
           Delay(5);
           for ColorOn := 0 to 15 do
               begin
               PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div
    63;           PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count)
    div 63;           PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] *
    Count) div 63;           Port[$3C9] := PaletteStuff[ColorOn, 0];
               Port[$3C9] := PaletteStuff[ColorOn, 1];
               Port[$3C9] := PaletteStuff[ColorOn, 2];
               end;
           end;
       end; {Fades out the 16 color screen to black}

    procedure FadeInScreen16(PalToMake: Palette16);
       var
         Count        : byte;
         ColorOn      : byte;
         PaletteStuff : Palette16;
         FastPal      : Palette16;

       begin
       GetVGAPalette16(PaletteStuff);
       for Count := 0 to 63 do
           begin
           Port[$3C8] := 0;
           PaletteStuff := PalToMake;
           Delay(5);
           for ColorOn := 0 to 15 do
               begin
               PaletteStuff[ColorOn, 0] := (PaletteStuff[ColorOn, 0] * Count) div
    63;           PaletteStuff[ColorOn, 1] := (PaletteStuff[ColorOn, 1] * Count)
    div 63;           PaletteStuff[ColorOn, 2] := (PaletteStuff[ColorOn, 2] *
    Count) div 63;           Port[$3C9] := PaletteStuff[ColorOn, 0];
               Port[$3C9] := PaletteStuff[ColorOn, 1];
               Port[$3C9] := PaletteStuff[ColorOn, 2];
               end;
           end;
       end;

    end.

[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]