unit_main.pas

扫雷

  for l_i:= 1 to l_DownGridArray .LocalTotalCols do
    for l_j:= 1 to l_DownGridArray .LocalTotalRows do
    begin
      //将是雷而没有标出来的将雷展开-41
      if (l_DownGridArray .grid[l_i][l_j] = 10 ) and
              ((l_UpGridArray .grid[l_i][l_j] = 11)
                or (l_UpGridArray .grid[l_i][l_j] = 32))  then
        l_UpGridArray .Grid[l_i][l_j]:= 41;

      //将不是雷而却标成雷了的快用标错了的雷块表示-43
      if (l_DownGridArray .grid[l_i][l_j] <> 10 )  and
              (l_UpGridArray .grid[l_i][l_j] = 31) then
        l_UpGridArray .Grid[l_i][l_j]:= 43;

    end;
  ChgSpbtnGlyph(f_Sad );

  isGameOver := true;
  isGameLost := true;

  //重扫本局的菜单可用
  Menu_Restart .Enabled :=true;

  //暂停 的菜单不可用
  Menu_Pause_Resume .Enabled :=false;

  GameStatus :=s_Lost;
  ChangeStatusBar(UserLevel ,UserTotalCols,UserTotalRows ,UserBombCount,GameStatus,LocalScore,LanguageType);
end;


procedure LeftAndRightBtnDown(lrd_DownGridArray:TGridArray ; var lrd_UpGridArray:TGridArray;lrd_Col,lrd_Row:Integer );
var
  lrd_i,lrd_j:integer;
begin
  case lrd_UpGridArray .Grid [lrd_Col ][lrd_Row ] of
    //"12" 的周围肯定不存在需要改变的方块
    12 : exit;

    11,32,31,21,22,23,24,25,26,27,28,33,13:
      begin
        //对其四周的方块进行逐个判断
        for lrd_i := -1 to 1 do
          for lrd_j :=-1 to 1do
            case lrd_UpGridArray .grid[lrd_Col +lrd_i][lrd_Row + lrd_j] of
              11 : lrd_UpGridArray .grid[lrd_Col +lrd_i][lrd_Row + lrd_j]:=13;
              32 : lrd_UpGridArray .grid[lrd_Col +lrd_i][lrd_Row + lrd_j]:=33
            end;
      end;
  end;
end;

procedure LeftAndRightBtnUp(lru_DownGridArray:TGridArray ;var lru_UpGridArray:TGridArray;lru_Col,lru_Row:integer );
var
  lru_i,lru_j:integer;
  lru_FlagCount:integer;
  WrongCount:integer;
  lru_ColArr,lru_RowArr :TOverColAndRow ;
  isWrong:boolean;
  i:integer;
begin
  case lru_UpGridArray .Grid [lru_Col ][lru_Row ] of
    12 : exit;
    13,31,33:
      begin
        for lru_i := -1 to 1 do
          for lru_j :=-1 to 1 do
            case lru_UpGridArray .grid[lru_Col +lru_i][lru_Row + lru_j] of
              13 : lru_UpGridArray .grid[lru_Col +lru_i][lru_Row + lru_j]:=11;
              33 : lru_UpGridArray .grid[lru_Col +lru_i][lru_Row + lru_j]:=32
            end;
      end;

    21,22,23,24,25,26,27,28:
      begin
        //
        lru_FlagCount := 0;
        for lru_i:= -1 to 1 do
          for lru_j:=-1 to 1 do
            if lru_UpGridArray .grid[lru_Col +lru_i][lru_Row + lru_j] = 31 then
              lru_FlagCount :=lru_FlagCount + 1;

        if lru_UpGridArray .grid[lru_Col ][lru_Row ] -20 = lru_FlagCount then
        // 显示的数字与周围标志的旗的数量相等时
        begin
          isWrong :=False;
          //判断是否有将不是累的标成了雷的块
            for lru_i := -1 to 1 do
              for lru_j:= -1 to 1 do
                if ((lru_UpGridArray .Grid [lru_Col+lru_i ][lru_Row + lru_j ] = 13)
                    or (lru_UpGridArray .Grid [lru_Col+lru_i  ][lru_Row+lru_j ] = 33))
                    and (lru_DownGridArray .grid[lru_Col + lru_i ][ lru_Row +lru_j ] <> 10 ) then
                  // DownGridArray '0'() UpGridArray ,
                  if lru_DownGridArray .grid[lru_Col + lru_i ][ lru_Row +lru_j ] <> 0 then
                  begin
                    lru_UpGridArray .grid[lru_Col + lru_i ][ lru_Row +lru_j ]:=
                        lru_DownGridArray .grid[lru_Col + lru_i ][ lru_Row +lru_j ] + 20;
                    BlockOpenCount :=BlockOpenCount +1;
                  end else
                    SeekBlackBlock(lru_DownGridArray ,lru_UpGridArray ,lru_Col+lru_i ,lru_Row+lru_j );

          for lru_i := -1 to 1 do
            for lru_j:= -1 to 1 do
              if (lru_DownGridArray .Grid [lru_Col + lru_i ][lru_Row +lru_j] <> 10 )
                  and (lru_UpGridArray .grid[lru_Col + lru_i][lru_Row +lru_j] = 31) then
                isWrong :=true;

          if isWrong <> false then
          //如果没有有标错了雷的块，则
          begin
            WrongCount :=1;
            for i:= 1 to 8 do
            begin
              lru_ColArr [i]:=0;
              lru_RowArr [i]:=0;
            end;
            for lru_i :=-1 to 1 do
              for lru_j:= -1 to 1 do
              begin
                //Down 是雷(10 )  Up 是原始块凹进去的(13)或是问号凹进去的 (33)
                if ((lru_UpGridArray .Grid [lru_Col+lru_i ][lru_Row+lru_j ] = 13 )
                      or (lru_UpGridArray .Grid [lru_Col+lru_i ][lru_Row+lru_j ] = 33 )) then
                  if  (lru_DownGridArray .grid[lru_Col + lru_i ][ lru_Row +lru_j ] = 10) then
                  begin
                    lru_ColArr [WrongCount]:=lru_Col + lru_i ;
                    lru_RowArr [wrongCount]:=lru_Row + lru_j ;
                    WrongCount :=WrongCount +1;
                  end
              end;
            Frm_Main.GameLost(lru_DownGridArray ,lru_UpGridArray ,lru_ColArr ,lru_RowArr );
          end;

        end else
        //
        begin
          for lru_i := -1 to 1 do
            for lru_j := -1 to 1 do
              if not ((lru_i =0 ) and(lru_j=0 ))then
                case lru_UpGridArray .grid[lru_Col +lru_i][lru_Row + lru_j] of
                  13 : lru_UpGridArray .grid[lru_Col +lru_i][lru_Row + lru_j]:=11;
                  33 : lru_UpGridArray .grid[lru_Col +lru_i][lru_Row + lru_j]:=32;
                end;
        end; { of If Else}
      end;  { of  21,22,23,24,25,26,27,28}
  end;
end;


procedure LeftBtnDown(ld_DownGridArray:TGridArray ;var ld_UpGridArray:TGridArray ;ld_Col,ld_Row:integer);
begin
  case ld_UpGridArray .Grid [ld_Col ][ld_Row ] of
    11 : ld_UpGridArray .grid[ld_Col ][ld_Row ] :=13;
    32 : ld_UpGridArray. grid[ld_Col ][ld_Row ] :=33;
    12,21,22,23,24,25,26,27,28,31: exit;
    else exit;
  end;
end;


procedure LeftBtnUp(lu_DownGridArray:TGridArray ;var lu_UpGridArray:TGridArray ;lu_Col,lu_Row:integer);
var
  lu_ColArr,lu_RowArr:TOverColAndRow ;
  i:integer;
begin
  case lu_UpGridArray .Grid [lu_Col ][lu_Row ] of
    //从被按下的空白原始块或是被按下的问号上UP时
    13,33 :
      begin
        case lu_DownGridArray .grid[lu_Col ][lu_Row ] of
          10 :
            begin
              for i:=1 to 8 do
              begin
                lu_ColArr [i]:=0;
                lu_RowArr [i]:=0;
              end;

              lu_ColArr [1]:=lu_Col ;
              lu_RowArr [1]:=lu_Row ;
              Frm_Main.GameLost(lu_DownGridArray ,lu_UpGridArray ,lu_ColArr ,lu_RowArr );
            end;
          0 :
            begin
              SeekBlackBlock(lu_DownGridArray ,lu_UpGridArray ,lu_Col ,lu_Row );
            end;

          1,2,3,4,5,6,7,8:
            begin
              lu_UpGridArray .grid[lu_Col ][lu_Row ] :=lu_DownGridArray .grid[lu_Col ][lu_Row ]+20;
              BlockOpenCount :=BlockOpenCount +1;
            end;
        end;
      end;
    12,21,22,23,24,25,26,27,28,31: exit;
  end;
end;

procedure RightBtnDown(rd_DownGridArray:TGridArray ;var rd_UpGridArray:TGridArray ;rd_Col,rd_Row:integer);
var
  rd_i:boolean;
begin
  rd_i:=True;

  if rd_i and ( rd_UpGridArray .Grid [rd_Col][rd_Row] = 11) then
  begin
    rd_i :=not true;
    rd_UpGridArray .Grid [rd_Col][rd_Row] := 31;
    FlagCount := FlagCount +1;
  end;

  if rd_i and ( rd_UpGridArray .Grid [rd_Col][rd_Row] = 31) then
  begin
    rd_i := not rd_i;
    FlagCount :=FlagCount -1;
    if isHaveQuestion then
    begin
      rd_UpGridArray .Grid [rd_Col][rd_Row] := 32;

    end else
    begin
      rd_UpGridArray .Grid [rd_Col][rd_Row] := 11;
    end;
  end;

  if rd_i and ( rd_UpGridArray .grid[rd_Col][rd_Row] = 32) then
  begin
    rd_UpGridArray .Grid [rd_Col][rd_Row] := 11;
  end;

  Frm_Main.DrawHead(UserBombCount -FlagCount ,d_left );
end;


procedure checkArr(var c_downGridArray,c_UpGridArray:TGridArray ;var c_BombCount:integer);
begin
  if c_DownGridArray .LocalTotalCols > g_MaxCol then
  begin
    c_DownGridArray.LocalTotalCols :=g_MaxCol;
    c_UpGridArray.LocalTotalCols :=g_MaxCol ;
  end;

  if c_DownGridArray  .LocalTotalRows > g_MaxRow then
  begin
    c_DownGridArray .LocalTotalRows := g_MaxRow ;
    c_UpGridArray .localTotalRows :=g_MaxRow ;
  end;

  if c_DownGridArray .LocalTotalCols < g_MinCol then
  begin
    c_DownGridArray.LocalTotalCols :=g_MinCol;
    c_UpGridArray.LocalTotalCols :=g_MinCol ;
  end;

  if c_DownGridArray  .LocalTotalRows < g_MinRow then
  begin
    c_DownGridArray .LocalTotalRows := g_MinRow ;
    c_UpGridArray .localTotalRows :=g_MinRow ;
  end;

  //控制雷数的最大值
  if c_BombCount >(c_DownGridArray .LocalTotalCols *c_downGridArray .LocalTotalRows ) *g_MaxPer then
    c_BombCount:= trunc((c_DownGridArray .LocalTotalCols *c_downGridArray .LocalTotalRows ) *g_MaxPer);

  if c_BombCount >999 then
    c_BombCount := 999;

  //控制雷数的最小值
  if c_BombCount < g_MinCount then
    c_BombCount :=g_MinCount;

  c_UpGridArray:=c_downGridArray ;
end;

procedure TFrm_Main.initForm(const totalCol,totalRow,i_bombCount:integer; const i_isHaveStatusBar:boolean);
var
  i_DisplayDir :TDisplayDir ;
begin
  //之所以取值如此大 8 4，是为了在初级时的菜单不至于双层显示！
  Panel_bottom .BorderWidth :=8;
  Panel_bottom .BevelWidth :=4;

  Panel_top .Height :=55;
  Panel_top .BorderWidth :=8;
  Panel_top .BevelWidth :=4;

  Panel_bottom .Width :=totalCol *g_BlockWidth +(Panel_bottom .BorderWidth +Panel_bottom .BevelWidth )*2;
  Panel_bottom .Height :=totalRow *g_BlockHeight  +(Panel_bottom .BorderWidth +Panel_bottom .BevelWidth )*2;
  Panel_top.Width :=Panel_bottom.Width ;

  Panel_bottom .Top :=50;

  //定制窗体的大小。
  ClientWidth :=Panel_bottom .Width ;

  //根据是否有状态栏定制窗体的高度； 调用函数
  CustomizeFrmClientRange(i_isHaveStatusBar);

  StatusBar_Mine.visible:=i_isHaveStatusBar;
  Menu_StatusBar.Checked :=i_isHaveStatusBar;

  Panel_Display_left.Left :=14;
  image_face.Width :=g_FaceWidth ;
  image_face.Height:=g_FaceHeight ;
  image_face.Left:=(Panel_top .Width div 2) - (image_face.Width  div 2);
  Panel_Display_right.Left :=Panel_top .Width - Panel_Display_left .left-g_NumWidth *3 -1 ;

  ChgSpbtnGlyph (f_smile );

  i_DisplayDir :=d_left ;
  DrawHead (i_bombCount, i_DisplayDir );

  i_DisplayDir :=d_right ;
  DrawHead (0,i_DisplayDir );
  
end;

procedure TFrm_Main.X1Click(Sender: TObject);
begin
  close;
end;

procedure TFrm_Main.FormClose(Sender: TObject; var Action: TCloseAction);
var
  l_i:integer; //语言;
  v_i:integer; //级别;
  c_REG:TRegistry;
begin
  case LanguageType of
    l_Chinese_Simplified : l_i:= 10;
    l_Chinese_Traditional : l_i:=11;
    l_English : l_i:= 20;
    else l_i:=10;
  end;

  case UserLevel of
    v_Beginner :v_i:=11;
    v_Middle :v_i:=12;
    v_Expert :v_i:=13;
    v_Professional :v_i:=14;
    v_UserDefine :v_i:=20;
    else v_i:=12;
  end;

  c_REG:=TRegistry.Create;
  c_REG.RootKey:=HKEY_CURRENT_USER;

  with c_REG do
  begin
    if not KeyExists(g_REG_InfoPath ) then
      CreateKey(g_REG_InfoPath);

    OpenKey(g_REG_InfoPath ,False);
    WriteInteger('Language',l_i);
    WriteInteger('Pos_Left',Left );
    WriteInteger('Pos_Top',Top );

    WriteInteger('Level',v_i );
    WriteInteger('LocalCols',UserTotalCols );
    WriteInteger('LocalRows',UserTotalRows );
    WriteInteger('BombCount',UserBombCount );
    WriteBool('IsHaveQuestion',isHaveQuestion );
    WriteBool('IsHaveColor',isHaveColor );
    WriteBool('IsHaveSound',isHaveSound );
    WriteBool('IsHaveStatusBar',isHaveStatusBar);

    CloseKey;
    Free;
  end;
  action:=cafree;
end;

procedure ChangePixelToBlock(pixelx,pixely:integer;var BlockCol,BlockRow:integer);
begin
  if pixelx< 0 then
    BlockCol :=pixelx div g_BlockWidth-1
  else
    BlockCol :=pixelx div g_BlockWidth +1;

  if pixely < 0 then