Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted by 123 ( 12 years ago )
program cars_1_2;
uses graphabc;
const
speed = 50; //Road's length 10
ms = 10; //Animation's haste 5
var
x1, x11, x2, x22, y1, y2, point1, point2, window: integer;
s: string;
f, gg, ps, inbutton, inbuttonexit, inbuttonmenu1, inbuttonmenu2: boolean;
///////////////////////////////////////////////
procedure playerswindow(); forward;
procedure move2(); forward;
procedure menu(); forward;
///////////////////////////////////////////////
procedure queue;
begin
setpencolor(clwhite);
rectangle(309, 169, 325, 195);
setpencolor(clblack);
if (not gg) and (not f) and (window = 2) then
begin
setpenwidth(2); //Go-button 1
setpencolor(clwhite);
rectangle(399, 124, 630, 201);
setpencolor(clblack);
rectangle(90, 160, 190, 200);
setfontsize(20);
textout(110, 165, 'Ход!');
setfontsize(16);
textout(40, 125, 'Ходит первый игрок');
end;
if (not gg) and (f) and (window = 2) and (ps) then
begin
setpenwidth(2); //Go-button 2
setpencolor(clwhite);
rectangle(39, 125, 244, 201);
setpencolor(clblack);
rectangle(440, 160, 550, 200);
setfontsize(20);
textout(468, 165, 'Ход!');
setfontsize(16);
textout(400, 125, 'Ходит второй игрок');
end;
if (not gg) and (f) and (window = 2) and (not ps) then
begin
setpenwidth(2); //Go-button 2 (CPU)
setpencolor(clwhite);
rectangle(39, 125, 244, 201);
setpencolor(clblack);
rectangle(440, 160, 550, 200);
setfontsize(20);
textout(468, 165, 'Ход!');
setfontsize(16);
textout(410, 125, 'Ходит компьютер');
sleep(1000);
setpencolor(clblack); //button-animation CPU
setpenwidth(2);
drawrectangle(439, 158, 551, 202);
drawrectangle(244, 158, 396, 202);
sleep(90);
setpencolor(clwhite);
setpenwidth(3);
drawrectangle(438, 158, 552, 202);
drawrectangle(243, 157, 397, 203);
f := false;
move2;
end;
if (gg) and (x1 >= 595) and (window = 2) then
begin
setpencolor(clwhite);
rectangle(2, 122, 639, 220);
setfontsize(22);
textout(175, 125, 'Победил первый игрок!');
setpencolor(clblack);
window := 3;
rectangle(200, 200, 440, 240);
setfontsize(18);
textout(240, 205, 'Главное меню');
end;
if (gg) and (x2 >= 595) and (window = 2) then
begin
setpencolor(clwhite);
rectangle(2, 122, 639, 220);
setpencolor(clblack);
window := 3;
rectangle(200, 200, 440, 240);
setfontsize(18);
textout(240, 205, 'Главное меню');
setfontsize(22);
if not ps then textout(185, 125, 'Победил компьютер!')
else textout(175, 125, 'Победил второй игрок!');
end;
end;
////////////////////////////////////////////////
procedure gamewindow;
var
i: integer;
begin
window := 2;
clearwindow;
setpencolor(clblack);
sleep(300);
i := 1;
gg := false;
setpenwidth(3); //Road
line(0, 30, 640, 30);
line(0, 120, 640, 120);
setpenwidth(2); //Exit-button
rectangle(570, 240, 630, 263);
setfontsize(12);
textout(576, 242, 'Выход');
while i < 600 do
begin
line(i, 75, i + 19, 75);
inc(i, 39);
end;
line(630, 75, 640, 75);
line(590, 30, 590, 120); //Finish
line(630, 30, 630, 120);
setpenwidth(1);
rectangle(590, 30, 610, 45);
rectangle(590, 65, 610, 85);
rectangle(590, 105, 610, 120);
rectangle(610, 45, 630, 65);
rectangle(610, 85, 630, 105);
floodfill(600, 35, clblack);
floodfill(600, 70, clblack);
floodfill(600, 110, clblack);
floodfill(620, 50, clblack);
floodfill(620, 100, clblack);
setpenwidth(2); //Points
rectangle (245, 160, 395, 200);
setfontsize(17);
textout(4, 41, '1');
textout(4, 86, '2');
circle(30, 53, 12); //cars
circle(30, 97, 12);
queue;
end;
/////////////////////////////////////////////////
procedure move1;
begin
queue;
setpenwidth(2);
setfontsize(18);
randomize; //Points 1
point1 := random(6) + 1;
str(point1, s);
textout(310, 168, s);
x11 := point1 * speed + x1;
sleep(1000);
while x1 <= x11 do //Go 1
begin
setpencolor(clwhite);
circle(x1, y1, 13);
inc(x1, ms);
setpencolor(clblack);
circle(x1, y1, 12);
if x1 >= 595 then break;
sleep(100);
end;
x1 := x11;
if x1 >= 595 then gg := true;
f := true;
sleep(500);
queue;
end;
////////////////////////////////////////////////
procedure move2;
begin
setpenwidth(2);
setfontsize(18);
randomize; //Points 2
point2 := random(6) + 1;
str(point2, s);
textout(310, 168, s);
x22 := point2 * speed + x2;
sleep(1000);
while x2 <= x22 do //Go 2
begin
setpencolor(clwhite);
circle(x2, y2, 13);
inc(x2, ms);
setpencolor(clblack);
circle(x2, y2, 12);
if x2 >= 595 then break;
sleep(100);
end;
x2 := x22;
if x2 >= 595 then gg := true;
f := false;
sleep(500);
queue;
end;
////////////////////////////////////////////////
procedure mousedown(xm, ym, mb: integer);
begin
setpencolor(clblack);
setpenwidth(2);
if (not gg) and (not f) and (xm > 90) and (xm < 190) and (window = 2) //Go-buttons
and (ym > 160) and (ym < 200) and (mb = 1) then
begin
inbutton := true;
drawrectangle(89, 158, 191, 202);
drawrectangle(244, 158, 396, 202);
end;
if (not gg) and (f) and (xm > 440) and (xm < 550) and (window = 2)
and (ym > 160) and (ym < 200) and (mb = 1) then
begin
inbutton := true;
drawrectangle(439, 158, 551, 202);
drawrectangle(244, 158, 396, 202);
end;
if (xm > 570) and (xm < 630) and (ym > 240) and ((window = 2) or (window = 3)) //Exit
and (ym < 260) then
begin
drawrectangle(569, 238, 631, 265);
inbuttonexit := true;
end;
if ((window = 1) or (window = 4)) and (xm > 200) and (xm < 440) and (ym > 70) //Main menu buttons
and (ym < 110) then
begin
drawrectangle(199, 68, 441, 112);
inbuttonmenu1 := true;
end;
if ((window = 1) or (window = 4)) and (xm > 200) and (xm < 440) and (ym > 150)
and (ym < 190) then
begin
drawrectangle(199, 148, 441, 192);
inbuttonmenu2 := true;
end;
if (window = 3) and (xm > 200) and (xm < 440) and (ym > 200) //Go to main menu
and (ym < 240) then
begin
drawrectangle(199, 198, 440, 242);
inbutton := true;
end;
end;
////////////////////////////////////////////////
procedure mouseup(xm, ym, mb: integer); //Animation
begin
setpencolor(clwhite);
setpenwidth(3);
if (not gg) and (not f) and (window = 2) and (mb = 1) and (inbutton) then //Go-buttoins
begin
drawrectangle(89, 158, 191, 202);
drawrectangle(243, 157, 397, 203);
move1;
inbutton := false;
end;
if (not gg) and (f) and (window = 2) and (mb = 1) and (inbutton) then
begin
drawrectangle(439, 158, 552, 202);
drawrectangle(243, 157, 397, 203);
move2;
inbutton := false;
end;
if ((window = 2) or (window = 3)) and (inbuttonexit) then //Exit
begin
drawrectangle(569, 238, 631, 265);
sleep(400);
closewindow;
inbuttonexit := false;
end;
if (window = 1) and (inbuttonmenu1) then //Menu-buttons
begin
drawrectangle(198, 67, 442, 113);
sleep(300);
playerswindow;
inbuttonmenu1 := false;
end;
if (window = 1) and (inbuttonmenu2) then
begin
drawrectangle(198, 147, 442, 193);
sleep(300);
closewindow;
inbuttonmenu2 := false;
end;
if (window = 3) and (inbutton) then //Go to main menu
begin
inbutton := false;
drawrectangle(199, 198, 441, 242);
sleep(200);
clearwindow;
menu;
end;
if (window = 4) and (inbuttonmenu1) then //1 player
begin
drawrectangle(198, 67, 442, 113);
sleep(300);
ps := false;
gamewindow;
inbuttonmenu1 := false;
end;
if (window = 4) and (inbuttonmenu2) then
begin
drawrectangle(198, 147, 442, 193);
sleep(300);
ps := true;
gamewindow;
inbuttonmenu2 := false;
end;
end;
////////////////////////////////////////////////
procedure mousemove(xm, ym, mb: integer);
begin
setpenwidth(2);
if ((window = 1) or (window = 4)) and (xm > 200) and (xm < 440)
and (ym > 70) and (ym < 110) and (not inbuttonmenu2) then
begin
setpencolor(clwhite);
circle(180, 170, 11);
circle(460, 170, 11);
setpencolor(clblack);
drawcircle(180, 90, 10);
drawcircle(460, 90, 10);
end;
if ((window = 1) or (window = 4)) and (xm > 200) and (xm < 440)
and (ym > 150) and (ym < 190) and (not inbuttonmenu1) then
begin
setpencolor(clwhite);
circle(180, 90, 11);
circle(460, 90, 11);
setpencolor(clblack);
drawcircle(180, 170, 10);
drawcircle(460, 170, 10);
end;
end;
////////////////////////////////////////////////
procedure menu;
begin
x1 := 30;
y1 := 53;
x2 := 30;
y2 := 97;
f := false;
window := 1;
setwindowsize(640, 270);
setpenwidth(3);
setpencolor(clblack);
setfontsize(19);
rectangle(200, 70, 440, 110);
rectangle(200, 150, 440, 190);
drawcircle(180, 90, 10);
drawcircle(460, 90, 10);
textout(277, 77, 'Играть');
textout(281, 157, 'Выход');
onmousemove := mousemove;
onmousedown := mousedown;
onmouseup := mouseup;
setfontsize(10);
textout(565, 250, 'Версия 1.2');
end;
////////////////////////////////////////////////
procedure playerswindow;
begin
window := 4;
clearwindow;
setpencolor(clblack);
setpenwidth(2);
setfontsize(18);
rectangle(200, 70, 440, 110);
rectangle(200, 150, 440, 190);
drawcircle(180, 90, 10);
drawcircle(460, 90, 10);
textout(277, 77, '1 игрок');
textout(276, 157, '2 игрока');
onmousemove := mousemove;
onmousedown := mousedown;
onmouseup := mouseup;
end;
////////////////////////////////////////////////
begin
menu;
end.
Revise this Paste
Parent: 75223