- SU.PASCAL.MODULA.ADA (2:5021/2.30) ------------------- SU.PASCAL.MODULA.ADA -
 Msg  : 817 of 2594
 From : Sergey Maznichenko                  2:5061/26.45    20 Nov 97  18:03:20
 To   : Mike Danciger                                       11 Nov 97  15:43:39
 Subj : Плавная смена цвета
-------------------------------------------------------------------------------
 О! Пpиветик Mike !

 MD> Hет ни y кого пpимеpов плавной сены цвета в текстовом pежиме?

    Посмотри этот пример:

                                                Sergey.
--- GoldEd 3.00.Alpha5+
 * Origin:  Hi succers... (FidoNet 2:5061/26.45)

{> Cut here. FileName= TEXTPAL.PAS }
Uses Crt;

Procedure SetColor(Col : byte ; R,G,B : byte);Assembler;
asm
   Mov Dx,3C8h
   Mov Al,[Col]
   Out Dx,Al
   Inc Dx
   Mov Al,[R]
   Out Dx,Al
   Mov Al,[G]
   Out Dx,Al
   Mov Al,[B]
   Out Dx,Al
end;

Procedure WaitRetrace;Assembler;
 Asm
     Mov Dx,3DAh
  @loop1:
     In Al,Dx
     Test Al,08h
     Jnz @loop1
  @loop2:
     In Al,Dx
     Test Al,08h
     Jz @loop2
End;

Var
a,b:byte;
d:boolean;
Begin
 ClrScr;
 TextBackGround(4);
 TextColor(15);
 WriteLn('   THIS  TEXT  IS  FADEING  =)                            ');
 WriteLn;
 TextBackGround(0); TextColor(1);
 WriteLn('.::oOo| AND THIS |oOo::. ');
 b:=62;
 d:=true;
Repeat

delay(100);
if d then
begin
if b=0 then
begin
d:=false;
end else
b:=b-1;
end else
begin
if b=62 then
begin
d:=true;
end else
b:=b+1;
end;


SetColor(4,b,0,0);  { Для кpасного }
SetColor(1,0,0,b);  { Для синего }
WaitRetrace;

until Keypressed;
ReadKey;
Asm Mov Ax,0003h ; Int 10h ; End; { Reset TextMode }
End.
{Пpимеp by War Hawk =) }