The Matrix V1.01, Для прикола написал Опции

[godd]

Код

uses crt;
var Del:word;
   i:byte;

procedure WWD(Del:word;Col:byte;Str:string);
   var i:byte;
   begin
   TextColor(Col);
   for i:=1 to length(Str) do
       begin
       delay(Del);
       write(str[i]);
       end;
   for i:=1 to 5 do Delay(Del);
   writeln;
   end;
Procedure MI; {MatrixInitialized}
   type arr35b=array[1..15] of byte;
   var matrix:record
                    element:array[1..25,1..80] of char;
                    color:array[1..25,1..80] of byte;
                    pos:arr35b;          
                    leng:arr35b;        
              end;
       f:boolean;
       i,j,j_2,n:byte;
       s:string;
   begin
   TextColor(2);
   s:='';
   with matrix do        
        for j_2:=1 to 15 do
            begin
            pos[j_2]:=random(80)+1;
            leng[j_2]:=random(15)+1;
            end;
   for i:=25 downto 1 do
       begin
       for j:=1 to 80 do
           begin
           f:=false;
           n:=random(16);
           matrix.color[i,j]:=2;
           for j_2:=1 to n do
               if j=matrix.pos[j_2] then
                  if matrix.leng[j_2]>0 then
                     begin
                     with matrix do
                          begin
                          element[i,j]:=chr(random(256));
                          if leng[j_2]>random(15) then color[i,pos[j_2]]:=10;
                          leng[j_2]:=leng[j_2]-1;
                          end;
                     f:=true;
                     end;
           if f=false then matrix.element[i,j]:=' ';
           end;
       end;            
   while TRUE do      
         begin
         if KeyPressed then
            begin
            s:=s+ReadKey;
            if s='godd rulez forever' then exit;
            if s[length(s)]=#27 then s:='';
            end;
         for i:=1 to 25 do    
             begin
             for j:=1 to 80 do
                 begin
                 GotoXY(j,i);
                 TextColor(matrix.color[i,j]);
                 write(matrix.element[i,j]);    
                 with matrix do
                      begin
                      element[i,j]:=element[i+1,j];
                      color[i,j]:=color[i+1,j];
                      end
                 end;
             Delay(random(10));
             end;              
         for j:=1 to 80 do
             with matrix do
                  begin
                  element[25,j]:=' ';
                  color[25,j]:=2;
                  end;
         with matrix do
              for j_2:=1 to 15 do
                  begin
                  leng[j_2]:=leng[j_2]-1;
                  if leng[j_2]<=0 then
                     begin
                     f:=true;
                     pos[j_2]:=random(80)+1;
                     leng[j_2]:=random(15)+1;
                     element[25,pos[j_2]]:=chr(random(256));
                     color[25,pos[j_2]]:=10;
                     end
                  else element[25,pos[j_2]]:=chr(random(256));
                  if leng[j_2]>random(10)+1 then color[25,pos[j_2]]:=10;
                  end;
         end;
   end;                

begin
clrscr;
randomize;
CheckBreak:=false;
Del:=150;
clrscr;
WWD(Del,8,'Entering the MATRIX v1.01');
WWD(Del*2,2,'');
WWD(Del,2,'Loading');
WWD(Del*2,11,'..........................................');
WWD(trunc(Del*0.5),2,'');
WWD(trunc(Del*0.5),12,'All modules loaded.');
WWD(Del*2,2,'');
WWD(Del,2,'Testing the System');
WWD(Del*2,11,'..........................................');
WWD(trunc(Del*0.5),2,'');
WWD(trunc(Del*0.5),12,'System is OK.');
WWD(Del*2,2,'');
WWD(Del,7,'We are in the MATRIX now!');
WWD(trunc(Del*0.8),2,'');
WWD(Del,2,'Go follow white rabbit and remember...');
WWD(trunc(Del*0.8),2,'');
WWD(Del,10,'MATRIX HAD YOU !!!');
for i:=1 to 10 do Delay(del);
MI;
clrscr;
WWD(Del,2,'Password is right.');
WWD(Del,10,'Yes godd rulez, you right )))');
WWD(Del,2,'Bye!');
for i:=1 to 25 do delay(Del);
clrscr;
TextColor(15);
end.

P.S. Delay настроил под пропатченный CRT.

[xds]

Неплохо... Но есть одно замечание: не стоит выводить с помощью Write/Writeln символы c кодами 0..31. Например, Chr(7) может порождать достаточно длительные задержки на генерацию звукового сигнала (не говоря об акустических артефактах).

Для быстрого вывода символа с любым кодом 0..255 можно использовать прямую запись в видеобуфер:

Код

program Code;

procedure SetTextMode; assembler;
asm
 mov ax,3
 int 10h
end;

function ReadKey: Word; assembler;
asm
 xor ah,ah
 int 16h
end;

function KeyPressed: Boolean; assembler;
asm
 mov ah,1
 int 16h
 mov al,0
 jz @l
 inc al
@l:
end;

type
 TTextBuf = array[0..24, 0..79] of Word;

var
 BackBuf: TTextBuf;
 ScrBuf: TTextBuf absolute $B800:0;
 Timer: Word absolute $40:$6C;
 t: Word;
 x, y, dx, dy: Integer;
 c, a: Byte;
 i, j: Integer;

begin
 SetTextMode;

 x := 0;
 y := 9;
 dx := 3;
 dy := 1;
 c := 0;
 repeat
   t := Timer + 1;

   Inc(x, dx);
   if x < 0 then
     begin
       x := 0;
       dx := -dx;
     end
   else
     if x > 63 then
       begin
         x := 63;
         dx := -dx;
       end;
   Inc(y, dy);
   if y < 0 then
     begin
       y := 0;
       dy := -dy;
     end
   else
     if y > 9 then
       begin
         y := 9;
         dy := -dy;
       end;

   for i := 0 to 24 do
     for j := 0 to 79 do
       BackBuf[i, j] := ((i + j) shr 3 and 1 - (i - j) shr 4 and 1) shl 12;

   for i := 0 to 15 do
     begin
       for j := 0 to 15 do
         begin
           a := $F xor (c + i) and 3 shl 4;
           BackBuf[i + y, j + x] := c or a shl 8;
           Inc(c);
         end;
     end;

   Move(BackBuf, ScrBuf, SizeOf(TTextBuf));
   while Timer < t do;

 until KeyPressed;
 ReadKey;
end.