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

    {
    I attempted to Write a Unit For Text FADING, but I don't have it all down
    right...  If any one wants to play With the Unit and perfect it I would not
    mind!  My problem is that I do not know the correct values to change in the
    color register For the affect of a fade.  Once all the values are 0 the screen
    is black, but on the way there the screen gets some strange colors... Also, if
    you know how to change the colors, you can implement your own custom colors for
    Text mode.  I think 256 different colors, but only 16 at a time. (I am only
    guessing at that last part).   The FADEOUT and FADEIN does work here, but it
    goes through some strange colors on the way!

    Robert
    }

    Unit TextFade; {attempt For implementing Text fading}
    { only works For VGA or SVGA as Far as I know! }

    Interface

    Uses Dos, Crt;

    Type
      ColorRegister =
      Record
        Red      : Byte;
        Green    : Byte;
        Blue     : Byte;
      end;

      ColorRegisterArray    = Array[0..255] of ColorRegister;
      ColorRegisterArrayPtr = ^ColorRegisterArray;

    Var
      SaveCRAp      : ColorRegisterArrayPtr;

    Procedure SaveColorRegister(Var CRAp : ColorRegisterArrayPtr);
    { given a color register Array ptr, this will save the current }
    { values so you can restore from them later...                 }

    Procedure SetColorRegister(Var CRAp : ColorRegisterArrayPtr);
    { when you adjust the values of a color register set, this     }
    { Procedure will make put the new values into memory           }

    Procedure FadeOut(MS_Delay : Integer);
    { using the global Variable 'SaveCRAp', this will fade the Text}
    { screen out till all the values in the color register Array   }
    { ptr are 0                                                    }

    Procedure FadeIn(MS_Delay : Integer);
    { once again using the global Variable 'SaveCRAp', this will   }
    { fade the screen back in till all values of the current color }
    { register Array ptr are equal to 'SaveCRAp'                   }

    Implementation

    Procedure Abort(Msg : String);
    begin
      Writeln(Msg);
      Halt(1);
    end;

    Procedure SaveColorRegister(Var CRAp : ColorRegisterArrayPtr);
    Var
      R : Registers;
    begin
      With R Do
      begin
        ah := $10;
        al := $17;
        bx := $00;
        cx := 256;
        es := Seg(crap^);
        dx := Ofs(crap^);
      end;
      Intr($10,r);
    end;

    Procedure SetColorRegister(Var CRAp : ColorREgisterArrayPtr);
    Var
      R : Registers;
    begin
      With R Do
      begin
        ah := $10;
        al := $12;
        bx := $00;
        cx := 256;
        es := Seg(crap^);
        dx := Ofs(crap^);
      end;
      Intr($10,r);
    end;

    Procedure FadeOut(MS_Delay : Integer);
    Var
      NewCRAp : ColorRegisterArrayPtr;
      W       : Word;
      T       : Word;
    begin
      New(NewCRAp);
      If NewCRAp = NIL Then
        Abort('Not Enough Memory');
      NewCrap^ := SaveCrap^;
      For T := 1 to 63 Do
      begin
        For W := 0 to 255 Do
        With NewCRAp^[w] Do
        If Red + Green + Blue > 0 Then
        begin
          Dec(Red);
          Dec(Green);
          Dec(Blue);
        end;
        SetColorRegister(NewCRAp);
        Delay(MS_Delay);
      end;
    end;

    Procedure FadeIn(MS_Delay : Integer);
    Var
      NewCRAp : ColorRegisterArrayPtr;
      W       : Word;
      T       : Word;
    begin
      New(NewCRAp);
      If NewCRAp = Nil Then
        Abort('Not Enough Memory');
      FillChar(NewCRAp^,SizeOf(NewCRAp^),0);
      For T := 1 to 63 Do
      { The values in the color register are not higher than 63 }
      begin
        For W := 0 to 255 Do
        If SaveCRAp^[w].Red + SaveCRAp^[w].Green + SaveCRAp^[w].Red > 0 Then
        begin
          If NewCRAp^[w].Red   < SaveCRAp^[w].Red Then
            Inc(NewCRAp^[w].Red);
          If NewCRAp^[w].Green < SaveCRAp^[w].Green Then
            Inc(NewCRAp^[w].Green);
          If NewCRAp^[w].Blue  < SaveCRAp^[w].Blue Then
            Inc(NewCRAp^[w].Blue);
        end;
        SetColorRegister(NewCRAp);
        Delay(MS_Delay);
      end;
    end;

    begin
      New(SaveCRAp);
      {get memory For the Pointer}
      If SaveCRAp = Nil Then Abort('Not Enough Memory');
      {make sure it actually got some memory}
      SaveColorRegister(SaveCRAp);
      {save the current values into SaveCRAp}
    end.

    ---------------8<-----cut here------>8---------

    Here is a demo of how to use it...

    Uses TextFADE;

    begin
       FADEOUT(10);
       WriteLN(' HOW DOES THIS LOOK');
       FADEIN(10);
       Dispose(SaveCRAp);
       {I just Realized I never got rid of this Pointer before!}
    end.

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