IPB
ЛогинПароль:

> Правила раздела!

1. Заголовок или название темы должно быть информативным !
2. Все тексты фрагментов программ должны помещаться в теги [code] ... [/code] или [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ" и используйте ПОИСК !
4. НЕ используйте форум для личного общения!
5. Самое главное - это раздел теоретический, т.е. никаких задач и программ (за исключением небольших фрагментов) - для этого есть отдельный раздел!

 
 Ответить  Открыть новую тему 
> Где взять исходники задач, по урокам Дмитриева Эду, Помогите найти решеные задачи по урокам
сообщение
Сообщение #1


Гость






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


Профи
****

Группа: Пользователи
Сообщений: 775
Пол: Мужской

Репутация: -  0  +


Дык выложил бы задачки, посмотрели/подумали бы.
Я вот чой-то Дмитриева Э. не знаю.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Знаток
****

Группа: Пользователи
Сообщений: 408
Пол: Мужской

Репутация: -  3  +


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

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


--------------------
- Где я?
- Во тьме.
- В какой тьме?
- Во тьме твоего мозга.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






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

Сообщение отредактировано: APAL -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Профи
****

Группа: Пользователи
Сообщений: 775
Пол: Мужской

Репутация: -  0  +


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

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

Код

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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 26.10.2020 17:32
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name