Мое решение:
program rain;
uses crt,graph,dos;
var a: array [1..25,1..80] of char;
i,j,k: integer;
c: char;
{****************************************************************************}
procedure UnifDelay(n:integer);
var i: integer;
h,min,sec,ss: word;
ss1: word;
sum: integer;
begin
for i:=1 to n do
begin
gettime(h,min,sec,ss);
ss1:=ss;
repeat
gettime(h,min,sec,ss);
until abs(ss-ss1)>0;
end;
end;
{****************************************************************************}
{===========================================================================}
procedure fullscreen;
var gd,gm: integer;
begin
gd:=vga;
gm:=vgahi;
initgraph(gd,gm,'');
closegraph;
end;
{===========================================================================}
{===========================================================================}
procedure writer;
begin
randomize;
for i:=1 to 25 do
for j:=1 to 80 do
begin
k:=random(10);
if k=0 then
a[i,j]:='0'
else
if k=1 then
a[i,j]:='1'
else
a[i,j]:=' ';
end;
end;
{===========================================================================}
{===========================================================================}
procedure decomp;
var i,j: integer;
an: array [1..25,1..80] of char;
begin
for i:=1 to 25 do
for j:=1 to 80 do
an[i,j]:=a[i,j];
for i:=25 downto 1 do
for j:=1 to 80 do
begin
if i=25 then
begin
a[i,j]:=a[1,j];
continue;
end;
a[i,j]:=an[i+1,j];
write(a[i,j]);
end;
unifdelay(1);
end;
{===========================================================================}
begin
fullscreen;
TextAttr:=2;
clrscr;
writer;
repeat
clrscr;
decomp;
until keypressed;
end.
Можно ли как то проще???