Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Теоретические вопросы _ Где взять исходники задач, по урокам Дмитриева Эду

Автор: Ярослав 14.05.2004 20:14

Ребята если у кого есть решеные задачи по урокам Дмитриева Эдуарда, скиньте мне на Wolf002@yandex.ru, хотя с 13 урока первые сам порешал а дальше не могу. Помогите новичку. blink.gif blink.gif blink.gif :p2:

Автор: GLuk 16.05.2004 1:30

Дык выложил бы задачки, посмотрели/подумали бы.
Я вот чой-то Дмитриева Э. не знаю.

Автор: Dark 16.05.2004 8:39

Хых, прикинь =) я тоже не знал
рискнул набрать в Яндексе - он дал ссылку на сайт pascal.dax.ru ;)

http://pascal.dax.ru/?lessons&id=1&page=15

Автор: Ярослав 16.05.2004 22:27

Dark спасибо, что ответил, но по укзаному адресу исходников нет, там просто размещены уроки по паскалю в частности урок номер 15, ладно ребята что б вас не парить лишний раз буду писать задания целиком, а то может кто нибудь и знает ответ, но не знает откуда задача и так задание №13
{ СHЕЖИHКИ }

Код
uses crt;  
const n=79;  
Var  
x:array[1..n] of byte;  
i,k:byte; c:char;  
Begin  
clrscr;  
for i:=1 to n do  
begin  
x[i]:=0;  
end;  
repeat  
k:=random(80);  
if x[k]=0 then x[k]:=1;  
for i:=1 to n do  
begin  
if x[i]>0 then  
begin  
gotoxy(i,x[i]);  
write(' ');  
x[i]:=x[i]+1;  
gotoxy(i,x[i]);  
write('*');  
if x[i]>23 then x[i]:=0;  
end;  
end;  
delay(100);  
until keypressed;  
end.


Не забывай текст проги заключать в соответствующие теги!
Отредактировано модератором.


вопрос к заданию
1.усложнить задачу можно подсчетом опавших снежинок в каждом столбце, если наглядно то получить сугробы!

2.снежинки падают под углом, в одну сторону, две стороны <= и =>
Если кто знает напишите код решения.

Автор: GLuk 20.05.2004 5:20

Вообще-то это в задачи надо теперь перенести.

Вот твои сугробы, для падения снежинок под углом нужно изменить пару строчек...

Код

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.