Интересные программы в паскале

Программирование в школе – всегда тема очень сложная для понимания. И хотя именно эта тема имеет очевидное практическое применение (а отсутствие такового – причина для ученика, чтобы заявлять, что это ему знать не надо), мало кто из учеников изучает ее с желанием.

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

Я предлагаю ученикам создать собственные игры. Конечно, консольные.

И первая из них – это “Угадай число”.

Компьютер “загадывает” число из указанного диапазона. Задача пользователя – отгадать это число. Пользователь вводит свой вариант ответа, компьютер отвечает, как введенное число относится к загаданному (больше, меньше или равно). На отгадывание дается определенное количество попыток.

Примерный текст на экране:

Задание для учеников можно сформулировать так.

Самостоятельно сделайте следующее:

1. Наберите в среде программирования исходный код приложения (размещен дальше по заданию).
2. Дополните код, добавив в него еще два уровня сложности.
3. Исправьте ошибку программиста (угадывание не прекращается, если число потраченных попыток превысило допустимое значение).
   Подсказка
   until (chislo=number)or(popytki=max);
4. Доработайте программу таким образом, чтобы в случае неудачной игры пользователю выводилось сообщение о том, что он не угадал число.
5. Доработайте программу таким образом, чтобы после завершения игры пользователю предлагалось либо завершить игру, либо начать заново. Во втором случае на экране должен снова появиться выбор сложности.

Graph3D на PascalABC! 3D теперь реально! КАК и ЧЕГО можно СДЕЛАТЬ?

Исходный код проекта:

Полный исходный код программы со всеми исправлениями

program guessnumber; var b,uroven, chislo, popytki, number, max :integer; begin randomize; writeln(‘###############################’); writeln(‘##### Игра «Угадай число» #####’); writeln(‘###############################’); repeat writeln; uroven:=0; popytki:=0; while (uroven<1) or (uroven>4) do //Защита от неправильно введенного уровня begin writeln(‘Выберите уровень сложности:’); writeln(‘1 — Числа от 1 до 10, 3 попытки’); writeln(‘2 — Числа от 1 до 50, 5 попыток’); writeln(‘3 — Числа от 1 до 100, 8 попыток’); writeln(‘4 — Числа от 1 до 1000, 15 попыток’); readln(uroven); end; if uroven =1 then begin chislo:=random(10)+1; max:=3 end; if uroven =2 then begin chislo:=random(50)+1; max:=5 end; if uroven =3 then begin chislo:=random(100)+1; max:=8 end; if uroven =4 then begin chislo:=random(1000)+1; max:=15 end; repeat inc(popytki); write(‘Попытка ‘,popytki,’ Ваше число? ‘); read(number); if number>chislo then writeln(‘ Я загадал число поменьше’) else if numbernumber)and(popytki=max)then writeln(‘К сожалению, Вам не удалось отгадать число. Я загадал ‘,chislo); writeln(‘Хотите сыграть еще раз? Если да, введите 1, если нет, то 0’); readln(b); until b=0; end.

Успехов в программировании!

МОЯ ПЕРВАЯ ИГРА!(и она на языке Pascal ABC) «Hit the Casino».

Источник: andrewrogov.ru

Очень интересная программа на языке Pascal

Flashback Статьи и обзоры

Эта задача очень интересна именно тем, что показывает, что наипростейшую задачу можно решить нестандартно.
Задача – поменять значения переменных a и b.
Пусть a=5, а b=7.

Как бы мы решали её просто.

Program name_name;
uses crt;
var a,b,c:LongInt;
begin
readln(a);
readln(b);
c:=b;
b:=a;
a:=c;
write(a,b);
end.

Проверяем работоспособность…
Готово!

Но если мы учимся программировать правильно, то давайте добавим для себя дополнительное условие – перемену значений нужно сделать без дополнительной переменной. Тогда:

program name_eman;
uses crt;
var a,b:LongInt;
begin
readln(a,b);
…
Занесем в переменную A результат суммирования A и B (A := A + B): A = A1 + B1; B = B1;
Занесем в переменную B разность A и B (B := A – B): A = A1 + B1; B = A1;
Занесем в переменную A разность A и B (A := A – B): A = B1; B = A1;
…
writeln(a,b);
end.

Источник: rce.su

Интересные программы в паскале

Превосходная программа, демонстрирующая возможности графики и алгоритма игры «Жизнь» на торе. Немного пояснений для тех кто только начинает учиться.

Игра «Жизнь» была придумана английским математиком Джоном Конвейем в 1970 году. Впервые описание этой игры опубликовано в октябрьском выпуске (1970) журнала Scientic American, в рубрике «Математические игры» Мартина Гарднера.

Место действия этой игры – «вселенная» – это размеченная на клетки поверхность. Каждая клетка на этой поверхности может находиться в двух состояниях: быть живой или быть мертвой. Клетка имеет восемь соседей. Распределение живых клеток в начале игры называется первым поколением. А дальше все происходит почти как в реальной жизни, потому игра так и называется. Каждое следующее поколение рассчитывается на основе предыдущего по таким правилам:

1) пустая (мертвая) клетка с ровно тремя живыми клетками-соседями оживает;
2) если у живой клетки есть две или три живые соседки, то эта клетка продолжает жить;
3) в противном случае (если соседок меньше двух или больше трех) клетка умирает (от «одиночества» или от «перенаселенности»).

В этой задаче рассматривается игра «Жизнь» на торе. Представим себе прямоугольник размером n строк на m столбцов. Для того, чтобы превратить его в тор мысленно «склеим» его верхнюю сторону с нижней, а левую с правой. Таким образом, у каждой клетки, даже если она раньше находилась на границе прямоугольника, теперь есть ровно восемь соседей.

Ваша задача состоит в том, чтобы найти конфигурацию клеток, которая будет через k поколений от заданного.

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

// Игра «Жизнь» на торе // Оптимизация хешированием по равномерной сетке uses Graph; const /// Пауза между поколениями delay = 10; /// Ширина клетки w = 10; /// Количество клеток по ширине m = 70; /// Количество клеток по высоте n = 60; /// Отступ поля от левой границы окна x0 = 1; /// Отступ поля от верхней границы окна y0 = 21; mm = m + 1; nn = n + 1; /// Количество клеток сетки по горизонтали mk = 10; /// Количество клеток сетки по вертикали nk = 5; var a,b,sosedia,sosedib: array [0..nn,0..mm] of byte; obnovA,obnovB: array [1..nk,1..mk] of boolean; CountCells: integer; obn: boolean; gen: integer; hn,hm: integer; /// Нарисовать ячейку procedure DrawCell(i,j: integer); begin SetBrushColor(Color.Black); FillRectangle(x0+(j-1)*w,y0+(i-1)*w,x0+j*w-1,y0+i*w-1); end; /// Стереть ячейку procedure ClearCell(i,j: integer); begin SetBrushColor(Color.White); FillRectangle(x0+(j-1)*w,y0+(i-1)*w,x0+j*w-1,y0+i*w-1); end; /// Нарисовать все изменившиеся ячейки procedure DrawConfiguration; begin for var i:=1 to n do for var j:=1 to m do begin var bb := b[i,j]; if a[i,j]<>bb then if bb=1 then DrawCell(i,j) else ClearCell(i,j); end; end; /// Нарисовать все ячейки procedure DrawConfigurationFull; begin for var i:=1 to n do for var j:=1 to m do if b[i,j]=1 then DrawCell(i,j) else ClearCell(i,j); end; /// Нарисовать поле procedure DrawField; begin Pen.Color := Color.LightGray; for var i:=0 to m do begin if i mod hm = 0 then Pen.Color := Color.Gray else Pen.Color := Color.LightGray; Line(x0+i*w-1,y0,x0+i*w-1,y0+n*w-1); end; for var i:=0 to n do begin if i mod hn = 0 then Pen.Color := Color.Gray else Pen.Color := Color.LightGray; Line(x0,y0+i*w-1,x0+m*w,y0+i*w-1); end; end; /// Увеличить массив соседей для данной клетки procedure IncSosedi(i,j: integer); var i1,i2,j1,j2: integer; begin if i=1 then i1:=n else i1:=i-1; if i=n then i2:=1 else i2:=i+1; if j=1 then j1:=m else j1:=j-1; if j=m then j2:=1 else j2:=j+1; SosediB[i1,j1] += 1; SosediB[i1,j] += 1; SosediB[i1,j2] += 1; SosediB[i,j1] += 1; SosediB[i,j2] += 1; SosediB[i2,j1] += 1; SosediB[i2,j] += 1; SosediB[i2,j2] += 1; end; /// Уменьшить массив соседей для данной клетки procedure DecSosedi(i,j: integer); var i1,i2,j1,j2: integer; begin if i=1 then i1:=n else i1:=i-1; if i=n then i2:=1 else i2:=i+1; if j=1 then j1:=m else j1:=j-1; if j=m then j2:=1 else j2:=j+1; SosediB[i1,j1] -= 1; SosediB[i1,j] -= 1; SosediB[i1,j2] -= 1; SosediB[i,j1] -= 1; SosediB[i,j2] -= 1; SosediB[i2,j1] -= 1; SosediB[i2,j] -= 1; SosediB[i2,j2] -= 1; end; /// Поставить ячейку в клетку (i,j) procedure SetCell(i,j: integer); begin if b[i,j]=0 then begin b[i,j] := 1; obn := True; IncSosedi(i,j); end; CountCells += 1; end; /// Убрать ячейку из клетки (i,j) procedure UnSetCell(i,j: integer); begin if b[i,j]=1 then begin b[i,j] := 0; obn := True; DecSosedi(i,j); end; CountCells -= 1; end; /// Инициализировать массивы и конфигурацию поля procedure Init; var xc := n div 2; yc := m div 2; begin for var i:=0 to n+1 do for var j:=0 to m+1 do b[i,j] := 0; a := b; SosediB := b; SosediA := SosediB; for var ik:=1 to nk do for var jk:=1 to mk do obnovB[ik,jk] := True; obnovA := obnovB; CountCells := 0; SetCell(xc,yc); SetCell(xc,yc+1); SetCell(xc,yc+2); SetCell(xc-1,yc+2); SetCell(xc+1,yc+1); end; /// Обработать ячейку procedure ProcessCell(i,j: integer); begin case SosediA[i,j] of 0..1,4..9: if b[i,j]=1 then begin b[i,j] := 0; obn := True; DecSosedi(i,j); ClearCell(i,j); Dec(CountCells); end; 3: if b[i,j]=0 then begin b[i,j] := 1; obn := True; IncSosedi(i,j); DrawCell(i,j); Inc(CountCells); end; end; end; /// Перейти к следующему поколению procedure NextGen; var ifirst,jfirst,ilast,jlast: integer; begin for var ik:=1 to nk do begin for var jk:=1 to mk do begin obn := False; ifirst := (ik-1)*hn+1; ilast := (ik-1)*hn+hn; jfirst := (jk-1)*hm+1; jlast := (jk-1)*hm+hm; if obnovA[ik,jk] then begin for var i:=ifirst to ilast do for var j:=jfirst to jlast do ProcessCell(i,j); end else begin var ik1,jk1,ik2,jk2: integer; if ik=1 then ik1:=nk else ik1:=ik-1; if ik=nk then ik2:=1 else ik2:=ik+1; if jk=1 then jk1:=mk else jk1:=jk-1; if jk=mk then jk2:=1 else jk2:=jk+1; var l := obnovA[ik,jk1]; var r := obnovA[ik,jk2]; var u := obnovA[ik1,jk]; var d := obnovA[ik2,jk]; var lu := obnovA[ik1,jk1]; var ld := obnovA[ik2,jk1]; var ru := obnovA[ik1,jk2]; var rd := obnovA[ik2,jk2]; if u then for var j:=jfirst+1 to jlast-1 do ProcessCell(ifirst,j); if d then for var j:=jfirst+1 to jlast-1 do ProcessCell(ilast,j); if l then for var i:=ifirst+1 to ilast-1 do ProcessCell(i,jfirst); if r then for var i:=ifirst+1 to ilast-1 do ProcessCell(i,jlast); if u or l or lu then ProcessCell(ifirst,jfirst); if u or r or ru then ProcessCell(ifirst,jlast); if d or l or ld then ProcessCell(ilast,jfirst); if d or r or rd then ProcessCell(ilast,jlast); end; obnovB[ik,jk] := obn; end; end; end; /// Перерисовка содержимого окна procedure LifeRedrawProc; begin DrawConfigurationFull; end; /// Вывод номера поколения и количества ячеек procedure DrawInfo; begin Brush.Color := Color.LightGray; FillRectangle(0,0,Window.Width,20); Font.Size := 10; TextOut(15,5,’Поколение ‘+IntToStr(gen)); TextOut(Window.Width — 130,5,’Жителей: ‘+IntToStr(CountCells)+’ ‘); end; begin if (m mod mk<>0) or (n mod nk<>0) then begin writeln(‘Размер кластера не согласован с размером поля. Программа завершена’); exit end; hm := m div mk; hn := n div nk; Window.SetPos(200,50); Window.SetSize(x0+m*w,y0+n*w); Window.Title := ‘Игра Жизнь’; Init; DrawInfo; DrawField; DrawConfiguration; var mil := Milliseconds; gen := 0; Sleep(100); DrawField; while True do begin gen += 1; // if gen mod 11 = 0 then DrawInfo; SosediA := SosediB; obnovA := obnovB; NextGen; DrawConfiguration; Sleep(delay); end; end.

Источник: primat.org