Смекни!
smekni.com

Арканоид на Паскале (стр. 6 из 7)

inc(i,2);

a[i]:=xs;

a[i+1]:=ys;

end;

procedure level(var a:t_arr;const numbering:byte;var kol_kub:kol_kubik);

var xs,ys,i:t_kubik;

f:text;

color,pattern:byte;

number:string;

begin

for i:=1 to 494 do

a[i]:=0;

str(numbering,number);

assign(f,'levels\level'+number+'.den');

reset(f);

while not eof(f) do

begin

readln(f,xs,ys);

color:=random(14)+1;

pattern:=random(11)+1;

setcolor(color);

setfillstyle(pattern,color);

bar3d(xs,ys,48+xs,ys-20,0,false);

end;

close(f);

kol_kub:=0;

reset(f);

while not eof(f) do

begin

readln(f,xs,ys);

if xs<>0 then inc(kol_kub);

case xs of

1: begin i:=1; zapis(xs,ys,i,a); end;

50: begin i:=39; zapis(xs,ys,i,a); end;

99: begin i:=77; zapis(xs,ys,i,a); end;

148: begin i:=115; zapis(xs,ys,i,a); end;

197: begin i:=153; zapis(xs,ys,i,a); end;

246: begin i:=191; zapis(xs,ys,i,a); end;

295: begin i:=229; zapis(xs,ys,i,a); end;

344: begin i:=267; zapis(xs,ys,i,a); end;

393: begin i:=305; zapis(xs,ys,i,a); end;

442: begin i:=343; zapis(xs,ys,i,a); end;

491: begin i:=381; zapis(xs,ys,i,a); end;

540: begin i:=419; zapis(xs,ys,i,a); end;

589: begin i:=457; zapis(xs,ys,i,a); end;

end;

end;

close(f);

end;

procedure left(const koeff:byte;var x1_dv,x2_dv:t_kubik);

begin

if x1_dv-8 <= 0 then

begin

musik;

setcolor(0);

setfillstyle(0,0);

bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);

setfillstyle(6,13);

setcolor(13);

x1_dv:=1;

x2_dv:=koeff*shir;

bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);

end else

begin

setcolor(0);

setfillstyle(0,0);

bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);

setfillstyle(6,13);

setcolor(13);

dec(x1_dv,8);

dec(x2_dv,8);

bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);

end;

end;

procedure right(const koeff:byte;var x1_dv,x2_dv:t_kubik);

begin

if x2_dv+8 >= getmaxx then

begin

musik;

setcolor(0);

setfillstyle(0,0);

bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);

setfillstyle(6,13);

setcolor(13);

x2_dv:=getmaxx-1;

x1_dv:=x2_dv-koeff*shir;

bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);

end else

begin

setcolor(0);

setfillstyle(0,0);

bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);

setfillstyle(6,13);

setcolor(13);

inc(x1_dv,8);

inc(x2_dv,8);

bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);

end;

end;

procedure dviguna_keyboard(const koeff:byte;var x,x1_dv,x2_dv:t_kubik;var y:t_kubik);

begin

{Ðèñóåì ïëàíêó ñ øàðèêîì ïîñåðåäèíå}

planka_sharik(koeff);

{Íèæå --- êîîðäèíàòû ïëàíêè è øàðèêà(òîëüêî-÷òî íàðèñîâàííûõ)}

x1_dv:=round(getmaxx/2-(koeff/2)*shir-1);

x2_dv:=round(getmaxx/2+(koeff/2)*shir);

x:=getmaxx div 2;

y:=getmaxy-shir-radius-1;

repeat

case readkey of

#75: if x > (koeff div 2)*shir then

begin

left(koeff,x1_dv,x2_dv);

setcolor(0);

circle(x,y,radius);

x:=round(x1_dv+shir*koeff/2);

setcolor(10);

circle(x,y,radius);

end;

#77: if x < getmaxx-(koeff/2)*shir then

begin

right(koeff,x1_dv,x2_dv);

setcolor(0);

circle(x,y,radius);

x:=round(x1_dv+shir*koeff/2);

setcolor(10);

circle(x,y,radius);

end;

' ': exit;

#27:begin closegraph; halt; end;

end;

until false;

end;

procedure dviguna_mouse(const koeff:byte;var x,x1_dv,x2_dv:t_kubik;var y:t_kubik);

var x_get,y_get:word;

x_get_pred:word;

lb,rb,tb:boolean;

begin

{Ðèñóåì ïëàíêó ñ øàðèêîì ïîñåðåäèíå}

planka_sharik(koeff);

{óñòàíàâëèâàåò îãðàíè÷åíèå ïåðåìåùåíèÿ êóðñîðà ìûøè ïî âåðòèêàëè}

setYrange(5,5);

{óñòàíàâëèâàåò îãðàíè÷åíèå ïåðåìåùåíèÿ êóðñîðà ìûøè ïî ãîðèçîíòàëè}

setXrange(1,getmaxx-koeff*shir-1);

{Íèæå --- êîîðäèíàòû ïëàíêè è øàðèêà(òîëüêî-÷òî íàðèñîâàííûõ)}

x1_dv:=round(getmaxx/2-(koeff/2)*shir-1);

x2_dv:=round(getmaxx/2+(koeff/2)*shir);

setmousexy(x1_dv,0);

x:=getmaxx div 2;

y:=getmaxy-shir-radius-1;

repeat

getmousexy(x_get,y_get,lb,rb,tb);

if x_get_pred<>x_get then

begin

setcolor(0);

setfillstyle(0,0);

bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);

setfillstyle(6,13);

setcolor(13);

x1_dv:=x_get;

x2_dv:=x1_dv+koeff*shir;

bar3d(x1_dv,y1_dv,x2_dv,y2_dv,0,false);

x_get_pred:=x_get;

setcolor(0);

circle(x,y,radius);

setcolor(10);

x:=x_get+round(koeff/2)*shir;

circle(x,y,radius);

end;

until lb;

end;

procedure zar_nar(var x,y:t_kubik;const dx,dy:t_dx_dy);

begin

setcolor(0);

circle(x,y,radius);

inc(x,dx);

inc(y,dy);

setcolor(10);

circle(x,y,radius);

end;

procedure naverhu_number(numbering:byte);

var s:string;

begin

settextstyle(4{GothicFont},horizdir,3);

settextjustify(centertext,centertext);

setfillstyle(1,black);

bar(0,0,120,19);

setcolor(lightgreen);

str(numbering,s);

s:='Level '+s;

outtextxy(60,5,s);

end;

procedure naverhu_liv(liv:byte);

var s:string;

begin

settextstyle(4{GothicFont},horizdir,3);

settextjustify(centertext,centertext);

setfillstyle(1,black);

bar(140,0,250,19);

setcolor(lightgreen);

str(liv,s);

s:='Lifes '+s;

outtextxy(195,5,s);

end;

procedure naverhu_kubiki(kol_kub:byte;var score:integer);

var s:string;

begin

settextstyle(4{GothicFont},horizdir,3);

settextjustify(centertext,centertext);

setfillstyle(1,black);

bar(270,0,420,19);

setcolor(lightgreen);

str(kol_kub,s);

s:='Kubikov '+s;

outtextxy(345,5,s);

inc(score,10);

naverhu_score(score);

end;

procedure naverhu_score(score:integer);

var s:string;

begin

settextstyle(4{GothicFont},horizdir,3);

settextjustify(centertext,centertext);

setfillstyle(1,black);

bar(440,0,630,19);

setcolor(lightgreen);

str(score,s);

s:='Score '+s;

outtextxy(535,5,s);

end;

end.

unit mark_zas;

interface

uses crt,graph,mymouse;

type t_mas=array [1..11] of word;

procedure zastavka(s2:string);

procedure text_na_ekran;

procedure ochki(score:word);

implementation

procedure text_na_ekran;

var f:text;

a:char;

begin

assign(f,'pravila.txt');

reset(f);

textmode(1);

textbackground(3);

textcolor(0);

clrscr;

while not eof(f) do

begin

while not(eof(f)) do

begin

read(f,a);

write(a);

end;

writeln;

end;

while not(keypressed) do

case readkey of

#27:exit;

end;

close(f);

end;

procedure zastavka(s2:string);

var redvalue:-2..63;

greenvalue2:-2..63;

lb,rb,tb:boolean;

buttoncount,errorcode:byte;

x,y:word;

i:-1..1;

begin

initmouse(buttoncount,errorcode);

cleardevice;

setcolor(lightgreen);

setlinestyle(0,2,3);

rectangle(0,0,getmaxx,getmaxy);

settextjustify(centertext,centertext);

settextstyle(4{GothicFont},horizdir,9);

setcolor(3);

outtextxy(getmaxx div 2,round(getmaxy / 2.5),'Markball');

setcolor(1);

settextstyle(7{TSCR.CHR},horizdir,2);

settextjustify(lefttext,centertext);

if s2='Click to start' then

outtextxy(10,10,'Press F1 for the help');

setcolor(2);

settextstyle(7{TSCR.CHR},horizdir,3);

outtextxy(getmaxx div 2,round(getmaxy / 1.3), s2);

i:=1;

redvalue:=1;

greenvalue2:=62;

repeat

repeat

inc(redvalue,i);

setRGBpalette(3,redvalue,redvalue,0);

getmouseXY(x,y,lb,rb,tb);

inc(greenvalue2,-i);

setRGBpalette(2,0,greenvalue2,greenvalue2);

setRGBpalette(1,Greenvalue2,0,0);

until (redvalue=63) or (redvalue=0) or rb or lb or keypressed;

i:=-i;

if keypressed then

case readkey of

#59{F1}:

begin

text_na_ekran;

SetGraphMode(vgahi);

setcolor(lightgreen);

setlinestyle(0,2,3);

rectangle(0,0,getmaxx,getmaxy);

settextjustify(centertext,centertext);

settextstyle(4{GothicFont},horizdir,9);

redvalue:=1;

greenvalue2:=62;

setcolor(3);

outtextxy(getmaxx div 2,round(getmaxy / 2.5),'Markball');

setcolor(1);

settextstyle(7{TSCR.CHR},horizdir,2);

settextjustify(lefttext,centertext);

if s2='Click to start' then

outtextxy(10,10,'Press F1 for the help');

setcolor(2);

settextstyle(7{TSCR.CHR},horizdir,3);

outtextxy(getmaxx div 2,round(getmaxy / 1.3), s2);

end;

#13:exit;

end;

until rb or lb;

end;

procedure ochki(score:word);

var f:text;

s:string[15];

c:word;

numb,mynumber:-5..20;

player:t_mas;

players_name:array [1..11] of string[15];

x,y:word;

i:char;

myname:string[15];

label ld;

begin

assign(f,'record.txt');

reset(f);

readln(f);

numb:=0;

while not eof(f) do

begin

readln(f,c);

inc(numb);

player[numb]:=c;

readln(f);

end;

close(f);

reset(f);

numb:=0;

while not eof(f) do

begin

readln(f,s);

inc(numb);

players_name[numb]:=s;

readln(f);

end;

close(f);

x:=getmaxx div 2-140;

y:=35;

bar3d(x,y,x+280,y+100,0,false);

settextjustify(centertext,centertext);

settextstyle(4{Gothic Font},horizdir,3);

setcolor(lightcyan);

outtextxy(x+140,y+10,'Enter your name');

myname:='';

while true do

if keypressed then

begin

i:=readkey;

case i of

#13: goto ld;

else begin

outtextxy(x+20,y+40,i);

inc(x,18);

myname:=myname+i;

end;

end;

end;

ld:

mynumber:=0;

numb:=1;

while (numb <= 10) and (score < player[numb]) do

inc(numb);

if numb = 11 then

begin

x:=getmaxx div 2-140;

y:=35;

bar3d(x,y,x+280,y+300,0,false);

settextjustify(centertext,centertext);

settextstyle(4{Gothic Font},horizdir,3);

setcolor(lightcyan);

outtextxy(x+140,y+10,'The best players');

settextjustify(lefttext,centertext);

y:=75;

for numb:=1 to 10 do

begin

outtextxy(x+10,y,players_name[numb]);

str(player[numb],s);

outtextxy(x+190,y,s);

inc(y,25);

delay(1000);

end;

end

else

begin

settextstyle(4{Gothic Font},horizdir,3);

mynumber:=numb;

for c:=10 downto numb do

begin

player[c+1]:=player[c];

players_name[c+1]:=players_name[c];

end;

player[mynumber]:=score;

players_name[mynumber]:=myname;

x:=getmaxx div 2-140;

y:=35;

bar3d(x,y,x+280,y+300,0,false);

settextjustify(centertext,centertext);

settextstyle(4{Gothic Font},horizdir,3);

setcolor(lightcyan);

outtextxy(x+140,y+10,'The best players');

y:=75;

settextjustify(lefttext,centertext);

for numb:=1 to 10 do

begin

outtextxy(x+10,y,players_name[numb]);

str(player[numb],s);

outtextxy(x+190,y,s);

inc(y,25);

delay(1000);

end;

rewrite(f);

for numb:=1 to 10 do

begin

writeln(f,players_name[numb]);

writeln(f,player[numb]);

end;

close(f);

end;

readkey;

end;

end.

Äîïîëíèòåëüíàÿ ïðîãðàììà äëÿ ïîñòðîåíèÿ ñîáñòâåííûõ óðîâíåé :

Ïðàâèëà ïîëüçîâàíèÿ ïðîãðàììîé:

1. çàïóñòèòü MARKEDIT.EXE

2. íàæèìàÿ ëåâóþ êíîïêó ìûøè ñòàâèòü(ðèñîâàòü) êóáèêè;

3. ïîñëå ïîñòðîåíèÿ óðîâíÿ íàæàòü ïðàâóþ êíîïêó ìûøè;

4. ïîñëå ïîÿâëåíèÿ ìåíþ íîìåðîâ óðîâíåé âûáðàòü íîìåð ñîõðàíÿåìîãî óðîâíÿ (ôàéëà);

Ñïåöèôèêàöèè ïîäïðîãðàìì:

1. procedure text_na_ekran;

Íàçíà÷åíèå: èñïîëüçóåòñÿ êàê ñïðàâêà è âñåãäà ïîêàçûâàåòñÿ ïðè çàïóñêå;

Âõîäíûå äàííûå:

íåò;

Âûõîäíûå äàííûå:

íåò;

2. function netu:boolean;

Íàçíà÷åíèå: ïðè íàæàòèè ëåâîé êíîïêè ìûøè îïðåäåëÿåò, åñòü ëè íà ýòîì ìåñòå óæå êóáèê èëè íåò;

Âõîäíûå äàííûå: