Задача Програмування Pascal
Работа добавлена на сайт bukvasha.net: 2015-10-29Поможем написать учебную работу
Если у вас возникли сложности с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой - мы готовы помочь.
Зміст
Зміст
Постановка завдання
Теоретичне розв’язання задач
Методика підрахунку прямокутників різної форми
Фізичні основи та формули до завдання №2
Блок – схеми програми та процедур
Текст програми
Пояснення до програми
Результати роботи програми
Список використаної літератури
2. Постановка задачі
Створити програму на мові програмування Pascal згідно вибраного завдання
Задача №1: (1022) На квадратному аркуші клітчатого паперу розміром 8х8 кліток намальовано декілька прямокутників, кожний прямокутник складається із кліток. Різні прямокутники не накладаються і не доторкуються один іншого. Приклад:
Дана цілочисельна квадратна матриця розміром 8, де елемент =0 коли відповідна клітка належить деякому прямокутнику, і відмінний від 0 в противному разі. Визначити кількість прямокутників.
Задача №2: (1006) Скласти програму, яка допомагає у вивченні руху тіла, кинутого під кутом до горизонту з деякою початковою швидкістю. Гравець, що знає відстань від чоловіка, що кидає камінь, до лунки і ширину лунки, повинен задати такі початкові значення кута і швидкості, щоб камінь потрапив у лунку.
На екрані повинні відображатись поверхня землі, лунка, камінь і траєкторія польоту каменя. Відстань від чоловіка до лунки і ширину лунки слідує вибирати за допомогою датчика випадкових чисел.
3. Теоретичне розв’язання задач
3.1 Методика підрахунку прямокутників різної форми
В завданні №1 курсової роботи головною метою є визначення кількості прямокутників в матриці розміром 8х8, тобто елементи цієї матриці які дорівнюють 0 належать деякому прямокутнику, інакше – це пуста клітка. Так сукупність декількох таких елементів утворюють прямокутник довільної форми в залежності від розміщення елементів (індексів елементів). По умові задачі існуючі прямокутники мають правильну форму, не доторкаються один до одного і не накладаються.
Таким чином, ми маємо матрицю розміром 8х8, де елемент, який = 0 належить деякому прямокутнику, і якщо не = 0 – це пуста клітка. Розглянемо таку матрицю:
-
1
1
1
0
0
0
0
1
1
1
1
0
0
0
0
1
1
1
1
1
1
1
1
1
1
1
1
1
1
1
1
1
0
0
1
1
1
1
1
1
0
0
1
1
1
1
1
0
0
0
1
1
0
0
1
1
0
0
1
1
1
1
1
1
Принцип роботи заключається в наступному: програма починає шукати перший нульовий елемент:
-
Х
Після того, як знайдено перший нульовий елемент програма починає спочатку по горизонталі відшукувати їх і заміняти на 1. Коли буде досягнуто останнього нульового елемента програма переходить до наступного рядка, при чому номер стовпчика цього рядка буде співпадати з номером стовпчика першого нульового елемента:
-
Х
І так далі, доки весь прямокутник не буде повністю затертий, тобто, якщо елемент першої колонки прямокутника наступного рядка не буде = 0 (елемент Х попереднього рисунку). А після цього програма почне шукати наступний прямокутник. З кожним знайденим прямокутником лічильник збільшується на 1.
Таким чином: програма спочатку знаходить прямокутник, збільшує лічильник прямокутників, а потім затирає знайдений прямокутник.
Ось в якій черзі затираються елементи першого прямокутника:
-
1
2
3
4
5
6
6
8
Для решти:
-
1
2
3
4
5
6
6
8
1
2
3
4
1
5
6
1
2
7
8
3.2 Фізичні основи та формули до завдання №2
За допомогою ПК можна намалювати те, що важко замітити. Кидання каменя – наглядний приклад цьому. Але політ каменя проходить так швидко, що мозок не встигає фіксувати траєкторію його польоту. В той же час відомо, що політ каменя добре підчиняється простим законам механіки. За допомогою рівнянь руху і машинної графіки можна відтворити траєкторію польоту каменя.
Для того щоб відобразити цю траєкторію в фізиці вже давно виведено такі формули:
Спочатку потрібно знайти вертикальні і горизонтальні компоненти швидкості vx і vy за допомогою таких формул: vx=v*cos , vy=v*sin . Де: v – початкова сила кидка, - кут кидка.
Координати ядра в точці x і y в любий момент часу:
x=vx*t
y=vy*t-gt2/2
Де: t – час польоту каменя (від кидка), секунд
g – прискорення вільного падіння = 9.8 м/сек2
Для більшого реалізму польоту приріст часу прийнято 0.02 секунди.
4. Блок – схеми програми та процедур
5. Текст програми
uses crt,graph;
const full : fillpatterntype = ($ff, $ff, $ff, $ff, $ff, $ff, $ff, $ff);
brick: fillpatterntype = (255,1,1,1,255,16,16,16);
grass: fillpatterntype = ($55, $aa, $55, $aa, $55, $aa, $55, $aa);
g=9.8;
var maxx,mode,device,lnum,pnum:integer;
ch:char;
done:boolean;
matr:array [1..8,1..8] of integer;
label 1;
procedure draw;
var str: string;
begin
{************** Сейчас рисуем окно и рамку ******************}
cleardevice;
setbkcolor (black);
setcolor (green);
setfillpattern (full, blue);
bar3d (10,10,maxx-20,265,10,topon);
setfillpattern (full, green);
bar (180,10,181,265);
setfillpattern (full, black);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (yellow);
setfillpattern (full,black);
bar3d (40,40,150,65,0,topon);
bar3d (40,80,150,105,0,topon);
bar3d (40,120,150,145,0,topon);
bar3d (40,160,150,185,0,topon);
bar3d (40,200,150,225,0,topon);
setcolor (15);
outtextxy (50,50,'ЗАДАЧА № 1');
outtextxy (50,90,'ЗАДАЧА № 2');
outtextxy (50,130,'ЗАДАЧА № 3');
outtextxy (50,170,'ПРО АВТОРА');
outtextxy (50,210,'ВИХIД В DOS');
str:=('Клавiшами '#24#25' виберiть потрiбний пункт меню; ENTER - пiдтвердити вибiр.');
outtextxy (30,255,str);
end;
{******************** Эффект переливающихся букв ****************}
procedure flash (x,y,x1,y1,bk,oc:integer);
var c,t,xps,yps,pixcolor:integer;
begin
t:=0;
repeat
t:=t+1;
if t=16 then t:=0;
if t=bk then t:=t+1;
c:=t;
for xps:=x to x1 do
begin
for yps:=y to y1 do if getpixel (xps,yps) <>bk then putpixel (xps,yps,c);
c:=c+1;
if c=16 then c:=0;
if c=bk then c:=c+1;
end;
until keypressed;
for xps:=x to x1 do
begin
for yps:=y to y1 do
begin
pixcolor:=getpixel (xps,yps);
if pixcolor <>bk then putpixel (xps,yps,oc)
end;
end;
end;
{******************* Рамка курсора ****************}
procedure ramka;
var t:integer;
begin
setcolor (blue);
t:=lnum*40-5;
rectangle (25,t,165,t+36);
setcolor (12);
t:=pnum*40-5;
rectangle (25,t,165,t+36);
flash (50,t+13,140,t+23,black,white);
end;
{********************** Процедура "Про автора" *******************}
procedure about;
var str:string;
exit:boolean;
maxx:integer;
begin
exit:=false;
maxx:=getmaxx;
setfillpattern (full, black);
bar (11,11,maxx-21,254);
setcolor (green);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
str:='Esc - вихiд.';
outtextxy (30,255,str);
settextstyle (defaultfont,horizdir,2);
setcolor (red);
str:='Курсова робота';
outtextxy (180,30,str);
settextstyle (defaultfont,horizdir,1);
setcolor (white);
str:='З дисциплiни:';
outtextxy (100,60,str);
setcolor (13);
str:='Основи програмування та алгоритмiчнi мови';
outtextxy (120,80,str);
setcolor (white);
str:='Виконав:';
outtextxy (100,100,str);
setcolor (13);
str:='Студент групи КС-91';
outtextxy (120,120,str);
setcolor (10);
settextstyle (defaultfont,horizdir,2);
str:='Семенуха Сергiй Павлович';
outtextxy (120,140,str);
settextstyle (defaultfont,horizdir,1);
setcolor (11);
str:='[email protected]';
outtextxy (120,220,str);
setcolor (12);
str:='20.V.2000';
outtextxy (500,220,str);
setcolor (red);
settextstyle (defaultfont,horizdir,1);
flash (180,30,502,45,0,12);
repeat
case readkey of
#27: exit:=true;
end;
until exit;
draw;
ramka;
end;
{******************** Рисует курсор в матрице к задаче №1 **************}
procedure curpos (x1,y1,x,y:integer);
var xc,yc:integer;
begin
xc:=40+x1*10;
yc:=40+y1*10;
setcolor (0);
rectangle (xc,yc,xc+10,yc+10);
xc:=40+x*10;
yc:=40+y*10;
setcolor (10);
rectangle (xc,yc,xc+10,yc+10);
end;
{******************** Печать исходной матрицы к зад. №1 ******************}
procedure printmatrix;
var i,j,x,y:integer;
begin
setcolor (12);
rectangle (49,49,131,131);
for i:=1 to 8 do
begin
for j:=1 to 8 do
begin
x:=41+i*10;
y:=41+j*10;
if matr [i,j]=0 then
setfillpattern (full,white)
else setfillpattern (full,black);
bar (x,y,x+8,y+8);
end;
end;
end;
{*************** Процедура подщета кол-ва прямоуг. ********************}
procedure count;
var i,j,num,ti,tj:integer;
yes,ok:boolean;
st:string;
begin
num:=0;
yes:=false;
ok:=false;
for j:=1 to 8 do
begin
for i:=1 to 8 do
begin
if matr[i,j]=0 then
begin
num:=num+1;
tj:=j;
ti:=i;
repeat
yes:=false;
repeat
matr [ti,tj]:=1;
inc (ti);
if matr[ti,tj]<>0 then yes:=true;
until yes;
inc (tj);
ti:=i;
if matr[ti,tj]<>0 then ok:=true;
until ok;
ok:=false;
end;
end;
end;
setfillpattern (full,black);
bar (150,55,600,200);
setcolor (white);
st:='В матрицi';
outtextxy (230,60,st);
str (num,st);
outtextxy (310,60,st);
st:='прямокутникiв';
outtextxy (330,60,st);
setcolor (green);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
st:='Натиснiть любу клавiшу.';
outtextxy (30,255,st);
end;
{***************** Основная процедура задания №1 **************}
procedure zad1;
var str:string;
exit:boolean;
i,j,maxx,xcur,ycur:integer;
begin
exit:=false;
maxx:=getmaxx;
setfillpattern (full, black);
setcolor (green);
bar (11,11,maxx-21,264);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (11);
str:='Умова задачi:';
outtextxy (200,40,str);
setcolor (white);
str:='На квадратному аркушi клiтчатого паперу розмiром 8х8 клiток намальовано';
outtextxy (35,60,str);
str:='декiлька прямокутникiв, кожен прямокутник складаеться iз клiток. Рiзнi';
outtextxy (35,75,str);
str:='прямокутники не накладаються один до одного i не доторкаються. Дана';
outtextxy (35,90,str);
str:='цiлочисельна квадратна матриця 8-го порядку, де елемент = 0 - якщо вiд-';
outtextxy (35,105,str);
str:='повiдна клiтка належить деякому прямокутнику, i вiдмiнний вiд 0 - якщо';
outtextxy (35,120,str);
str:='елемент не належить жодному прямокутнику.';
outtextxy (35,135,str);
str:='Натиснiть любу клавiшу';
outtextxy (30,255,str);
readkey;
setcolor (green);
bar (11,11,maxx-21,264);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
str:='Enter - пiдрахунок прямокутникiв. Esc - вихiд.';
outtextxy (30,255,str);
str:=#27#24#25#26' - перемiщення курсора по матрицi.';
outtextxy (230,55,str);
str:='Space - поставити/зтерти сегмент.';
outtextxy (230,70,str);
setcolor (red);
str:='Умова: прямокутники повиннi бути правильнoi форми,';
outtextxy (150,150,str);
str:='i не повиннi доторкатись один до одного!!!';
outtextxy (160,165,str);
for i:=1 to 8 do for j:=1 to 8 do matr [i,j]:=1;
printmatrix;
xcur:=1;
ycur:=1;
curpos (xcur,ycur,xcur,ycur);
repeat
case readkey of
#0:begin
ch:=readkey;
case ch of
#77: begin
xcur:=xcur+1;
if xcur>8 then xcur:=8;
curpos (xcur-1,ycur,xcur,ycur);
end;
#75: begin
xcur:=xcur-1;
if xcur<1 then xcur:=1;
curpos (xcur+1,ycur,xcur,ycur);
end;
#80: begin
ycur:=ycur+1;
if ycur>8 then ycur:=8;
curpos (xcur,ycur-1,xcur,ycur);
end;
#72: begin
ycur:=ycur-1;
if ycur<1 then ycur:=1;
curpos (xcur,ycur+1,xcur,ycur);
end;
end;
end;
' ': begin
if matr[xcur,ycur]=0 then
matr[xcur,ycur]:=1
else matr[xcur,ycur]:=0;
printmatrix;
end;
#27: exit:=true;
#13: begin
count;
exit:=true;
readkey;
end;
end;
until exit;
draw;
ramka;
end;
{************** Основная процедура задания №2 ****************}
procedure zad2;
var st:string;
shoot,exit:boolean;
tx,ty,sx,len,angle,speed,maxx,x,y,e,x1,y1:integer;
t,an,vx,vy,xx,yy:real;
label 2;
begin
randomize;
maxx:=getmaxx;
setfillpattern (full, black);
setcolor (green);
bar (11,11,maxx-21,264);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (11);
st:='Умова задачi:';
outtextxy (200,40,st);
setcolor (white);
st:='Скласти пограму, яка допомагае у вивченнi руху тiла, кинутого пiд кутом';
outtextxy (35,60,st);
st:='до горизонту з деякою початковою швидкiстю. Гравець повинен задати такi';
outtextxy (35,75,st);
st:='значення кута i сили кидка, щоб камiнь потрапив у лунку. На екранi по-';
outtextxy (35,90,st);
st:='виннi бути вiдображенi поверхня землi, лунка, камiнь, i траекторiя по-';
outtextxy (35,105,st);
st:='льоту камня. Вiддаль вiд людини до лунки, та ширина лунки задаються ге-';
outtextxy (35,120,st);
st:='нератором випадкових чисел.';
outtextxy (35,135,st);
st:='Натиснiть любу клавiшу';
outtextxy (30,255,st);
readkey;
setcolor (green);
bar (11,11,maxx-21,264);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
st:=('Вибрати: '#24#25' - силу кидка, '#27#26' - кут кидка. Enter - кидок. Esc - вихiд.');
outtextxy (30,255,st);
setfillpattern (brick, red);
setcolor (green);
bar (11,235,maxx-21,248);
setfillpattern (grass, green);
setcolor (green);
bar (11,230,maxx-21,235);
setfillpattern (full,black);
sx:=230+random (300);
len:=30+random (50);
bar (sx,230,sx+len,235);
angle:=45;
speed:=50;
setcolor (white);
st:= 'Сила кидка: ';
outtextxy (15,20,st);
st:= 'Кут кидка: ';
outtextxy (15,30,st);
str (speed,st);
outtextxy (120,20,st);
str (angle,st);
outtextxy (120,30,st);
setcolor (yellow);
line (20,230,27,215);
line (27,215,34,230);
line (27,215,27,197);
line (27,200,18,215);
line (27,200,33,195);
line (33,195,33,185);
circle (27,193,4);
setcolor (red);
circle (33,183,1);
setcolor (white);
setfillpattern (full,black);
shoot:=false;
exit:=false;
repeat
ch:=readkey;
case ch of
#0:begin
ch:=readkey;
case ch of
#77: begin
dec (angle);
if angle < 0 then angle:=0;
str (angle,st);
bar (120,30,140,40);
outtextxy (120,30,st);
end;
#75: begin
inc (angle);
if angle >90 then angle:=90;
str (angle,st);
bar (120,30,140,40);
outtextxy (120,30,st);
end;
#80: begin
dec (speed);
if speed < 0 then speed:=0;
str (speed,st);
bar (120,20,145,29);
outtextxy (120,20,st);
end;
#72: begin
inc (speed);
if speed >100 then speed:=100;
str (speed,st);
bar (120,20,145,29);
outtextxy (120,20,st);
end;
end;
end;
#27: exit:=true;
#13: begin
shoot:=true;
setcolor (black);
line (33,195,33,185);
circle (33,183,1);
circle (33,183,2);
setcolor (yellow);
line (33,195,37,190);
end;
' ': begin
shoot:=true;
setcolor (black);
line (33,195,33,185);
circle (33,183,1);
circle (33,183,2);
setcolor (yellow);
line (33,195,37,190);
end;
end;
until shoot or exit;
setcolor (0);
bar (12,20,150,40);
setcolor (red);
an:=(angle*3.14)/180;
t:=0;
vx:=speed*cos (an);
vy:=speed*sin (an);
y:=round(vy*t-(g*t*t)/2);
x:=round(vx*t);
while not exit do
begin
x:=x+37;
if (y<-43) or (x>615) then begin
tx:=x; ty:=y;
t:=sx+len+2;
setcolor (yellow);
if (x>sx) and (x<t) then
st:='Поздоровляю!!! Ви влучили!!!!!!!!'
else st:='Потрiбно ще трохи потренуватися...';
exit:=true;
outtextxy (200,20,st);
readkey;
goto 2;
end;
setcolor (0);
line (x-5,7,x-1,5);
putpixel (x,7,yellow);
setcolor (yellow);
if y<178 then
begin
putpixel (x,190-y,red);
circle (x,190-y,1);
end;
t:=t+0.02;
delay (15);
setcolor (0);
if y<178 then circle (x,190-y,1);
y:=round(vy*t-(g*t*t)/2);
x:=round(vx*t);
t:=t+0.02;
if keypressed then
begin
if readkey=#27 then exit:=true;
end;
end;
2:
setcolor (yellow);
circle (tx,190-ty,1);
setcolor (green);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
draw;
end;
{*********************** Задание №3 **************************}
procedure zad3;
var str:string;
exit:boolean;
a,b,c,i,x1,x2,x3:integer;
p: pointer;
size: word;
label 10;
begin
setfillpattern (full, black);
setcolor (green);
bar (11,11,maxx-21,264);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
str:='Esc - вихiд.';
outtextxy (30,255,str);
randomize;
exit:=false;
setcolor (black);
setfillpattern (brick,red);
bar (11,11,maxx-21,249);
setfillpattern (full,black);
setcolor (red);
bar3d (26,24,maxx-36,236,0,topon);
setcolor (green);
str:='Оце i е задача з графiки.';
outtextxy (200,40,str);
setcolor (white);
for i:=0 to 15 do
begin
setcolor (i);
circle (350,150,i);
i:=i+1;
end;
size:=imagesize (335,135,365,165);
getmem (p,size);
getimage (335,135,365,165,p^);
putimage (335,135,p^,xorput);
a:=0;
b:=50;
c:=90;
x1:=1000;
x2:=1000;
x3:=1000;
repeat
10:
putimage (150,203-x1,p^,xorput);
putimage (300,203-x2,p^,xorput);
putimage (450,203-x3,p^,xorput);
inc (a);
if a=181 then a:=0;
inc (b);
if b=181 then b:=0;
inc (c);
if c=181 then c:=0;
x1:=round (120*(sin(a*pi/180)));
x2:=round (120*(sin(b*pi/180)));
x3:=round (120*(sin(c*pi/180)));
putimage (150,203-x1,p^,xorput);
putimage (300,203-x2,p^,xorput);
putimage (450,203-x3,p^,xorput);
if not keypressed then goto 10;
case readkey of
#27: exit:=true;
end;
until exit;
draw;
ramka;
end;
{**************** ОСНОВНАЯ ПРОГРАММА *****************}
begin
device:=VGA;
mode:=VGAHi;
initgraph (device,mode,'');
cleardevice;
maxx:=getmaxx;
pnum:=1;
lnum:=1;
draw;
repeat
ramka;
ch:=readkey;
case ch of
#0:begin
ch:=readkey;
case ch of
#80: begin
lnum:=pnum;
pnum:=pnum+1;
if pnum=6 then pnum:=1;
ramka;
end;
#72: begin
lnum:=pnum;
pnum:=pnum-1;
if pnum=0 then pnum:=5;
ramka;
end;
end;
end;
#13: begin
if pnum=1 then zad1;
if pnum=2 then zad2;
if pnum=3 then zad3;
if pnum=4 then about;
if pnum=5 then done:=true;
end;
#27: done:=true; { Pressing ESC }
#3: done:=true; { Pressing Ctrl+C }
end;
until done;
closegraph;
write ('До побачення!!!');
end.
6. Пояснення до програми
Глобальні константи:
Назва
Тип
Призначення
Full
Тип заливки
Повністю замальована текстура
Brick
Тип заливки
Текстура вигляду цегли
Grass
Тип заливки
Текстура вигляду трави
G
Integer
Прискорення вільного падіння = 9.8
Глобальні змінні:
Назва
Тип
Призначення
Device
Integer
Тип адаптера для відеорежиму
Mode
Integer
Відеорежим
Pnum
Integer
Номер пункту меню, на який вказує курсор
Lnum
Integer
Номер пункту меню, на який вказував курсор до його переміщення
Ch
Char
Код натиснутої клавіші
Done
Boolean
Вихід – так/ні (true/false відповідно)
Matr
Масив 8х8 із елементів типу Integer
Масив даних (прямокутників) до завдання №1
Змінні, які застосовуються в процедурі Ramka (малює рамку курсора)
Назва
Тип
Призначення
T
Integer
Координата Y верхнього лівого кутка рамки
Pnum
Integer
Номер пункту меню, на який вказує курсор
Lnum
Integer
Номер пункту меню, на який вказував курсор до його переміщення
Змінні, які застосовуються в процедурі Flash (ефект переливання букв)
Назва
Тип
Призначення
С
Integer
Поточний колір замальовування
T
Integer
Поточний колір замальовування
Xps
Integer
Горизонтальна координата на екрані
Yps
Integer
Вертикальна координата на екрані
Pixcolor
Integer
Колір пікселя в поточних координатах
X
Integer
Координати верхнього лівого кута зони
Y
Integer
X1
Integer
Координати нижнього правого кута зони
Y1
Integer
Bk
Integer
Колір фона екрана
Oc
Integer
Колір, яким замальовується зображення перед виходом із процедури
Змінні, які застосовуються в процедурі About (задача “Про автора”)
Назва
Тип
Призначення
Str
String
Для тимчасового зберігання написів
Exit
Boolean
Вихід – так/ні
Змінні, які застосовуються в процедурі Curpos (виводить на екран курсор на матриці до задачі №1)
Назва
Тип
Призначення
X
Integer
Координата X курсору на екрані
Y
Integer
Координата Y курсору на екрані
X1
Integer
Координата X курсору на екрані до переміщення
Y1
Integer
Координата Y курсору на екрані до переміщення
Xc
Integer
Координата X прямокутника на екрані
Yc
Integer
Координата Y прямокутника на екрані
Змінні, які застосовуються в процедурі Printmatrix (виводить на екран матрицю до задачі №1)
Назва
Тип
Призначення
I
Integer
Використовується в циклі
J
Integer
Використовується в циклі
X
Integer
Координата X прямокутника на екрані
Y
Integer
Координата Y прямокутника на екрані
Mas
Масив 8х8 із елементів типу Integer
Масив даних (прямокутників)
Змінні, які застосовуються в процедурі Count (підрахунок прямокутників)
Назва
Тип
Призначення
Mas
Масив 8х8 із елементів типу Integer
Масив даних (прямокутників)
I
Integer
Використовується в циклах
J
Integer
Використовується в циклах
Num
Integer
Кількість прямокутників
Ti
Integer
Тимчасова координата
Tj
Integer
Тимчасова координата
Yes
Boolean
Умова роботи горизонтального пошуку
Ok
Boolean
Умова роботи вертикального пошуку
St
String
Для тимчасового зберігання тексту
Змінні, які застосовуються в процедурі Zad1 (завдання №1)
Назва
Тип
Призначення
Str
String
Для тимчасового зберігання тексту
Exit
Boolean
Вихід із процедури – так/ні
I
Integer
Використовується в циклах
J
Integer
Використовується в циклах
Xcur
Integer
Координата курсору
Ycur
Integer
Координата курсору
Змінні, які застосовуються в процедурі Zad2 (завдання №2)
Назва
Тип
Призначення
St
String
Для тимчасового зберігання тексту
Shoot
Boolean
Признак “кидок” – так/ні
Exit
Boolean
Признак “вихід” – так/ні
Sx
Integer
Ширина лунки
Len
Integer
Відстань від людини до лунки
Angle
Integer
Кут кидка
Speed
Integer
Сила кидка
X
Integer
Координата каменя
Y
Integer
Координата каменя
T
Real
Час польоту каменя
An
Real
Кут кидка в радіанах
Vx
Real
Горизонтальна складова сили
Vy
Real
Вертикальна складова сили
Xx
Real
Координата каменя
Yy
Real
Координата каменя
Змінні, які застосовуються в процедурі Zad3 (завдання №3)
Назва
Тип
Призначення
Str
String
Для тимчасового зберігання тексту
Exit
Boolean
Признак “вихід” із процедури – так/ні
A
Integer
Кут випередження м’яча 1
B
Integer
Кут випередження м’яча 2
C
Integer
Кут випередження м’яча 3
I
Integer
Використовується в циклі
X1
Integer
Координата Х для м’яча 1
X2
Integer
Координата Х для м’яча 2
X3
Integer
Координата Х для м’яча 3
P
Pointer
Вказівник на зображення в пам’яті
Size
Word
Розмір зображення
7. Результати роботи програми
Після запуску програми побачимо таке вікно (меню):
Клавішами вибираємо пункт меню і натискаємо клавішу ENTER. Наприклад наводимо курсор на пункт “ЗАДАЧА №1” і натискаємо клавішу ENTER. З’явиться таке вікно:
Потім натискаємо на любу клавішу:
заповнюємо матрицю (малюємо прямокутники згідно умови), натискаємо клавішу ENTER, програма підрахує кількість прямокутників і виведе результат:
Натискаємо любу клавішу і повертаємося в головне меню, наводимо курсор на пункт “ЗАДАЧА №2” і натискаємо клавішу ENTER:
Натискаємо любу клавішу, задаємо початкові значення сили і кута кидка:
Натискаємо клавішу ENTER і очікуємо, доки камінь впаде у лунку:
Тепер достатньо натиснути будь-яку клавішу, і повертаємось в головне меню, вибираємо пункт “ЗАДАЧА №3”:
Натискаємо Escape – повертаємось в головне меню, вибираємо пункт “ПРО АВТОРА”:
Натискаємо Escape – повертаємось в головне меню, вибираємо пункт “ВИХІД В DOS”, і повертаємось в DOS чи в Turbo Pascal, в залежності від того звідки запускається програма.
8. Список використаної літератури
Т.Б. Романовский «Микрокалькуляторы в рассказах и играх», Радянська школа 1989
В.С. Волькенштейн «Сборник задач по общему курсу физики», Наука 1973
С.А. Абрамов «Задачи по программированию», Наука 1988
В.З. Аладьев, В.Г. Тупало «Turbo Pascal для всех», Техніка 1993
Р. Хершель «Turbo Pascal 4.0/5.0», МИК 1991.
ТЕКСТ ПРОГРАМИ
uses crt,graph;
const full : fillpatterntype = ($ff, $ff, $ff, $ff, $ff, $ff, $ff, $ff);
brick: fillpatterntype = (255,1,1,1,255,16,16,16);
grass: fillpatterntype = ($55, $aa, $55, $aa, $55, $aa, $55, $aa);
g=9.8;
var maxx,mode,device,lnum,pnum:integer;
ch:char;
done:boolean;
matr:array [1..8,1..8] of integer;
label 1;
procedure draw;
var str: string;
begin
{************** Сейчас рисуем окно и рамку ******************}
cleardevice;
setbkcolor (black);
setcolor (green);
setfillpattern (full, blue);
bar3d (10,10,maxx-20,265,10,topon);
setfillpattern (full, green);
bar (180,10,181,265);
setfillpattern (full, black);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (yellow);
setfillpattern (full,black);
bar3d (40,40,150,65,0,topon);
bar3d (40,80,150,105,0,topon);
bar3d (40,120,150,145,0,topon);
bar3d (40,160,150,185,0,topon);
bar3d (40,200,150,225,0,topon);
setcolor (15);
outtextxy (50,50,'ЗАДАЧА № 1');
outtextxy (50,90,'ЗАДАЧА № 2');
outtextxy (50,130,'ЗАДАЧА № 3');
outtextxy (50,170,'ПРО АВТОРА');
outtextxy (50,210,'ВИХIД В DOS');
str:=('Клавiшами '#24#25' виберiть потрiбний пункт меню; ENTER - пiдтвердити вибiр.');
outtextxy (30,255,str);
end;
{******************** Эффект переливающихся букв ****************}
procedure flash (x,y,x1,y1,bk,oc:integer);
var c,t,xps,yps,pixcolor:integer;
begin
t:=0;
repeat
t:=t+1;
if t=16 then t:=0;
if t=bk then t:=t+1;
c:=t;
for xps:=x to x1 do
begin
for yps:=y to y1 do if getpixel (xps,yps) <>bk then putpixel (xps,yps,c);
c:=c+1;
if c=16 then c:=0;
if c=bk then c:=c+1;
end;
until keypressed;
for xps:=x to x1 do
begin
for yps:=y to y1 do
begin
pixcolor:=getpixel (xps,yps);
if pixcolor <>bk then putpixel (xps,yps,oc)
end;
end;
end;
{******************* Рамка курсора ****************}
procedure ramka;
var t:integer;
begin
setcolor (blue);
t:=lnum*40-5;
rectangle (25,t,165,t+36);
setcolor (12);
t:=pnum*40-5;
rectangle (25,t,165,t+36);
flash (50,t+13,140,t+23,black,white);
end;
{********************** Процедура "Про автора" *******************}
procedure about;
var str:string;
exit:boolean;
maxx:integer;
begin
exit:=false;
maxx:=getmaxx;
setfillpattern (full, black);
bar (11,11,maxx-21,254);
setcolor (green);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
str:='Esc - вихiд.';
outtextxy (30,255,str);
settextstyle (defaultfont,horizdir,2);
setcolor (red);
str:='Курсова робота';
outtextxy (180,30,str);
settextstyle (defaultfont,horizdir,1);
setcolor (white);
str:='З дисциплiни:';
outtextxy (100,60,str);
setcolor (13);
str:='Основи програмування та алгоритмiчнi мови';
outtextxy (120,80,str);
setcolor (white);
str:='Виконав:';
outtextxy (100,100,str);
setcolor (13);
str:='Студент групи КС-91';
outtextxy (120,120,str);
setcolor (10);
settextstyle (defaultfont,horizdir,2);
str:='Семенуха Сергiй Павлович';
outtextxy (120,140,str);
settextstyle (defaultfont,horizdir,1);
setcolor (11);
str:='[email protected]';
outtextxy (120,220,str);
setcolor (12);
str:='20.V.2000';
outtextxy (500,220,str);
setcolor (red);
settextstyle (defaultfont,horizdir,1);
flash (180,30,502,45,0,12);
repeat
case readkey of
#27: exit:=true;
end;
until exit;
draw;
ramka;
end;
{******************** Рисует курсор в матрице к задаче №1 **************}
procedure curpos (x1,y1,x,y:integer);
var xc,yc:integer;
begin
xc:=40+x1*10;
yc:=40+y1*10;
setcolor (0);
rectangle (xc,yc,xc+10,yc+10);
xc:=40+x*10;
yc:=40+y*10;
setcolor (10);
rectangle (xc,yc,xc+10,yc+10);
end;
{******************** Печать исходной матрицы к зад. №1 ******************}
procedure printmatrix;
var i,j,x,y:integer;
begin
setcolor (12);
rectangle (49,49,131,131);
for i:=1 to 8 do
begin
for j:=1 to 8 do
begin
x:=41+i*10;
y:=41+j*10;
if matr [i,j]=0 then
setfillpattern (full,white)
else setfillpattern (full,black);
bar (x,y,x+8,y+8);
end;
end;
end;
{*************** Процедура подщета кол-ва прямоуг. ********************}
procedure count;
var i,j,num,ti,tj:integer;
yes,ok:boolean;
st:string;
begin
num:=0;
yes:=false;
ok:=false;
for j:=1 to 8 do
begin
for i:=1 to 8 do
begin
if matr[i,j]=0 then
begin
num:=num+1;
tj:=j;
ti:=i;
repeat
yes:=false;
repeat
matr [ti,tj]:=1;
inc (ti);
if matr[ti,tj]<>0 then yes:=true;
until yes;
inc (tj);
ti:=i;
if matr[ti,tj]<>0 then ok:=true;
until ok;
ok:=false;
end;
end;
end;
setfillpattern (full,black);
bar (150,55,600,200);
setcolor (white);
st:='В матрицi';
outtextxy (230,60,st);
str (num,st);
outtextxy (310,60,st);
st:='прямокутникiв';
outtextxy (330,60,st);
setcolor (green);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
st:='Натиснiть любу клавiшу.';
outtextxy (30,255,st);
end;
{***************** Основная процедура задания №1 **************}
procedure zad1;
var str:string;
exit:boolean;
i,j,maxx,xcur,ycur:integer;
begin
exit:=false;
maxx:=getmaxx;
setfillpattern (full, black);
setcolor (green);
bar (11,11,maxx-21,264);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (11);
str:='Умова задачi:';
outtextxy (200,40,str);
setcolor (white);
str:='На квадратному аркушi клiтчатого паперу розмiром 8х8 клiток намальовано';
outtextxy (35,60,str);
str:='декiлька прямокутникiв, кожен прямокутник складаеться iз клiток. Рiзнi';
outtextxy (35,75,str);
str:='прямокутники не накладаються один до одного i не доторкаються. Дана';
outtextxy (35,90,str);
str:='цiлочисельна квадратна матриця 8-го порядку, де елемент = 0 - якщо вiд-';
outtextxy (35,105,str);
str:='повiдна клiтка належить деякому прямокутнику, i вiдмiнний вiд 0 - якщо';
outtextxy (35,120,str);
str:='елемент не належить жодному прямокутнику.';
outtextxy (35,135,str);
str:='Натиснiть любу клавiшу';
outtextxy (30,255,str);
readkey;
setcolor (green);
bar (11,11,maxx-21,264);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
str:='Enter - пiдрахунок прямокутникiв. Esc - вихiд.';
outtextxy (30,255,str);
str:=#27#24#25#26' - перемiщення курсора по матрицi.';
outtextxy (230,55,str);
str:='Space - поставити/зтерти сегмент.';
outtextxy (230,70,str);
setcolor (red);
str:='Умова: прямокутники повиннi бути правильнoi форми,';
outtextxy (150,150,str);
str:='i не повиннi доторкатись один до одного!!!';
outtextxy (160,165,str);
for i:=1 to 8 do for j:=1 to 8 do matr [i,j]:=1;
printmatrix;
xcur:=1;
ycur:=1;
curpos (xcur,ycur,xcur,ycur);
repeat
case readkey of
#0:begin
ch:=readkey;
case ch of
#77: begin
xcur:=xcur+1;
if xcur>8 then xcur:=8;
curpos (xcur-1,ycur,xcur,ycur);
end;
#75: begin
xcur:=xcur-1;
if xcur<1 then xcur:=1;
curpos (xcur+1,ycur,xcur,ycur);
end;
#80: begin
ycur:=ycur+1;
if ycur>8 then ycur:=8;
curpos (xcur,ycur-1,xcur,ycur);
end;
#72: begin
ycur:=ycur-1;
if ycur<1 then ycur:=1;
curpos (xcur,ycur+1,xcur,ycur);
end;
end;
end;
' ': begin
if matr[xcur,ycur]=0 then
matr[xcur,ycur]:=1
else matr[xcur,ycur]:=0;
printmatrix;
end;
#27: exit:=true;
#13: begin
count;
exit:=true;
readkey;
end;
end;
until exit;
draw;
ramka;
end;
{************** Основная процедура задания №2 ****************}
procedure zad2;
var st:string;
shoot,exit:boolean;
tx,ty,sx,len,angle,speed,maxx,x,y,e,x1,y1:integer;
t,an,vx,vy,xx,yy:real;
label 2;
begin
randomize;
maxx:=getmaxx;
setfillpattern (full, black);
setcolor (green);
bar (11,11,maxx-21,264);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (11);
st:='Умова задачi:';
outtextxy (200,40,st);
setcolor (white);
st:='Скласти пограму, яка допомагае у вивченнi руху тiла, кинутого пiд кутом';
outtextxy (35,60,st);
st:='до горизонту з деякою початковою швидкiстю. Гравець повинен задати такi';
outtextxy (35,75,st);
st:='значення кута i сили кидка, щоб камiнь потрапив у лунку. На екранi по-';
outtextxy (35,90,st);
st:='виннi бути вiдображенi поверхня землi, лунка, камiнь, i траекторiя по-';
outtextxy (35,105,st);
st:='льоту камня. Вiддаль вiд людини до лунки, та ширина лунки задаються ге-';
outtextxy (35,120,st);
st:='нератором випадкових чисел.';
outtextxy (35,135,st);
st:='Натиснiть любу клавiшу';
outtextxy (30,255,st);
readkey;
setcolor (green);
bar (11,11,maxx-21,264);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
st:=('Вибрати: '#24#25' - силу кидка, '#27#26' - кут кидка. Enter - кидок. Esc - вихiд.');
outtextxy (30,255,st);
setfillpattern (brick, red);
setcolor (green);
bar (11,235,maxx-21,248);
setfillpattern (grass, green);
setcolor (green);
bar (11,230,maxx-21,235);
setfillpattern (full,black);
sx:=230+random (300);
len:=30+random (50);
bar (sx,230,sx+len,235);
angle:=45;
speed:=50;
setcolor (white);
st:= 'Сила кидка: ';
outtextxy (15,20,st);
st:= 'Кут кидка: ';
outtextxy (15,30,st);
str (speed,st);
outtextxy (120,20,st);
str (angle,st);
outtextxy (120,30,st);
setcolor (yellow);
line (20,230,27,215);
line (27,215,34,230);
line (27,215,27,197);
line (27,200,18,215);
line (27,200,33,195);
line (33,195,33,185);
circle (27,193,4);
setcolor (red);
circle (33,183,1);
setcolor (white);
setfillpattern (full,black);
shoot:=false;
exit:=false;
repeat
ch:=readkey;
case ch of
#0:begin
ch:=readkey;
case ch of
#77: begin
dec (angle);
if angle < 0 then angle:=0;
str (angle,st);
bar (120,30,140,40);
outtextxy (120,30,st);
end;
#75: begin
inc (angle);
if angle >90 then angle:=90;
str (angle,st);
bar (120,30,140,40);
outtextxy (120,30,st);
end;
#80: begin
dec (speed);
if speed < 0 then speed:=0;
str (speed,st);
bar (120,20,145,29);
outtextxy (120,20,st);
end;
#72: begin
inc (speed);
if speed >100 then speed:=100;
str (speed,st);
bar (120,20,145,29);
outtextxy (120,20,st);
end;
end;
end;
#27: exit:=true;
#13: begin
shoot:=true;
setcolor (black);
line (33,195,33,185);
circle (33,183,1);
circle (33,183,2);
setcolor (yellow);
line (33,195,37,190);
end;
' ': begin
shoot:=true;
setcolor (black);
line (33,195,33,185);
circle (33,183,1);
circle (33,183,2);
setcolor (yellow);
line (33,195,37,190);
end;
end;
until shoot or exit;
setcolor (0);
bar (12,20,150,40);
setcolor (red);
an:=(angle*3.14)/180;
t:=0;
vx:=speed*cos (an);
vy:=speed*sin (an);
y:=round(vy*t-(g*t*t)/2);
x:=round(vx*t);
while not exit do
begin
x:=x+37;
if (y<-43) or (x>615) then begin
tx:=x; ty:=y;
t:=sx+len+2;
setcolor (yellow);
if (x>sx) and (x<t) then
st:='Поздоровляю!!! Ви влучили!!!!!!!!'
else st:='Потрiбно ще трохи потренуватися...';
exit:=true;
outtextxy (200,20,st);
readkey;
goto 2;
end;
setcolor (0);
line (x-5,7,x-1,5);
putpixel (x,7,yellow);
setcolor (yellow);
if y<178 then
begin
putpixel (x,190-y,red);
circle (x,190-y,1);
end;
t:=t+0.02;
delay (15);
setcolor (0);
if y<178 then circle (x,190-y,1);
y:=round(vy*t-(g*t*t)/2);
x:=round(vx*t);
t:=t+0.02;
if keypressed then
begin
if readkey=#27 then exit:=true;
end;
end;
2:
setcolor (yellow);
circle (tx,190-ty,1);
setcolor (green);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
draw;
end;
{*********************** Задание №3 **************************}
procedure zad3;
var str:string;
exit:boolean;
a,b,c,i,x1,x2,x3:integer;
p: pointer;
size: word;
label 10;
begin
setfillpattern (full, black);
setcolor (green);
bar (11,11,maxx-21,264);
bar3d (10,250,maxx-20,265,0,topon);
setcolor (white);
str:='Esc - вихiд.';
outtextxy (30,255,str);
randomize;
exit:=false;
setcolor (black);
setfillpattern (brick,red);
bar (11,11,maxx-21,249);
setfillpattern (full,black);
setcolor (red);
bar3d (26,24,maxx-36,236,0,topon);
setcolor (green);
str:='Оце i е задача з графiки.';
outtextxy (200,40,str);
setcolor (white);
for i:=0 to 15 do
begin
setcolor (i);
circle (350,150,i);
i:=i+1;
end;
size:=imagesize (335,135,365,165);
getmem (p,size);
getimage (335,135,365,165,p^);
putimage (335,135,p^,xorput);
a:=0;
b:=50;
c:=90;
x1:=1000;
x2:=1000;
x3:=1000;
repeat
10:
putimage (150,203-x1,p^,xorput);
putimage (300,203-x2,p^,xorput);
putimage (450,203-x3,p^,xorput);
inc (a);
if a=181 then a:=0;
inc (b);
if b=181 then b:=0;
inc (c);
if c=181 then c:=0;
x1:=round (120*(sin(a*pi/180)));
x2:=round (120*(sin(b*pi/180)));
x3:=round (120*(sin(c*pi/180)));
putimage (150,203-x1,p^,xorput);
putimage (300,203-x2,p^,xorput);
putimage (450,203-x3,p^,xorput);
if not keypressed then goto 10;
case readkey of
#27: exit:=true;
end;
until exit;
draw;
ramka;
end;
{**************** ОСНОВНАЯ ПРОГРАММА *****************}
begin
device:=VGA;
mode:=VGAHi;
initgraph (device,mode,'');
cleardevice;
maxx:=getmaxx;
pnum:=1;
lnum:=1;
draw;
repeat
ramka;
ch:=readkey;
case ch of
#0:begin
ch:=readkey;
case ch of
#80: begin
lnum:=pnum;
pnum:=pnum+1;
if pnum=6 then pnum:=1;
ramka;
end;
#72: begin
lnum:=pnum;
pnum:=pnum-1;
if pnum=0 then pnum:=5;
ramka;
end;
end;
end;
#13: begin
if pnum=1 then zad1;
if pnum=2 then zad2;
if pnum=3 then zad3;
if pnum=4 then about;
if pnum=5 then done:=true;
end;
#27: done:=true; { Pressing ESC }
#3: done:=true; { Pressing Ctrl+C }
end;
until done;
closegraph;
write ('До побачення!!!');
end.
4. Блок – схеми програми та процедур
Блок-схема процедури Draw:
Блок-схема процедури Ramka:
Блок-схема процедури About:
Блок-схема процедури Flash:
Блок-схема процедури ZAD1:
Блок-схема процедури PRINTMATRIX:
Блок-схема процедури Curpos:
Блок-схема процедури Count:
Блок-схема процедури ZAD2:
Блок-схема процедури ZAD3:
1. Сочинение Дедушка Мазай и зайцы
2. Контрольная работа Культура и цивилизация 13
3. Реферат на тему The Quarrel About Historical Explanation Essay Research
4. Курсовая на тему Фальшивомонетничество
5. Реферат на тему Misnaming Motifs Essay Research Paper Misnaming Motifs
6. Реферат Основные правовые системы современности 6
7. Реферат на тему Космічна погода
8. Реферат Принятие христианства на Руси 7
9. Реферат на тему Jacobson V United States Essay Research Paper
10. Реферат на тему Основные этапы развития античной философии