Game to Gain more blocks by drawing appropriate lines from correct places(dots).

Special : Web Developer's Collection CD-ROM
50,000+ Web Templates, Logos, Cliparts, Scripts. Order Now!

Add to Favorites Make Home Page

2447 Online

Language Categories

Source Codes Home
Project Ideas New!
Interview Questions
FAQs Home
ASP Home: ASP Source Codes; ASP Script Directory New!; ASP .Net Script Directory New!; ASP Interview Questions; ASP FAQs; ASP How Tos
C Home: C Source Codes; C Script Directory New!; C Interview Questions; C FAQs; C How Tos
C++ Home: C++ Source Codes; C++ Script Directory New!; C++ Interview Questions; C++ FAQs; C++ How Tos
Java Home: Java Source Codes; Java Directory New!; Java Interview Questions; Java FAQs; Java How Tos
JavaScript Home: JavaScript Directory New!; JavaScript Source Codes; JavaScript FAQs; JavaScript How Tos
COBOL Home: COBOL Source Codes; COBOL FAQs; COBOL How Tos
Pascal Home: Pascal Source Codes; Pascal FAQs; Pascal How Tos
PHP Script Directory New!
Python Script Directory New!
Perl & CGI Script Directory New!
Flash Script Directory New!
CFML Script Directory New!
Remotely Hosted Scripts New!
Tools & Utilities Directory New!
XML Script Directory New!
Best Programmers: Amit Mathur; Vishal Bhardwaj; Deepesh Jain
Vyom NetWork

Our Services

Get 9,000 Interview Questions & Answers in an eBook.

9500+ Pages
9000 Question & Answers
All Tech. Categories

14 MB Content

Get it now !!

Home » Pascal Home » Pascal Projects Home » Game to Gain more blocks by drawing appropriate lines from correct places(dots).

A D V E R T I S E M E N T

Title	Game to Gain more blocks by drawing appropriate lines from correct places(dots).
Description
Category	Pascal » Pascal Projects
Hits	384443
Code	Select and Copy the Code
{ Description: Game to Gain more blocks by drawing appropriate lines from correct places(dots). } program game; uses graph,crt; label Z,T; const directory='c: pgi'; type myarray=array[0..9,0..9]of byte; sarray=array[1..2]of byte; larray=array[1..2]of char; var score:sarray; letter:larray; row,min,fc,bc:byte; player,ax,ay,bx,by:byte; drive,mode:integer; i,j:integer; lin,col:myarray; tp,ch:char; ps1,ps2:string; {******************************************************} procedure music; begin for i:=1 to 15 do begin sound(i400); delay(200); end; Nosound; end; {******************************************************} procedure welcome; begin Randomize; setfillstyle(11,7); bar(160,120,480,360); setcolor(15); settextstyle(1,0,3); outtextxy(180,140,'WELCOME TO "SPOTGAME"'); settextstyle(11,0,2); outtextxy(200,180,'This Product is Licensed to:'); outtextxy(265,220,'NEGIN AHMADIAN'); outtextxy(265,240,'SIMIN MOKHTARI'); outtextxy(275,320,'February 2002'); outtextxy(285,335,'Esfand 1380'); outtextxy(200,440,'Press a KEY to Begin*'); repeat PutPixel(Random(1000), Random(1000),7); Delay(10); until keypressed; music; for i:=1 to 10 do begin setcolor(random(16)); settextstyle(1,0,i-1); outtextxy(250-(i-1)15,40+2(i-1)(i-1),'WELCOME'); setcolor(random(16)); settextstyle(1,0,i); outtextxy(250-i15,40+2ii,'WELCOME'); delay(150); end; delay(1000); music; for i:=10 downto 1 do begin setcolor(random(16)); settextstyle(1,0,i); outtextxy(250-i15,40+2ii,'WELCOME'); setcolor(random(16)); settextstyle(1,0,i-1); outtextxy(250-(i-1)15,40+2(i-1)(i-1),'WELCOME'); Delay(100); end; end; {****************************************************} procedure errorbar; begin setfillstyle(solidfill,red); bar(390,170,550,190); setcolor(black); sound(220); delay(200); end; {***************************************************} procedure clearbar; begin nosound; delay(300); setfillstyle(solidfill,black); bar(390,170,550,190); delay(300); end; {***************************************************} procedure takespot(var x,y:byte); label L,K; var aa,a:char; begin L: setfillstyle(solidfill,bc); bar(400,120,500,130); setcolor(fc); outtextxy(400,120,'Letter:'); aa:=readkey; aa:=upcase(aa); outtextxy(490,120,aa); delay(250); if ((aa<'A') or (aa>chr(64+row)))and(ord(aa)<>27) then begin repeat errorbar; setcolor(fc); outtextxy(10,465,'Enter a Letter A-'); outtextxy(150,465,chr(64+row)); setcolor(black); outtextxy(415,175,'<Out Of Range>'); clearbar; until keypressed; setfillstyle(solidfill,bc); bar(10,465,200,480); goto L; end {if} else if ord(aa)=27 then halt; K: setfillstyle(solidfill,bc); bar(400,140,500,150); setcolor(fc); outtextxy(400,140,'Number:'); a:=readkey; outtextxy(490,140,a); delay(250); if ((a<'1') or (a>chr(48+row)))and (ord(a)<>27) then begin repeat errorbar; setcolor(fc); outtextxy(10,465,'Enter a Number 1-'); outtextxy(150,465,chr(48+row)); setcolor(black); outtextxy(415,175,'<Out Of Range>'); clearbar; until keypressed; setfillstyle(solidfill,bc); bar(10,465,200,480); goto K; end else if ord(a)=27 then halt; x:=ord(aa)-65; y:=ord(a)-48; end; {****************************************************} procedure draw; begin if row=5 then min:=2 else if row=7 then min:=1 else min:=0; initgraph (drive,mode,directory); setbkcolor(bc); setcolor(fc); outtextxy(25,10,'Esc=Exit'); for j:=min to row+min-1 do for i:=min to row+min-1 do begin circle(40+40j,80+40i,2); setfillstyle(solidfill,fc); floodfill(40+40j,80+40i,fc); end; for i:=0 to row-1 do begin outtextxy(40+40i+min40,45+min40,chr(i+65)); outtextxy(5+min40,78+40i+min40,chr(i+49)); end; end; {****************************************************} procedure fillarray(var lin,col:myarray); begin for i:=0 to 9 do for j:=0 to 9 do begin lin[i,j]:=0; col[i,j]:=0; end; end; {***************************************************} procedure drawman; var x,y:integer; begin x:=500; y:=300; circle(x,y,20); circle(x,y,3); arc(x,y,200,350,15); circle(x-5,y-10,2); circle(x+5,y-10,2); line(x,y+20,x,y+60); line(x,y+60,x-20,y+100); line(x,y+60,x+20,y+100); end; {***************************************************} function checkspot(var a,b,c,d:byte):boolean; label R; begin checkspot:=true; if ((a<>c)and(b<>d)) or ((a=c)and(abs(b-d)<>1)) or ((b=d)and(abs(a-c)<>1))then begin repeat errorbar; setcolor(fc); outtextxy(10,450,'Lines should be vertical or horizentical and be 1 unit!'); outtextxy(20,465,'Enter First Spot again.'); setcolor(black); outtextxy(415,175,'<Invalid Line>'); clearbar; until keypressed; setfillstyle(solidfill,bc); bar(10,450,600,480); setcolor(fc); R: checkspot:=false; exit; end;{if} if ((a=c)and(col[a,(b+d)div 2]<>0)) or ((b=d) and (lin[(a+c)div 2,b]<>0))then begin repeat errorbar; setcolor(fc); outtextxy(10,450,'You are trying to draw a repeated line!'); outtextxy(20,465,'Enter First Spot again.'); setcolor(black); outtextxy(420,175,'<Drawn Line>'); clearbar; until keypressed; setfillstyle(solidfill,bc); bar(10,450,600,480); setcolor(fc); goto R; end end; {****************************************************} procedure selection(var ps1,ps2:string;var tp:char); label A,B,C; var fcolor,bcolor:char; p1,p2:string[10]; size:char; begin initgraph(drive,mode,directory); rectangle(60,60,120,180); rectangle(380,60,440,180); for i:=1 to 3 do begin line(60,60+i30,120,60+30i); line(380,60+i30,440,60+30i); outtextxy(40,45+i30,chr(i+48)); outtextxy(360,45+i30,chr(i+48)); end; outtextxy(40,165,'4'); outtextxy(360,165,'4'); setfillstyle(solidfill,1); floodfill(75,75,white); setfillstyle(solidfill,7); floodfill(75,135,white); setfillstyle(solidfill,15); floodfill(75,165,white); setfillstyle(solidfill,5); floodfill(395,75,white); setfillstyle(solidfill,3); floodfill(395,105,white); setfillstyle(solidfill,9); floodfill(395,135,white); setfillstyle(solidfill,2); floodfill(395,165,white); outtextxy(25,10,'Esc=Exit'); outtextxy(110,25,'Enter a number 1-4 for background color'); outtextxy(130,120,'BackGround:'); outtextxy(450,120,'ForeGround:'); outtextxy(30,200,'TYPE OF PLAY>'); outtextxy(110,220,'1.Human by Human'); outtextxy(110,240,'2.Human by Computer'); A: bcolor:=readkey; if (bcolor>'0') and (bcolor<'5')and(ord(bcolor)<>27) then begin outtextxy(220,120,bcolor); setfillstyle(solidfill,black); bar(110,25,420,50); outtextxy(110,25,'Enter a number 1-4 for spots and texts'); end else if ord(bcolor)=27then halt else goto A; case bcolor of '1': bc:=1; '2': bc:=0; '3': bc:=7; '4': bc:=15; end; B: fcolor:=readkey; if (fcolor>'0') and (fcolor<'5') and (ord(fcolor)<>27)then begin outtextxy(540,120,fcolor); bar(110,25,420,50); outtextxy(110,25,'Enter a number 1-2 for type of the Game'); end else if ord(fcolor)=27 then halt else goto B; case fcolor of '1': fc:=5; '2': fc:=3; '3': fc:=9; '4': fc:=2; end; repeat tp:=readkey; if (tp='1') or (tp='2') then outtextxy(150,200,tp) until (tp='1') or (tp='2') or (ord(tp)=27); if ord(tp)=27 then halt else if tp='1' then begin outtextxy(30,285,'Enter your FirstNames>'); outtextxy(110,308,'Player<1>:'); bar(110,25,420,50); outtextxy(70,25,'After entering your name(1-10 characters),Press <ENTER>'); gotoxy(25,20); readln(p1); C: outtextxy(110,326,'Player<2>:'); bar(110,25,420,50); outtextxy(70,25,'After entering your name(1-10 characters),Press <ENTER>'); gotoxy(25,21); readln(p2); outtextxy(30,370,p1); outtextxy(130,370,'Will Play As'); outtextxy(270,370,upcase(p1[1])); outtextxy(30,390,p2); outtextxy(130,390,'Will Play As'); i:=0; repeat i:=i+1; until p1[1]<>p2[i]; outtextxy(270,390,upcase(p2[i])); end{if} else begin outtextxy(30,285,'Enter your FirstNames>'); outtextxy(110,308,'Player<1>: Computer'); p1:='computer'; goto C; end; letter[1]:=upcase(p1[1]); letter[2]:=upcase(p2[i]); ps1:=p1; ps2:=p2; bar(70,25,520,50); outtextxy(110,25,'Enter a number 1-3 for number of Spots'); outtextxy(380,285,'Size of "SPOTGAME" box>'); outtextxy(420,305,'1.5x5'); outtextxy(420,325,'2.7x7'); outtextxy(420,345,'3.9x9'); repeat size:=readkey; if (size>'0') and (size<'4') then outtextxy(580,285,size); until ((size>'0') and (size<'4'))or (ord(size)=27); if ord(size)=27 then halt else if size='1' then row:=5 else if size='2' then row:=7 else row:=9; end; {*****************************************************} function givescore:boolean; begin givescore:=false; if (ax=bx)and(ax<>row)and(col[ax+1,(ay+by)div 2]=1)and(lin[ax,ay]=1)and(lin[bx,by]=1)then begin settextstyle(1,0,4); outtextxy(20(3+2min+2ax)-7,20(1+2min+ay+by),letter[player]); score[player]:=score[player]+1; givescore:=true; end; if (ax=bx)and(ax<>0)and(col[ax-1,(ay+by)div 2]=1)and(lin[ax-1,ay]=1)and(lin[bx-1,by]=1)then begin settextstyle(1,0,4); outtextxy(20(1+2min+2ax)-7,20(1+2min+ay+by),letter[player]); score[player]:=score[player]+1; givescore:=true; end; if (ay=by)and(ay<>1)and(lin[(ax+bx)div 2,ay-1]=1)and(col[bx,by-1]=1)and(col[ax,ay-1]=1)then begin settextstyle(1,0,4); outtextxy(20(2+2min+ax+bx)-7,20(2min+2ay),letter[player]); score[player]:=score[player]+1; givescore:=true; end; if (ay=by)and(ay<>row)and(lin[(ax+bx)div 2,ay+1]=1)and(col[bx,by]=1)and(col[ax,ay]=1)then begin settextstyle(1,0,4); outtextxy(20(2+2min+ax+bx)-7,20(2+2min+2ay),letter[player]); score[player]:=score[player]+1; givescore:=true; end; end; {****************************************************} procedure change; begin setfillstyle(solidfill,bc); bar(480,250,600,260); if player=2 then begin setcolor(bc); line(500,330,470,320); line(500,330,530,320); player:=1; setcolor(fc); drawman; line(500,330,480,360); line(500,330,520,360); settextstyle(11,0,2); outtextxy(480+(10-length(ps1))div 2,250,ps1); end else begin player:=2; setcolor(bc); drawman; line(500,330,480,360); line(500,330,520,360); setcolor(fc); settextstyle(11,0,2); outtextxy(480+(10-length(ps2))div 2,250,ps2); drawman; line(500,330,470,320); line(500,330,530,320); end; end; {***************************************************} procedure choose(a:byte); var b:byte; begin Randomize; repeat ax:=random(row); by:=random(row)+1; b:=random(2); if a=0 then bx:=ax else if a=1 then ay:=by; if (a=0) and (b=0) and(by<>1)then ay:=by-1 else if (a=0) and (b=0) and (by=1) then ay:=by+1 else if (a=0) and (b=1) and (by=row) then ay:=by-1 else if (a=0) and (b=1) and (by<>row)then ay:=by+1 else if (a=1) and (b=0) and (ax<>0)then bx:=ax-1 else if (a=1) and (b=0) and (ax=0)then bx:=ax+1 else if (a=1) and (b=1) and (ax<>row-1) then bx:=ax+1 else if (a=1) and (b=1) and (ax=row-1) then bx:=ax-1; until ((a=0)and(col[ax,(ay+by)div 2]=0))OR((a=1)and(lin[(ax+bx)div 2,ay]=0)) end; {***************************************************} procedure testcol(var if2,if1:byte); begin if1:=0;if2:=0; if (ax<>row-1)and(ax<>0) then begin if (col[ax+1,(ay+by)div 2]=0)and(lin[ax,ay]=0)and(lin[bx,by]=1)then if1:=1 else if (col[ax+1,(ay+by)div 2]=0)and(lin[ax,ay]=1)and(lin[bx,by]=0)then if1:=1 else if (col[ax+1,(ay+by)div 2]=1)and(lin[ax,ay]=0)and(lin[bx,by]=0)then if1:=1 else if (col[ax+1,(ay+by)div 2]=0)and(lin[ax,ay]=0)and(lin[bx,by]=0)then if1:=1; if (col[ax-1,(ay+by)div 2]=0)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=1)then if2:=1 else if (col[ax-1,(ay+by)div 2]=0)and(lin[ax-1,ay]=1)and(lin[bx-1,by]=0)then if2:=1 else if (col[ax-1,(ay+by)div 2]=1)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=0)then if2:=1 else if (col[ax-1,(ay+by)div 2]=0)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=0)then if2:=1; end else if ax=row-1 then begin if (col[ax-1,(ay+by)div 2]=0)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=1)then if2:=1 else if (col[ax-1,(ay+by)div 2]=0)and(lin[ax-1,ay]=1)and(lin[bx-1,by]=0)then if2:=1 else if (col[ax-1,(ay+by)div 2]=1)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=0)then if2:=1 else if (col[ax-1,(ay+by)div 2]=0)and(lin[ax-1,ay]=0)and(lin[bx-1,by]=0)then if2:=1; if1:=1; end else if ax=0 then begin if (col[ax+1,(ay+by)div 2]=0)and(lin[ax,ay]=0)and(lin[bx,by]=1)then if1:=1 else if (col[ax+1,(ay+by)div 2]=0)and(lin[ax,ay]=1)and(lin[bx,by]=0)then if1:=1 else if (col[ax+1,(ay+by)div 2]=1)and(lin[ax,ay]=0)and(lin[bx,by]=0)then if1:=1 else if (col[ax+1,(ay+by)div 2]=0)and(lin[ax,ay]=0)and(lin[bx,by]=0)then if1:=1; if2:=1; end; end; {***************************************************} function findcol:boolean; var if1,if2:byte; begin findcol:=false; for ax:=0 to row-1 do for ay:=1 to row-1 do begin bx:=ax; by:=ay+1; if (col[ax,(ay+by)div 2]=0)then begin testcol(if1,if2); if if1+if2=2 then begin findcol:=true; exit; end; end; end; end; {***************************************************} procedure testlin (var if2,if1:byte); begin if1:=0;if2:=0; if (ay<>row)and(ay<>0)then begin if (lin[(ax+bx)div 2,ay-1]=0)and(col[bx,by-1]=0)and(col[ax,ay-1]=1)then if1:=1 else if (lin[(ax+bx)div 2,ay-1]=0)and(col[bx,by-1]=1)and(col[ax,ay-1]=0)then if1:=1 else if (lin[(ax+bx)div 2,ay-1]=1)and(col[bx,by-1]=0)and(col[ax,ay-1]=0)then if1:=1 else if (lin[(ax+bx)div 2,ay-1]=0)and(col[bx,by-1]=0)and(col[ax,ay-1]=0)then if1:=1; if (lin[(ax+bx)div 2,ay+1]=0)and(col[bx,by]=0)and(col[ax,ay]=1)then if2:=1 else if (lin[(ax+bx)div 2,ay+1]=0)and(col[bx,by]=1)and(col[ax,ay]=0)then if2:=1 else if (lin[(ax+bx)div 2,ay+1]=1)and(col[bx,by]=0)and(col[ax,ay]=0)then if2:=1 else if (lin[(ax+bx)div 2,ay+1]=0)and(col[bx,by]=0)and(col[ax,ay]=0)then if2:=1; end else if ay=row then begin if (lin[(ax+bx)div 2,ay-1]=0)and(col[bx,by-1]=0)and(col[ax,ay-1]=1)then if1:=1 else if (lin[(ax+bx)div 2,ay-1]=0)and(col[bx,by-1]=1)and(col[ax,ay-1]=0)then if1:=1 else if (lin[(ax+bx)div 2,ay-1]=1)and(col[bx,by-1]=0)and(col[ax,ay-1]=0)then if1:=1 else if (lin[(ax+bx)div 2,ay-1]=0)and(col[bx,by-1]=0)and(col[ax,ay-1]=0)then if1:=1; if2:=1; end else if ay=1 then begin if (lin[(ax+bx)div 2,ay+1]=0)and(col[bx,by]=0)and(col[ax,ay]=1)then if2:=1 else if (lin[(ax+bx)div 2,ay+1]=0)and(col[bx,by]=1)and(col[ax,ay]=0)then if2:=1 else if (lin[(ax+bx)div 2,ay+1]=1)and(col[bx,by]=0)and(col[ax,ay]=0)then if2:=1 else if (lin[(ax+bx)div 2,ay+1]=0)and(col[bx,by]=0)and(col[ax,ay]=0)then if2:=1; if1:=1; end; end; {***************************************************} function findlin:boolean; var if1,if2:byte; begin findlin:=false; for ax:=0 to row-2 do for ay:=1 to row do begin by:=ay; bx:=ax+1; if lin[(ax+bx) div 2,ay]=0 then begin testlin(if1,if2); if if1+if2=2 then begin findlin:=true; exit; end; end; end; end; {***************************************************} procedure THINKING; label D; var a,f1,f2:byte; begin for ax:=0 to row-1 do for bx:=0 to row-1 do for ay:=1 to row do for by:=1 to row do begin if ((ax=bx)and(abs(ay-by)=1)and(col[ax,(ay+by)div 2]=0))or((ay=by)and(abs(ax-bx)=1)and(lin[(ax+bx)div 2,ay]=0))then begin if (col[ax+1,(ay+by)div 2]=1)and(lin[ax,ay]=1)and(lin[bx,by]=1)then exit; if (col[ax-1,(ay+by)div 2]=1)and(lin[ax-1,ay]=1)and(lin[bx-1,by]=1)then exit; if (lin[(ax+bx)div 2,ay-1]=1)and(col[bx,by-1]=1)and(col[ax,ay-1]=1)then exit; if (lin[(ax+bx)div 2,ay+1]=1)and(col[bx,by]=1)and(col[ax,ay]=1)then exit; end; end; if (findcol=true)and(findlin=true)then begin Randomize; a:=random(2); if a=1 then goto D; end; if findcol=true then begin repeat choose(0); testcol(f1,f2); until (f1+f2=2); exit; end; D: if findlin=true then begin repeat choose(1); testlin(f1,f2); until (f1+f2=2); exit; end; randomize; a:=random(2); choose(a); end; {***************************************************} procedure displayscore; var xposition,yposition,xpos,ypos:integer; standing:boolean; procedure drawheart(color:byte); begin setfillstyle(solidfill,color); circle(xposition,yposition+40,3); floodfill(xposition,yposition+40,color); circle(xposition+6,yposition+40,3); floodfill(xposition+6,yposition+40,color); line(xposition-3,yposition+40,xposition+3,yposition+50); line(xposition+9,yposition+40,xposition+3,yposition+50); floodfill(xposition+3,yposition+45,color); end; procedure drawsad(x,y:integer;standing:boolean); begin circle(x,y,20); circle(x,y,3); line(x-10,y-5,x-7,y-10); line(x+10,y-5,x+7,y-10); line(x,y+20,x,y+60); if standing then begin circle(x-25,y-5,1); circle(x-30,y-15,1); circle(x-35,y-10,1); circle(x+25,y-5,1); circle(x+30,y-15,1); circle(x+35,y-10,1); arc(x,y+20,400,135,15); line(x,y+30,x-20,y+60); line(x,y+30,x+20,y+60); line(x,y+60,x-20,y+100); line(x,y+60,x+20,y+100); end else begin line(x,y+30,x-30,y+20); line(x,y+30,x+30,y+20); line(x,y+60,x-30,y+80); line(x,y+60,x+30,y+80); end end;{drawsad} procedure drawhappy(x,y:integer;standing:boolean); begin circle(x,y,3); circle(x-5,y-10,2); circle(x+5,y-10,2); circle(x,y,20); line(x,y+20,x,y+60); if standing then begin arc(x,y,200,350,15); line(x,y+30,x-20,y+60); line(x,y+30,x+20,y+60); line(x,y+60,x-20,y+100); line(x,y+60,x+20,y+100); end else begin circle(x,y+12,6); line(x,y+30,x-30,y+20); line(x,y+30,x+30,y+20); line(x,y+60,x-30,y+80); line(x,y+60,x+30,y+80); end end;{drawhappy} begin xposition:=1; yposition:=getmaxy div 22; standing:=true; xpos:=getmaxx; ypos:=getmaxy-(getmaxy div 4); repeat sound(10000); setcolor(white); drawhappy(xposition,yposition,standing); drawsad(xpos,ypos,standing); nosound; setcolor(4); drawheart(4); delay(250); setcolor(0); sound(3000); drawhappy(xposition,yposition,standing); drawsad(xpos,ypos,standing); drawheart(0); xposition:=xposition+5; xpos:=xpos-5; standing:=not standing; setfillstyle(solidfill,0); bar(xposition-10,yposition+37,xposition+10,yposition+43); nosound; until keypressed; end; {***************************************************} procedure scorebar; var ch:char; begin initgraph(drive,mode,directory); setfillstyle(9,1); bar(160,140,480,310); settextstyle(11,0,1); outtextxy(245,150,'* GAME OVER *'); outtextxy(170,290,'Enter=Deal'); outtextxy(180,300,'Esc=Quit'); settextstyle(1,0,4); outtextxy(180,160,'PLAYER'); outtextxy(360,160,'SCORE'); settextstyle(2,0,6); if score[1]>score[2] then begin outtextxy(190,200,ps1); str(score[1],ps1); outtextxy(400,200,ps1); outtextxy(190,220,ps2); str(score[2],ps2); outtextxy(400,220,ps2); end else begin outtextxy(190,200,ps2); str(score[2],ps2); outtextxy(400,200,ps2); outtextxy(190,220,ps1); str(score[1],ps1); outtextxy(400,220,ps1); end; end; {*************************************************** MAIN ****************************************************} begin initgraph (drive,mode,directory); welcome; Z: selection(ps1,ps2,tp); fillarray(lin,col); draw; player:=2; change; repeat if (tp='2')and(player=1)then THINKING else begin repeat setfillstyle(solidfill,bc); bar(390,90,530,200); setcolor(fc); settextstyle(11,0,2); outtextxy(390,100,'Enter first spot:'); takespot(ax,ay); setfillstyle(solidfill,bc); bar(390,90,530,200); outtextxy(390,100,'Enter second spot:'); takespot(bx,by); until (checkspot(ax,ay,bx,by)=true) and (checkspot(bx,by,ax,ay)=true); end; if ax=bx then col[ax,(ay+by)div 2]:=1; if ay=by then lin[(ax+bx)div 2,ay]:=1; setcolor(fc); line(40(1+min+ax),40(1+ay+min),40(1+min+bx),40(1+by+min)); if givescore=false then change else begin sound(100); delay(100); sound(150); delay(100); nosound; end; until score[1]+score[2]=(row-1)(row-1); if (score[1]<>score[2])and(tp<>'2')then begin scorebar; displayscore; goto T end else scorebar; T: ch:=readkey; if ord(ch)=27 then halt else if ord(ch)=13 then begin for i:=1 to 2 do score[i]:=0; music; goto Z; end else goto T; readln; end. {*********************THE END*************************}

Related Source Codes

Script Name Author

Calendar date to day number and back Nicky McLean

Matrix Multiple Cirruse Salehnasab

Function Power Recursive Cirruse Salehnasab

swim brian colston

tetris (Mini Project) mehdi farrokhzad

Macsi - space fighting game. Macsi P�ter

Recursive Monkey Puzzle Solution - Project Maxim C.L. Wrne

Maze Game Project In Pascal Mahmood

Excellent Rat in a Maze Program. VyomWorld

A car game. You have to drive the car in such a way that you dont strike a barrier on the road. VyomWorld

Student Database Information System. VyomWorld

Tic Tac Toe Game implemented in Pascal. VyomWorld

To Find The Coinage Of The Amount Entered. VyomWorld

Randomizes two 3x3 arrays and indicates the numbers whih are common in both the arrays otherwise an cross 'x' is shown instead. VyomWorld

Program that checks the space on drive a: and also gives a graphical representation of memory. VyomWorld

A D V E R T I S E M E N T

Google Groups Subscribe to SourceCodesWorld - Techies Talk

Email:

Free eBook - Interview Questions: Get over 1,000 Interview Questions in an eBook for free when you join JobsAssist. Just click on the button below to join JobsAssist and you will immediately receive the Free eBook with thousands of Interview Questions in an ebook when you join.

Free Tutorials - HTML, Java, SQL, PHP, ASP, Perl, SQL Tutorials
Discuss Programming Problems and Freshers Jobs related issues here.
Discuss Final Year Project Ideas here.