主题:[原创]扫雷
由于时间有限,界面不大好看,请大家见谅哈!
经测试,可在FP1.06及打过补丁的TP7.0下编译运行成功!
program sweep;
uses
crt;
type
boardnode=record
screen:char;
data:shortint;
end;
boardtype=array[1..10,1..20] of boardnode;
pointtype=record
data:char;
x:byte;
y:byte;
end;
minenode=record
x:byte;
y:byte;
end;
team_point=^team_node;
team_node=record
x:byte;
y:byte;
next:team_point;
end;
var
mine:array[1..100] of minenode;
hush:array[1..10,1..20] of boolean;
board:boardtype;
point:pointtype;
over:boolean;
n,flag:byte;
procedure init(n:byte);
var
m,i,j,k,l:byte;
begin
for i:=1 to 10 do
for j:=1 to 20 do
begin
board[i,j].data:=0;
board[i,j].screen:=' ';
end;
fillchar(hush,sizeof(hush),false);
randomize;
m:=0;
repeat
repeat
i:=random(10)+1;
j:=random(20)+1;
until board[i,j].data<>-1;
board[i,j].data:=-1;
m:=m+1;
mine[m].x:=i;
mine[m].y:=j;
until m>=n;
for i:=1 to 10 do
for j:=1 to 20 do
if board[i,j].data<>-1 then
for k:=(i-1) to (i+1) do
for l:=(j-1) to (j+1) do
if (k in [1..10]) and (l in [1..20]) then
if board[k,l].data=-1 then board[i,j].data:=board[i,j].data+1;
end;
procedure draw;
var
i,j:byte;
begin
gotoxy(1,1);
write('flag:');
write(n);
writeln(' ');
for i:=1 to 21 do write(#219);
writeln(#219);
for i:=1 to 10 do
begin
write(#219);
for j:=1 to 20 do write(' ');
writeln(#219);
end;
for i:=1 to 21 do write(#219);
writeln(#219);
end;
procedure start;
begin
gotoxy(1,1);
writeln('Please select:');
writeln('1.Easy');
writeln('2.Normal');
writeln('3.Hard');
case readkey of
'1':n:=10;
'2':n:=30;
'3':n:=50;
end;
flag:=n;
init(n);
draw;
end;
procedure lost;
var
s:string;
i,j:byte;
begin
over:=true;
gotoxy(6,7);
write('You are lost !');
gotoxy(6,8);
write('Press Anykey..');
readkey;
for i:=1 to 10 do
for j:=1 to 20 do
begin
gotoxy(j+1,i+2);
if board[i,j].data=-1 then write('*')
else
if board[i,j].screen='P' then write('X')
else
begin
if board[i,j].data=0 then write('.')
else
begin
str(board[i,j].data,s);
write(s);
end;
end;
end;
end;
procedure open(a,b:byte);
var
head,tail,temp:team_point;
s:string;
i,k,l,x,y:byte;
begin
hush[a,b]:=true;
new(head);
tail:=head;
head^.x:=a;
head^.y:=b;
head^.next:=nil;
while head<>nil do
begin
x:=head^.x;
y:=head^.y;
temp:=head;
head:=head^.next;
dispose(temp);
hush[x,y]:=false;
{visit begin}
if board[x,y].screen='P' then
begin
flag:=flag+1;
gotoxy(6,1);
write(flag:2);
end;
board[x,y].screen:='.';
gotoxy(y+1,x+2);
write('.');
if (x>1) and (board[x-1,y].data>0) then
begin
if board[x-1,y].screen='P' then
begin
flag:=flag+1;
gotoxy(6,1);
write(flag:2);
end;
str(board[x-1,y].data,s);
board[x-1,y].screen:=s[1];
gotoxy(y+1,x+1);
write(s[1]);
end;
if (y>1) and (board[x,y-1].data>0) then
begin
if board[x,y-1].screen='P' then
begin
flag:=flag+1;
gotoxy(6,1);
write(flag:2);
end;
str(board[x,y-1].data,s);
board[x,y-1].screen:=s[1];
gotoxy(y,x+2);
write(s[1]);
end;
if (x<10) and (board[x+1,y].data>0) then
begin
if board[x+1,y].screen='P' then
begin
flag:=flag+1;
gotoxy(6,1);
write(flag:2);
end;
str(board[x+1,y].data,s);
board[x+1,y].screen:=s[1];
gotoxy(y+1,x+3);
write(s[1]);
end;
if (y<20) and (board[x,y+1].data>0) then
begin
if board[x,y+1].screen='P' then
begin
flag:=flag+1;
gotoxy(6,1);
write(flag:2);
end;
str(board[x,y+1].data,s);
board[x,y+1].screen:=s[1];
gotoxy(y+2,x+2);
write(s[1]);
end;
{visit end}
for i:=1 to 4 do
begin
case i of
1:
begin
k:=x-1;
l:=y;
end;
2:
begin
k:=x;
l:=y-1;
end;
3:
begin
k:=x+1;
l:=y;
end;
4:
begin
k:=x;
l:=y+1;
end;
end;
if (k in [1..10]) and (l in [1..20]) then
if (board[k,l].data=0) and (board[k,l].screen<>'.') and (not hush[k,l]) then
if head=nil then
begin
hush[k,l]:=true;
new(head);
tail:=head;
head^.x:=k;
head^.y:=l;
head^.next:=nil;
end
else
begin
hush[k,l]:=true;
new(temp);
temp^.x:=k;
temp^.y:=l;
temp^.next:=nil;
tail^.next:=temp;
tail:=temp;
end;
end;
end;
end;
function win:boolean;
var
ans:boolean;
i:byte;
begin
ans:=true;
for i:=1 to n do
if board[mine[i].x,mine[i].y].screen<>'P' then
begin
ans:=false;
break;
end;
win:=ans;
end;
procedure play;
var
s:string;
enter:boolean;
begin
over:=false;
enter:=false;
point.x:=1;
point.y:=1;
while not over do
begin
point.data:=board[point.x,point.y].screen;
gotoxy(point.y+1,point.x+2);
if enter then write(#2)
else write('?');
gotoxy(point.y+1,point.x+2);
enter:=false;
case upcase(readkey) of
'W':if point.x>1 then
begin
gotoxy(point.y+1,point.x+2);
write(point.data);
gotoxy(point.y+1,point.x+2);
point.x:=point.x-1;
end;
'S':if point.x<10 then
begin
gotoxy(point.y+1,point.x+2);
write(point.data);
gotoxy(point.y+1,point.x+2);
point.x:=point.x+1;
end;
'A':if point.y>1 then
begin
gotoxy(point.y+1,point.x+2);
write(point.data);
gotoxy(point.y+1,point.x+2);
point.y:=point.y-1;
end;
'D':if point.y<20 then
begin
gotoxy(point.y+1,point.x+2);
write(point.data);
gotoxy(point.y+1,point.x+2);
point.y:=point.y+1;
end;
'J':if board[point.x,point.y].screen<>'P' then
if board[point.x,point.y].data=-1 then
begin
gotoxy(point.y+1,point.x+2);
write(#1);
gotoxy(point.y+1,point.x+2);
readkey;
lost;
end
else
begin
enter:=true;
if board[point.x,point.y].data=0 then open(point.x,point.y)
else
begin
str(board[point.x,point.y].data,s);
board[point.x,point.y].screen:=s[1];
gotoxy(point.y+1,point.x+2);
write(s[1]);
end;
end;
'K':if board[point.x,point.y].screen=' ' then
begin
if flag>0 then
begin
flag:=flag-1;
gotoxy(6,1);
write(flag:2);
board[point.x,point.y].screen:='P';
gotoxy(point.y+1,point.x+2);
write('P');
gotoxy(point.y+1,point.x+2);
end;
end
else
if board[point.x,point.y].screen='P' then
begin
flag:=flag+1;
board[point.x,point.y].screen:=' ';
gotoxy(6,1);
write(flag:2);
gotoxy(point.y+1,point.x+2);
write(' ');
gotoxy(point.y+1,point.x+2);
end;
end;
if win then
begin
over:=true;
gotoxy(6,7);
write('You are win !');
gotoxy(6,8);
write('Press Anykey..');
end;
end;
end;
{main}
begin
start;
play;
readkey;
end.
经测试,可在FP1.06及打过补丁的TP7.0下编译运行成功!
program sweep;
uses
crt;
type
boardnode=record
screen:char;
data:shortint;
end;
boardtype=array[1..10,1..20] of boardnode;
pointtype=record
data:char;
x:byte;
y:byte;
end;
minenode=record
x:byte;
y:byte;
end;
team_point=^team_node;
team_node=record
x:byte;
y:byte;
next:team_point;
end;
var
mine:array[1..100] of minenode;
hush:array[1..10,1..20] of boolean;
board:boardtype;
point:pointtype;
over:boolean;
n,flag:byte;
procedure init(n:byte);
var
m,i,j,k,l:byte;
begin
for i:=1 to 10 do
for j:=1 to 20 do
begin
board[i,j].data:=0;
board[i,j].screen:=' ';
end;
fillchar(hush,sizeof(hush),false);
randomize;
m:=0;
repeat
repeat
i:=random(10)+1;
j:=random(20)+1;
until board[i,j].data<>-1;
board[i,j].data:=-1;
m:=m+1;
mine[m].x:=i;
mine[m].y:=j;
until m>=n;
for i:=1 to 10 do
for j:=1 to 20 do
if board[i,j].data<>-1 then
for k:=(i-1) to (i+1) do
for l:=(j-1) to (j+1) do
if (k in [1..10]) and (l in [1..20]) then
if board[k,l].data=-1 then board[i,j].data:=board[i,j].data+1;
end;
procedure draw;
var
i,j:byte;
begin
gotoxy(1,1);
write('flag:');
write(n);
writeln(' ');
for i:=1 to 21 do write(#219);
writeln(#219);
for i:=1 to 10 do
begin
write(#219);
for j:=1 to 20 do write(' ');
writeln(#219);
end;
for i:=1 to 21 do write(#219);
writeln(#219);
end;
procedure start;
begin
gotoxy(1,1);
writeln('Please select:');
writeln('1.Easy');
writeln('2.Normal');
writeln('3.Hard');
case readkey of
'1':n:=10;
'2':n:=30;
'3':n:=50;
end;
flag:=n;
init(n);
draw;
end;
procedure lost;
var
s:string;
i,j:byte;
begin
over:=true;
gotoxy(6,7);
write('You are lost !');
gotoxy(6,8);
write('Press Anykey..');
readkey;
for i:=1 to 10 do
for j:=1 to 20 do
begin
gotoxy(j+1,i+2);
if board[i,j].data=-1 then write('*')
else
if board[i,j].screen='P' then write('X')
else
begin
if board[i,j].data=0 then write('.')
else
begin
str(board[i,j].data,s);
write(s);
end;
end;
end;
end;
procedure open(a,b:byte);
var
head,tail,temp:team_point;
s:string;
i,k,l,x,y:byte;
begin
hush[a,b]:=true;
new(head);
tail:=head;
head^.x:=a;
head^.y:=b;
head^.next:=nil;
while head<>nil do
begin
x:=head^.x;
y:=head^.y;
temp:=head;
head:=head^.next;
dispose(temp);
hush[x,y]:=false;
{visit begin}
if board[x,y].screen='P' then
begin
flag:=flag+1;
gotoxy(6,1);
write(flag:2);
end;
board[x,y].screen:='.';
gotoxy(y+1,x+2);
write('.');
if (x>1) and (board[x-1,y].data>0) then
begin
if board[x-1,y].screen='P' then
begin
flag:=flag+1;
gotoxy(6,1);
write(flag:2);
end;
str(board[x-1,y].data,s);
board[x-1,y].screen:=s[1];
gotoxy(y+1,x+1);
write(s[1]);
end;
if (y>1) and (board[x,y-1].data>0) then
begin
if board[x,y-1].screen='P' then
begin
flag:=flag+1;
gotoxy(6,1);
write(flag:2);
end;
str(board[x,y-1].data,s);
board[x,y-1].screen:=s[1];
gotoxy(y,x+2);
write(s[1]);
end;
if (x<10) and (board[x+1,y].data>0) then
begin
if board[x+1,y].screen='P' then
begin
flag:=flag+1;
gotoxy(6,1);
write(flag:2);
end;
str(board[x+1,y].data,s);
board[x+1,y].screen:=s[1];
gotoxy(y+1,x+3);
write(s[1]);
end;
if (y<20) and (board[x,y+1].data>0) then
begin
if board[x,y+1].screen='P' then
begin
flag:=flag+1;
gotoxy(6,1);
write(flag:2);
end;
str(board[x,y+1].data,s);
board[x,y+1].screen:=s[1];
gotoxy(y+2,x+2);
write(s[1]);
end;
{visit end}
for i:=1 to 4 do
begin
case i of
1:
begin
k:=x-1;
l:=y;
end;
2:
begin
k:=x;
l:=y-1;
end;
3:
begin
k:=x+1;
l:=y;
end;
4:
begin
k:=x;
l:=y+1;
end;
end;
if (k in [1..10]) and (l in [1..20]) then
if (board[k,l].data=0) and (board[k,l].screen<>'.') and (not hush[k,l]) then
if head=nil then
begin
hush[k,l]:=true;
new(head);
tail:=head;
head^.x:=k;
head^.y:=l;
head^.next:=nil;
end
else
begin
hush[k,l]:=true;
new(temp);
temp^.x:=k;
temp^.y:=l;
temp^.next:=nil;
tail^.next:=temp;
tail:=temp;
end;
end;
end;
end;
function win:boolean;
var
ans:boolean;
i:byte;
begin
ans:=true;
for i:=1 to n do
if board[mine[i].x,mine[i].y].screen<>'P' then
begin
ans:=false;
break;
end;
win:=ans;
end;
procedure play;
var
s:string;
enter:boolean;
begin
over:=false;
enter:=false;
point.x:=1;
point.y:=1;
while not over do
begin
point.data:=board[point.x,point.y].screen;
gotoxy(point.y+1,point.x+2);
if enter then write(#2)
else write('?');
gotoxy(point.y+1,point.x+2);
enter:=false;
case upcase(readkey) of
'W':if point.x>1 then
begin
gotoxy(point.y+1,point.x+2);
write(point.data);
gotoxy(point.y+1,point.x+2);
point.x:=point.x-1;
end;
'S':if point.x<10 then
begin
gotoxy(point.y+1,point.x+2);
write(point.data);
gotoxy(point.y+1,point.x+2);
point.x:=point.x+1;
end;
'A':if point.y>1 then
begin
gotoxy(point.y+1,point.x+2);
write(point.data);
gotoxy(point.y+1,point.x+2);
point.y:=point.y-1;
end;
'D':if point.y<20 then
begin
gotoxy(point.y+1,point.x+2);
write(point.data);
gotoxy(point.y+1,point.x+2);
point.y:=point.y+1;
end;
'J':if board[point.x,point.y].screen<>'P' then
if board[point.x,point.y].data=-1 then
begin
gotoxy(point.y+1,point.x+2);
write(#1);
gotoxy(point.y+1,point.x+2);
readkey;
lost;
end
else
begin
enter:=true;
if board[point.x,point.y].data=0 then open(point.x,point.y)
else
begin
str(board[point.x,point.y].data,s);
board[point.x,point.y].screen:=s[1];
gotoxy(point.y+1,point.x+2);
write(s[1]);
end;
end;
'K':if board[point.x,point.y].screen=' ' then
begin
if flag>0 then
begin
flag:=flag-1;
gotoxy(6,1);
write(flag:2);
board[point.x,point.y].screen:='P';
gotoxy(point.y+1,point.x+2);
write('P');
gotoxy(point.y+1,point.x+2);
end;
end
else
if board[point.x,point.y].screen='P' then
begin
flag:=flag+1;
board[point.x,point.y].screen:=' ';
gotoxy(6,1);
write(flag:2);
gotoxy(point.y+1,point.x+2);
write(' ');
gotoxy(point.y+1,point.x+2);
end;
end;
if win then
begin
over:=true;
gotoxy(6,7);
write('You are win !');
gotoxy(6,8);
write('Press Anykey..');
end;
end;
end;
{main}
begin
start;
play;
readkey;
end.