Keramatifar
پنج شنبه 23 فروردین 1386, 11:53 صبح
این سرس بازی minsweeperبه زبان پاسکال:
program logic;
uses
DOS,Crt,Graph;
procedure EgaVgaDriverProc; external;
{$L EGAVGA.OBJ }
type
grid = array [0..49] of array [0..15] of integer;
var
map : grid;
tag : grid;
regs : Registers;
old : Registers;
GraphDriver : integer;
GraphMode : integer;
ErrorCode : integer;
a,b,c,d,e : integer;
j,k : integer;
x,y,xx,yy : integer;
row,col : integer;
count,runid : integer;
mines,score : integer;
mapx,mapy : integer;
idle1,idle2 : integer;
oldxx,oldyy : integer;
goodx,goody : integer;
flags : integer;
size : word;
s : string[15];
bang : pointer;
{ ----- procedure for drawing blank buttons ----- }
procedure button(bx,by : integer);
begin
bx := mapx + (bx*10);
by := mapy + (by*10);
setfillstyle(1,7);
bar(bx,by,bx+9,by+9);
setcolor(15);
line(bx,by,bx+9,by);
line(bx+9,by+1,bx+9,by+8);
setcolor(8);
line(bx,by+1,bx,by+9);
line(bx+1,by+9,bx+9,by+9);
end;
{ ----- procedure for drawing exposed buttons (tiles) ----- }
procedure tile(tx,ty : integer);
var
loc,lx,ly : integer;
begin
loc := map[tx][ty];
lx := mapx + (tx*10);
ly := mapy + (ty*10);
setfillstyle(1,7);
bar(lx,ly,lx+9,ly+9);
setcolor(8);
line(lx,ly,lx+9,ly);
line(lx,ly,lx,ly+9);
if (tag[tx][ty] = 2) and (loc < 9) then { you blew it! }
begin
setcolor(0);
outtextxy(lx+2,ly+2,'*');
setcolor(12);
outtextxy(lx+2,ly+2,'/');
end
else
case loc of
0:
begin
setcolor(4);
outtextxy(lx+2,ly+2,'ْ');
end;
1..8:
begin
setcolor(4);
str(loc,s);
outtextxy(lx+2,ly+2,s);
end;
9:
begin
setcolor(0);
outtextxy(lx+2,ly+2,'*');
end;
end;
end;
{ ----- procedure for a recursive search of the playing field ----- }
procedure search(sx,sy : integer);
begin
e := 0;
if (sx < 0) or (sy < 0) then e := 1;
if (sx = col) or (sy = row) then e := 1;
if e = 0 then
begin
if tag[sx][sy] = 0 then
begin
tag[sx][sy] := 1;
tile(sx,sy);
if map[sx][sy] = 0 then
begin
search(sx-1,sy);
search(sx+1,sy);
search(sx,sy-1);
search(sx,sy+1);
search(sx-1,sy-1);
search(sx+1,sy-1);
search(sx-1,sy+1);
search(sx+1,sy+1);
end;
end; { if location is untagged }
end; { if coordinates are valid }
end; { end procedure search }
{ ----- begining of main procedure ----- }
begin
{ seed random number generator and clear screen }
Randomize;
ClrScr;
{ register graphics driver }
if RegisterBGIdriver(@EGAVGADriverProc) < 0 then halt(3);
GraphDriver := VGA; GraphMode := 0; InitGraph(GraphDriver,GraphMode,'');
{ say, setting graphmode to 2 doubles your screen height }
ErrorCode:=GraphResult;
if ErrorCode <> grOK then
begin
WriteLn('Unknown graphics mode.');
Halt(1);
end;
{ call interrupt 033h with a zero and check for a mouse driver }
regs.AX := 0; intr(51,regs);
if regs.AX = 0 then
begin
closegraph;
writeln('Mouse driver not detected.');
Halt(2);
end;
size := imagesize(300,90,320,110);
getmem(bang,size);
setcolor(7);
line(310,97,310,103);
line(305,100,315,100);
getimage(300,90,320,110,bang^);
putimage(300,90,bang^,1);
setvisualpage(1);
setactivepage(1);
setfillstyle(1,0); bar(0,0,639,199); { clear spare page }
setvisualpage(0);
setactivepage(0);
setfillstyle(1,1); bar(0,0,639,199); { clear screen to blue and draw playing grid }
if paramcount > 0 then outtextxy(300,2,paramstr(1));
setfillstyle(1,2); bar(538, 8,639, 32); setcolor(15); outtextxy(540,10,'New');
setfillstyle(1,3); bar(538, 38,639, 62); setcolor(15); outtextxy(540,40,'Beginner');
setfillstyle(1,4); bar(538, 68,639, 92); setcolor(15); outtextxy(540,70,'Intermediate');
setfillstyle(1,5); bar(538, 98,639,122); setcolor(15); outtextxy(540,100,'Expert');
setfillstyle(1,6); bar(538,128,639,152); setcolor(15); outtextxy(540,130,'Custom');
setfillstyle(1,8); bar(538,178,639,199); setcolor(15); outtextxy(540,180,'Quit?');
{ initialize global values, arrays and graphics }
idle1 := 0; { left button idle time counter }
idle2 := 0; { right button idle time counter }
mines := 10; { initial number of mines }
row := 10; { starting grid size }
col := 10;
repeat { this is the main loop }
runid := 0; { runid 0 = play, 1 = quit, 2 = win, 3 = restart }
mapx := trunc((50 - col)/2)*10 + 10; { starting grid offsets }
mapy := trunc((18 - row)/2)*10 + 10;
for a := 0 to (col-1) do
for b := 0 to (row-1) do
map[a][b] := 0; { clear map of random data }
for a := 0 to (col-1) do
for b := 0 to (row-1) do
tag[a][b] := 0; { array used to determine end }
for count := 1 to mines do { place mines on map, allow no overlaps }
begin
b := 0;
repeat
x := random(col);
y := random(row);
if map[x][y] = 9 then
b := 0
else
b := 1;
map[x][y] := 9;
until b = 1;
for c := -1 to 1 do
for d := -1 to 1 do
begin
a := x + c;
b := y + d;
e := 0;
if (c = 0) and (d = 0) then e := 1;
if (a < 0) or (b < 0) then e := 1;
if (a = col) or (b = row) then e := 1;
if (e = 0) and (map[a][b] < 9) then map[a][b] := map[a][b] +1;
end;
end; { end of mine creation routine }
setfillstyle(1,1); bar(0,0,537,199); { clear screen to blue }
for a := 0 to (col-1) do
for b := 0 to (row-1) do
button(a,b);
e := 0;
repeat
goodx := random(col);
goody := random(row);
if map[goodx][goody] = 0 then e := 1;
until e = 1;
tile(goodx,goody);
regs.AX:=3; intr(51,regs); { ask driver for mouse status }
xx := regs.CX; { copy to working variables & check }
yy := regs.DX; { for a change in mouse variables }
if xx < 10 then xx := 10;
if yy < 10 then yy := 10;
if xx > 629 then xx := 629;
if yy > 189 then yy := 189;
putimage(xx-10,yy-10,bang^,1);
old.bx := regs.bx; { draw cursor and save registers }
oldxx := xx;
oldyy := yy;
score := 0; { reset score }
flags := 0;
repeat { iterative loop for user input }
regs.AX := 3; intr(51,regs); { ask driver for mouse status }
xx := regs.CX; { copy to working variables & check }
yy := regs.DX; { for a change in mouse variables }
if xx < 10 then xx := 10;
if yy < 10 then yy := 10;
if xx > 629 then xx := 629;
if yy > 189 then yy := 189;
if idle1 > 0 then idle1 := idle1 -1;
if idle2 > 0 then idle2 := idle1 -1;
if (old.bx <> regs.bx) or (oldxx <> xx) or (oldyy <> yy) then
begin
putimage(oldxx-10,oldyy-10,bang^,1); { erase cursor }
old.bx := regs.bx; { save registers }
oldxx := xx;
oldyy := yy;
putimage(xx-10,yy-10,bang^,1); { draw new cursor }
if ((xx mod 10)>0)and((yy mod 10)>0)and(xx>mapx)and(xx<(mapx+(col*10)))and(yy>mapy)and(yy<(mapy+(row*10))) then
begin
x := trunc(int((xx-mapx) / 10));
y := trunc(int((yy-mapy) / 10));
end { test for vaild locations }
else
begin
x := -1;
y := -1;
end; { flag bad locations }
if (regs.BX = 1) and (xx>537) and (idle1 < 1) then
begin
idle1 := 5;
case yy of
8 .. 32:
begin
c := col; d := row; runid := 3;
end;
38 .. 62:
begin
c := col; d := row; row := 10; col := 10; mines := 10; runid := 3;
end;
68 .. 92:
begin
c := col; d := row; row := 16; col := 16; mines := 40; runid := 3;
end;
98 ..122:
begin
c := col; d := row; row := 16; col := 30; mines := 99; runid := 3;
end;
128 ..152:
begin
c := col; d := row; runid := 4;
end;
178 ..199:
begin
runid := 1; c := col; d := row;
end;
end; { end of case }
end; { end of if button one }
if (regs.BX = 1) and (((x+1)*(y+1)) > 0) and (idle1 < 1) then
begin
idle1 := 5;
putimage(xx-10,yy-10,bang^,1);
case map[x][y] of
0:
begin
if tag[x][y] = 0 then
begin
setcolor(4);
setfillstyle(1,3);
search(x,y);
score := 0;
for a := 0 to (col-1) do
for b := 0 to (row-1) do
if tag[a][b] = 1 then score := score + tag[a][b];
setfillstyle(1,1);
bar(0,0,50,12);
setcolor(15);
str(score,s);
outtextxy(2,2,s);
if score + mines = (row * col) then
begin
runid := 2;
c := col;
d := row;
end; { end test for end-runid }
end; { end test for tagged locations }
end;
9:
begin
if tag[x][y] = 0 then
begin
setcolor(13);
setRGBpalette(1,254,254,254);
delay(5);
outtextxy(20,182,'BANG! You are dead.');
delay(5);
SetRGBPalette(1,0,0,48);
setfillstyle(1,1);
bar(20,182,500,192);
c := col;
d := row;
runid := 1;
end; { end test for tagged location }
end;
else { else case! }
begin
if tag[x][y] = 0 then
begin
tile(x,y);
tag[x][y] := 1;
score := score + 1;
setfillstyle(1,1);
bar(0,0,50,12);
setcolor(15);
str(score,s);
outtextxy(2,2,s);
if score + mines = (row * col) then
begin
runid := 2;
c := col;
d := row;
end;
end; { test tagged location }
end; { end of the case's else statement }
end; { end of the case }
putimage(xx-10,yy-10,bang^,1);
end; { end of select location if statement }
if (regs.BX = 2) and (((x+1)*(y+1)) > 0) and (idle2 < 1) then
begin
idle2 := 15;
putimage(xx-10,yy-10,bang^,1);
case tag[x][y] of
0:
begin
tag[x][y] := 2;
setcolor(0);
outtextxy((x*10)+mapx+2,(y*10)+mapy+2,'*');
flags := flags + 1;
setfillstyle(1,1);
bar(50,0,80,12);
setcolor(15);
str(flags,s);
outtextxy(52,2,s);
end;
2:
begin
tag[x][y] := 0;
flags := flags - 1;
setfillstyle(1,1);
bar(50,0,80,12);
setcolor(15);
str(flags,s);
outtextxy(52,2,s);
button(x,y);
end;
end; { end of case }
putimage(xx-10,yy-10,bang^,1);
end; { end of button 2 testing }
end; { end of if mouse is active statement }
if keypressed then
begin
e := 0;
s := readkey;
setvisualpage(2);
s := readkey;
if s = chr(27) then
begin
closegraph;
halt(1);
end;
setvisualpage(0);
end;
until (runid > 0); { end iterative play loop }
{ clean-up and end-runid options }
putimage(xx-10,yy-10,bang^,1);
setfillstyle(1,3);
for a := 0 to (c-1) do
for b := 0 to (d-1) do
tile(a,b);
if runid = 2 then
begin
setcolor(11);
outtextxy(20,180,'Congrats, you win.');
for a := 1 to 16 do
begin
setRGBpalette(1,random(256),random(256),random(256 ));
delay(60);
end;
SetRGBpalette(1,0,0,48);
end;
if runid <> 3 then
begin
if runid = 4 then
begin
setcolor(15);
setfillstyle(1,1);
bar(200,70,390,144);
line(200,70,390,70);
line(390,70,390,144);
line(390,144,200,144);
line(200,144,200,70);
for a := 0 to 2 do
begin
setfillstyle(1,a+2); bar(368,74+(a*24),378,82+(a*24));
setfillstyle(1,a+2); bar(368,84+(a*24),378,92+(a*24));
end;
outtextxy(210, 80,'Col [1..50]');
outtextxy(210,103,'Rows [1..16]');
outtextxy(210,127,'Mines [1..');
str((row*col),s);
outtextxy(290,127,s+']');
for a := 0 to 2 do outtextxy(370,75+(a*24),'>');
for a := 0 to 2 do outtextxy(370,85+(a*24),'<');
setfillstyle(1,1);
str(col,s); outtextxy(335,80,s);
str(row,s); outtextxy(335,103,s);
str(mines,s); outtextxy(335,127,s);
end
else
delay(500);
putimage(xx-10,yy-10,bang^,1);
repeat
regs.AX:=3;
intr(51,regs);
xx := regs.CX;
yy := regs.DX;
if xx < 10 then xx := 10;
if yy < 10 then yy := 10;
if xx > 629 then xx := 629;
if yy > 189 then yy := 189;
if (old.bx <> regs.bx)or(oldxx <> regs.cx)or(oldyy <> regs.dx) then
begin
putimage(oldxx-10,oldyy-10,bang^,1);
old.bx := regs.bx;
oldxx := xx;
oldyy := yy;
putimage(xx-10,yy-10,bang^,1);
end;
if (regs.BX = 1) and (runid = 4) then
case yy of
74.. 82:
if (xx > 367) and (xx < 379) then
begin
regs.BX := 0;
col := col +1;
if col > 50 then col := 50;
bar(335,80,365,90);
str(col,s); outtextxy(335,80,s);
bar(290,127,330,137);
str((row*col),s); outtextxy(290,127,s+']');
delay(100);
end;
84.. 92:
if (xx > 367) and (xx < 379) then
begin
regs.BX := 0;
col := col -1;
if col < 1 then col := 1;
bar(335,80,365,90);
str(col,s);
outtextxy(335,80,s);
bar(290,127,330,137);
str((row*col),s);
outtextxy(290,127,s+']');
delay(100);
end;
98..106:
if (xx > 367) and (xx < 379) then
begin
regs.BX := 0;
row := row +1;
if row > 16 then row := 16;
bar(335,103,365,113);
str(row,s);
outtextxy(335,103,s);
bar(290,127,330,137);
str((row*col),s);
outtextxy(290,127,s+']');
delay(100);
end;
108..116:
if (xx > 367) and (xx < 379) then
begin
regs.BX := 0;
row := row -1;
if row < 1 then row := 1;
bar(335,103,365,113);
str(row,s);
outtextxy(335,103,s);
bar(290,127,330,137);
str((row*col),s);
outtextxy(290,127,s+']');
delay(100);
end;
122..130:
if (xx > 367) and (xx < 379) then
begin
regs.BX := 0;
mines := mines +1;
if mines > (row*col) then mines := (row*col);
bar(335,127,365,137);
str(mines,s);
outtextxy(335,127,s);
delay(50);
end;
132..140:
if (xx > 367) and (xx < 379) then
begin
regs.BX := 0;
mines := mines -1;
if mines < 1 then mines := 1;
bar(335,127,365,137);
str(mines,s);
outtextxy(335,127,s);
delay(50);
end;
end;
if (regs.BX = 1) and (xx>537) then
begin
idle1 := 5;
case yy of
8 .. 32:
begin
c := col; d := row; runid := 3;
end;
38 .. 62:
begin
c := col; d := row; row := 10; col := 10; mines := 10; runid := 3;
end;
68 .. 92:
begin
c := col; d := row; row := 16; col := 16; mines := 40; runid := 3;
end;
98 ..122:
begin
c := col; d := row; row := 16; col := 30; mines := 99; runid := 3;
end;
128 ..152:
begin
c := col; d := row; regs.BX := 0; runid := 4;
setcolor(15);
setfillstyle(1,1);
bar(200,70,390,144);
line(200,70,390,70);
line(390,70,390,144);
line(390,144,200,144);
line(200,144,200,70);
for a := 0 to 2 do
begin
setfillstyle(1,a+2); bar(368,74+(a*24),378,82+(a*24));
setfillstyle(1,a+2); bar(368,84+(a*24),378,92+(a*24));
end;
outtextxy(210, 80,'Col [1..50]');
outtextxy(210,103,'Rows [1..16]');
outtextxy(210,127,'Mines [1..');
str((row*col),s);
outtextxy(290,127,s+']');
for a := 0 to 2 do outtextxy(370,75+(a*24),'>');
for a := 0 to 2 do outtextxy(370,85+(a*24),'<');
setfillstyle(1,1);
str(col,s); outtextxy(335,80,s);
str(row,s); outtextxy(335,103,s);
str(mines,s); outtextxy(335,127,s);
end;
178 ..199:
begin
runid := 1; c := col; d := row;
end;
end;
end;
if keypressed then
begin
e := 0;
s := readkey;
setvisualpage(1);
s := readkey;
if s = chr(27) then
begin
closegraph;
halt(1);
end;
setvisualpage(0);
end;
until (regs.bx > 0);
if runid <> 1 then
runid := 0;
putimage(xx-10,yy-10,bang^,1);
end;
if mines > (row*col) then mines := (row*col);
setfillstyle(1,1);
bar(0,0,510,199);
until (runid = 1);
closegraph;
end.
اگه میخوای حتما با VB بنویسی می تونی الگوریتمش رو از توی این سورس در بیاری و خودت با VB بنویسی
موفق باشی ...
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.