⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit_main.pas

📁 扫雷
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      begin
        for lrm_i := -1 to 1 do
          for lrm_j :=-1 to 1do
            case lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j] of
              13 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=11;
              33 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=32
            end;
      end;
    31,21,22,23,24,25,26,27,28:
      begin
        for lrm_i := -1 to 1 do
          for lrm_j :=-1 to 1do
            if (lrm_i =0 ) and(lrm_j=0 ) then
              Continue
            else
              case lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j] of
                13 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=11;
                33 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=32;
              end;
      end;
    33 :
      begin
        lrm_UpGridArray .Grid [lrm_Col ][lrm_Row ]:= 32;

        for lrm_i := -1 to 1 do
          for lrm_j :=-1 to 1 do
            if (lrm_i =0 ) and(lrm_j=0 ) then
              Continue
            else
              case lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j] of
                13 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=11;
                33 : lrm_UpGridArray .grid[lrm_Col +lrm_i][lrm_Row + lrm_j]:=32;
              end;
      end;
  end;
end;

procedure TFrm_Main.Image_BackGroundMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  moveCol,moveRow:integer;
begin
  //跳出过程的情况如下
  if isGameOver or isGamePaused or  not(isLeftBtnDown or isLeftAndRightBtnDown ) then
    exit;

  ChangePixelToBlock(x,y,moveCol ,moveRow );

  //对照鼠标移动到的方块是否是当前的方块
  if(moveCol <> LocalCol ) or (moveRow <> LocalRow ) then
    if isLeftAndRightBtnDown then
    //左右键一通按下时的移动
    begin
      //移出本方块,使其还原
      LeftAndRightBtnMoveOut(DownGridArray ,UpGridArray ,LocalCol,LocalRow );
      LocalCol :=moveCol;
      LocalRow :=moveRow ;
      //如果没有移出 Image 的区域,则执行新方块的被左右键一同按下的操作
      if (movecol >= 1 ) and (moveRow >= 1 ) and (moveCol <= UserTotalCols ) and (moveRow <= UserTotalRows )then
        LeftAndRightBtnDown (DownGridArray,UpGridArray ,LocalCol ,LocalRow );

    end else
      if isLeftBtnDown then
      //只有左键被按下
      begin
        //移出本方块,使其还原
        leftBtnMoveOut(DownGridArray ,UpGridArray ,LocalCol ,LocalRow );
        LocalCol :=moveCol ;
        LocalRow :=moveRow ;
        //如果没有移出 Image 的区域,则执行新方块的被左键按下的操作
        if (LocalCol >= 1 ) and (LocalRow >= 1 ) and (LocalCol <= UserTotalCols) and (LocalRow <= UserTotalRows )then
          LeftBtnDown(DownGridArray ,UpGridArray ,LocalCol ,LocalRow );
      end;
  DrawBackGround(UpGridArray ,false)
end;

procedure TFrm_Main.Timer_DisplayTimer(Sender: TObject);
begin
  if isHaveSound then
    sndPlaySound(pchar(comdir+g_ResourceName +g_sound_second),SND_ASYNC  );

  //使用 GetTickCount 以确保程序时间的准确性.
  TotalTime :=(GetTickCount -Begin_Time ) div 1000 +1;
  DrawHead(TotalTime ,d_right );
end;

procedure CheckMainFormPosition(frm_check:TForm );
begin
  //确保界面或是对话框存在于屏幕内部
  if frm_check .Left < 0 then
    frm_check.Left := 0;
  if frm_check .Top < 0 then
    frm_check .Top := 0;

  if (frm_check .Left + frm_check .Width ) >Screen .Width  then
    frm_check .Left := Screen.Width - frm_check .Width ;

  //30 是任务栏的高度
  if (frm_check  .Top + frm_check .Height )>screen.Height-30 then
    frm_check .Top := Screen .Height-30 -frm_check .Height ;
end;

procedure TFrm_Main.Panel_topMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if isGameOver then
    exit;
  if button = mbleft then
  begin
    ChgSpbtnGlyph(f_O );
  end;

  Image_BackGroundMouseDown (self, Button , Shift,x-Image_BackGround.left , y - Panel_bottom.Top - Image_BackGround.top);
end;

procedure TFrm_Main.Panel_topMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if isGameOver then
    exit;

  if Button = mbleft then
  begin
    ChgSpbtnGlyph(f_smile );
    isLeftBtnDown :=False;
  end else
    isRightbtnDown :=False;

  Image_BackGroundMouseUp (self,button,shift,x-Image_BackGround.left , y - Panel_bottom.Top - Image_BackGround.top);

end;

procedure TFrm_Main.Menu_Lv_BClick(Sender: TObject);
begin
  initApplication(v_Beginner ,g_Level_1_Col ,g_Level_1_Row ,g_Level_1_Bombcount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType );
end;

procedure TFrm_Main.Menu_Lv_IClick(Sender: TObject);
begin
  initApplication(v_Middle ,g_Level_2_Col ,g_Level_2_Row ,g_Level_2_Bombcount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType  );
end;

procedure TFrm_Main.Menu_Lv_EClick(Sender: TObject);
begin
  initApplication(v_Expert ,g_Level_3_Col ,g_Level_3_Row ,g_Level_3_Bombcount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType  );
end;

procedure TFrm_Main.Menu_Lv_PClick(Sender: TObject);
begin
  initApplication(v_Professional ,g_Level_4_Col ,g_Level_4_Row ,g_Level_4_Bombcount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType  );
end;

procedure TFrm_Main.N1Click(Sender: TObject);
begin
  initApplication(UserLevel ,UserTotalCols ,UserTotalRows ,UserBombCount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType  );
end;

procedure TFrm_Main.Menu_FlagClick(Sender: TObject);
begin
  isHaveQuestion :=not isHaveQuestion ;
  Menu_Flag .Checked :=isHaveQuestion ;
  checkMainFormPosition(Frm_Main );
end;

procedure TFrm_Main.Menu_ColorClick(Sender: TObject);
begin
  isHaveColor :=not isHaveColor ;
  Menu_Color .Checked :=isHaveColor ;
  checkMainFormPosition(Frm_Main );

  DrawBackGround (UpGridArray ,True);
  DrawHead(UserBombCount -FlagCount ,d_left );
  DrawHead(TotalTime ,d_right);
  if not isGameOver then
    ChgSpbtnGlyph (f_smile )
  else
    if isGameWin then
      ChgSpbtnGlyph(f_glass)
    else
      ChgSpbtnGlyph(f_sad);

end;

procedure TFrm_Main.Menu_SoundClick(Sender: TObject);
begin
  isHaveSound :=not isHaveSound ;
  Menu_Sound .Checked := isHaveSound ;
  checkMainFormPosition(Frm_Main );
end;

procedure TFrm_Main.Menu_Lv_CClick(Sender: TObject);
begin
  //初始化自定义 的Form ,并且 ShowModal;
  Application.CreateForm(TFrm_Choose, Frm_Choose);
  Frm_Choose .ShowModal ;
  //如果自定义了,则接受 Frm_Choose 传过来的参数.否则还是按当前的参数开始新局
  if UNit_Choose.Changed then
    initApplication(v_UserDefine ,Unit_Choose.userW, Unit_Choose.UserH ,Unit_Choose.UserM ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType  )
  else
    initApplication(UserLevel ,UserTotalCols ,UserTotalRows ,UserBombCount ,isHaveQuestion ,isHaveColor ,isHaveSound ,isHaveStatusBar ,LanguageType  );
end;

procedure ExportIniFile(var i_level:TGameLevel ;var i_totalCols,i_totalRows,i_bombCount:integer; var i_isHaveQuestion,i_isHaveColor,i_isHaveSound, i_isHaveStatusBar:boolean; var i_LanguageType:TLanguageType);
var
  e_REG:TRegistry;
begin
  //从注册表读取新信息
  e_REG:=TRegistry.Create;
  e_REG.RootKey:=HKEY_CURRENT_USER;

  with e_REG do
  begin
    OpenKey(g_REG_InfoPath ,False);

    case ReadInteger('Level') of
      11: i_level :=v_Beginner ;
      12: i_level :=v_Middle ;
      13: i_level :=v_Expert ;
      14: i_level :=v_Professional ;
      20: i_level :=v_UserDefine;
      else i_level :=v_Middle;
    end;

    i_totalCols :=ReadInteger ('LocalCols');
    i_totalRows :=ReadInteger('LocalRows');
    case ReadInteger('Language') of
      10: i_LanguageType :=l_Chinese_Simplified ;
      11: i_LanguageType :=l_Chinese_Traditional ;
      20: i_LanguageType :=l_English ;
      else i_LanguageType :=l_Chinese_Simplified;
    end;

    Frm_Main .Left :=ReadInteger('Pos_Left');
    Frm_Main .Top  :=ReadInteger('Pos_Top');

    i_bombCount :=ReadInteger('BombCount');
    i_ishaveQuestion :=ReadBool('IsHaveQuestion');
    i_ishaveColor :=ReadBool('IsHaveColor');
    i_ishaveSound :=ReadBool('IsHaveSound');
    i_ishaveStatusBar:=ReadBool('IsHaveStatusBar');

    CloseKey;
    free;
  end;
end;

procedure TFrm_Main.T1Click(Sender: TObject);
begin
  Application.CreateForm(TFrm_Hero, Frm_Hero);
  Frm_Hero.ShowModal ;
  checkMainFormPosition(Frm_Main );
end;

procedure TFrm_Main.A1Click(Sender: TObject);
begin
  Application.CreateForm(TFrm_About, Frm_About);
  frm_About .ShowModal ;
end;

procedure TFrm_Main.C2Click(Sender: TObject);
begin
  ShellExecute (Application.Handle,pchar('open'),pchar(comdir+g_ResourceName+g_ChmFileName),nil,nil,SW_show);
end;

procedure TFrm_Main.Image_FaceMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbleft then
  begin
    Timer_Display .Enabled :=False;
    ChgSpbtnGlyph(f_smileDown );
  end;

end;

procedure TFrm_Main.Image_FaceMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (x < 0) or (y < 0) or (x > Image_Face.Width) or (y > Image_Face.Height ) then
  begin
    if (not isGameOver) and (GameStatus =s_Sweeping )then
    begin
      TotalTime :=TotalTime +1;
      if isHaveSound then
        sndPlaySound(pchar(comdir+g_ResourceName +g_Sound_Second),SND_ASYNC  );
      DrawHead(TotalTime,d_right );
      Timer_Display.Enabled :=true
    end;

    if isGameWin then
      ChgSpbtnGlyph(f_glass )
    else if isGameLost then
      ChgSpbtnGlyph(f_sad)
    else
      ChgSpbtnGlyph(f_smile );

  end else
    if (button = mbleft ){and (isGameOver ) }then
      N1Click (self);

end;


// For cheating !
procedure TFrm_Main.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
{  if( key =27) and (isLeftAndRightBtnDown ) then
    Timer_Display.Enabled :=false;
}
end;

procedure TFrm_Main.Panel_topMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if isGameOver then
    exit;
  Image_BackGroundMouseMove(self,  Shift, x-Image_BackGround.left , y-Panel_bottom .top-Image_BackGround.top);
end;

procedure TFrm_Main.Image_Dis_BombCountMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  Panel_topMouseMove(self,shift,x + Image_Dis_BombCount.Left + Panel_Display_left.Left ,y + Image_Dis_BombCount.top + Panel_Display_left.Top );
end;

procedure TFrm_Main.Image_Dis_TimeMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  Panel_topMouseMove(self,shift,x + Image_Dis_Time .Left + Panel_Display_right .Left ,y + Image_Dis_Time.top + Panel_Display_right .Top );
end;

procedure TFrm_Main.Image_Dis_BombCountMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel_topMouseDown(self,button,shift,x + Image_Dis_BombCount.Left + Panel_Display_left.Left ,y + Image_Dis_BombCount.top + Panel_Display_left.Top );
end;

procedure TFrm_Main.Image_Dis_TimeMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel_topMouseDown(self,button,shift,x + Image_Dis_Time .Left + Panel_Display_right .Left ,y + Image_Dis_Time.top + Panel_Display_right .Top );
end;

procedure TFrm_Main.Image_Dis_BombCountMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel_topMouseUp(self,button,shift,x + Image_Dis_BombCount.Left + Panel_Display_left.Left ,y + Image_Dis_BombCount.top + Panel_Display_left.Top );
end;

procedure TFrm_Main.Image_Dis_TimeMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel_topMouseUp(self,button,shift,x + Image_Dis_Time .Left + Panel_Display_right .Left ,y + Image_Dis_Time.top + Panel_Display_right .Top );
end;

procedure TFrm_Main.Panel_Display_leftMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel_topMouseDown(self,button,shift,x + Panel_Display_left.Left ,y + Panel_Display_left.Top );
end;

procedure TFrm_Main.Panel_Display_leftMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  Panel_topMouseMove(self,shift,x + Panel_Display_left.Left ,y + Panel_Display_left.Top );
end;

procedure TFrm_Main.Panel_Display_leftMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel_topMouseUp(self,button,shift,x + Panel_Display_left.Left ,y + Panel_Display_left.Top );
end;

procedure TFrm_Main.Panel_Display_rightMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel_topMouseDown(self,button,shift,x + Panel_Display

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -