回 帖 发 新 帖 刷新版面

主题:[原创]扫雷

由于时间有限,界面不大好看,请大家见谅哈!

经测试,可在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.

回复列表 (共6个回复)

沙发

楼主真疯狂

板凳

太厉害了
不管程序对不对,能遍出来就很厉害了
不知道我什么时候能到这个水平啊

3 楼

呵呵,这是为了准备NOIP进行恢复训练时写的。由于时间有限界面做的很烂,不过还是能将就玩“WSAD”分别对应“上下左右”,“J”是踩,“K”是标记地雷。我这个程序判断胜利的方式是看每颗地雷是否都被标记,所以必须标记了所有的雷才能胜利。游戏开始时有个难度选择,只需按对应的数字键就行了!

PS,我的BLOG上还有我原来写的游戏/软件代码,大家如果感兴趣可以去看看!
http://blog.sina.com.cn/u/1077089055

4 楼

代码已经更新:
主要改进了打开无地雷方格时的判重的算法:使用了一个二维的哈希表来判重,大大提升了处理速度!

5 楼

太厉害拉,用pascal编游戏
[em17]

6 楼


游戏狂人!!!

我来回复

您尚未登录,请登录后再回复。点此登录或注册