Програмування Pascal
Печать исходной матрицы к зад. № 1 ******************}. Str:="i не повиннi доторкатись один до одного!!!" ,. Процедура подщета кол-ва прямоуг. ********************}. Str:=#27#24#25#26″ — перемiщення курсора по матрицi." ,. For yps:=y to y1 do if getpixel (xps, yps) <>bk then putpixel (xps, yps, c),. Основная процедура задания № 2 ****************}. Else st:="Потрiбно ще трохи потренуватися… Читать ещё >
Програмування Pascal (реферат, курсовая, диплом, контрольная)
Програмування Pascal
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.
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 ©,.
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.