Вообще-то это в задачи надо теперь перенести.
Вот твои сугробы, для падения снежинок под углом нужно изменить пару строчек...
Код
Uses
Crt;
Const
{Љў ¤а в ᥣ®Ї ¤ }
X2=80;
Y2=24;
Pause = 100;
Snow : Char = '*';
Space = ' ';
DelSnow = True;
LoopCount = 5000;
Var
A:array[1..X2] of Byte;
i,k,b,j:Byte;
c:Char;
N,S:LongInt;
Function GetChar(X,Y:Byte):Char;
begin
GetChar:=Chr(Mem[$B800:160*Y+2*X-162]);
end;
Procedure WriteXY(X,Y:Byte;C:Char);
begin
Mem[$B800:160*Y+2*X-162]:=Ord(C);
end;
Begin
ClrScr;
Randomize;
FillChar(A,SizeOf(A),Y2);
TextColor(White);
For i:=1 to X2 do WriteXY(i,Y2+1,Snow);
N:=0; S:=0;
Repeat
Inc(N);
For i:=1 to X2 do
if (Random(20)=8) and (GetChar(i,2)<>Snow) then
begin
WriteXY(i,1,Snow);
Inc(S);
end;
{-------------------------------------}
For i:=1 to X2 do
For j:=A[i] downto 1 do
begin
If GetChar(i,j)=Snow then
If (j+1)=A[i] then Dec(A[i])
else
begin
WriteXY(i,j,Space);
WriteXY(i,j+1,Snow);
end;
end;
{-------------------------------------}
If DelSnow then
For i:=1 to X2 do
if A[i]=1 then
begin
For j:=1 to Y2 do WriteXY(i,j,Space);
A[i]:=Y2;
end;
{-------------------------------------}
Delay(Pause);
Until (KeyPressed) or (N=LoopCount);
WriteLn(N,' жЁЄ«®ў'#13#10,S,' ᥦЁ®Є');
End.