Програмування Pascal

[ виправити ] текст може містити помилки, будь ласка перевіряйте перш ніж використовувати.

скачати

Зміст

  1. Зміст

  2. Постановка завдання

  3. Теоретичне розв’язання задач

    1. Методика підрахунку прямокутників різної форми

    2. Фізичні основи та формули до завдання №2

  4. Блок – схеми програми та процедур

  5. Текст програми

  6. Пояснення до програми

  7. Результати роботи програми

  8. Список використаної літератури

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


За допомогою ПК можна намалювати те, що важко замітити. Кидання каменя – наглядний приклад цьому. Але політ каменя проходить так швидко, що мозок не встигає фіксувати траєкторію його польоту. В той же час відомо, що політ каменя добре підчиняється простим законам механіки. За допомогою рівнянь руху і машинної графіки можна відтворити траєкторію польоту каменя.

Для того щоб відобразити цю траєкторію в фізиці вже давно виведено такі формули:

  1. Спочатку потрібно знайти вертикальні і горизонтальні компоненти швидкості vx і vy за допомогою таких формул: vx=v*cos , vy=v*sin . Де: vпочаткова сила кидка, - кут кидка.

  2. Координати ядра в точці 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:='semmy@chiti.uch.net';

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. Список використаної літератури


  1. Т.Б. Романовский «Микрокалькуляторы в рассказах и играх», Радянська школа 1989

  2. В.С. Волькенштейн «Сборник задач по общему курсу физики», Наука 1973

  3. С.А. Абрамов «Задачи по программированию», Наука 1988

  4. В.З. Аладьев, В.Г. Тупало «Turbo Pascal для всех», Техніка 1993

  5. Р. Хершель «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:='semmy@chiti.uch.net';

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:












































































































Додати в блог або на сайт

Цей текст може містити помилки.

Астрономія | Завдання
369.1кб. | скачати


Схожі роботи:
Мова програмування Pascal
Модульне програмування Turbo Pascal
Мова програмування Turbo Pascal
Розробка програм у середовищі програмування Turbo Pascal 7 0
Розробка програм у середовищі програмування Turbo Pascal 70
Програмування трьохмірної графіки та анімації засобами Turbo Pascal
Складання програм для вирішення задач на мові програмування Turbo Pascal
Об`єктно-орієнтоване середовище програмування Object Pascal в профільному курсі інформатики
Розробка методики вивчення теми Графічні примітиви з використанням мови програмування Pascal
© Усі права захищені
написати до нас