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

📄 unit1.pas

📁 这个软件是用Delphi 7开发的。 原本它是两个人在纸面上玩的益智游戏
💻 PAS
📖 第 1 页 / 共 4 页
字号:
            CheckPlaneCou;
            ShowMsgInList(msg_NewGame, 1);
            GridPanel1.NewGame(False, in_PlaneCou);
         end;
      mrNo: ;
   end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
   ReadIni; in_From3Created := False;
   Computer := TComputer.Create;
   AudioEffectThread := TAudioEffectThread.Create(True);
   if in_ShowOnStart = True then begin
      in_From3Created := True;
      Form3 := TForm3.Create(frmMain);
      Form3.CheckBox1.Checked := True;
      Form3.Show;
   end;
   in_NotExited := True;
   in_OnlineGame := False;
   in_InfoListMouseDown := False;
   ActiveGame.IP := GetLocalIP;
   ActiveGame.in_Connected := False;
   MenuNowPort.Caption := '当前端口:' + IntToStr(ClientSocket.Port);
   MenuNowIP.Caption := '本机IP:' + GetLocalIP;
   InfoListClear;
   CheckPlaneCou;
   ShowMsgInList(msg_NewGame, 1);
   GridPanel1.NewGame(True, in_PlaneCou);
end;

procedure TfrmMain.Readini;
begin
   in_DirectoryPath := ExtractFilePath(Application.ExeName);
   if FileExists(in_DirectoryPath + 'Set.ini') = False then
      fileClose(FileCreate(in_DirectoryPath + 'Set.ini'));
   MyIniFile := TIniFile.Create(in_DirectoryPath + 'Set.ini');
   in_GridCount := MyIniFile.ReadInteger(str_General, 'GridCount', 10);
   if not in_GridCount in [10, 15, 20] then
      in_GridCount := 10;
   case in_GridCount of
      10: MenuSize1.Checked := True;
      15: MenuSize2.Checked := True;
      20: MenuSize3.Checked := True;
   end;
   GridPanel1.ChangeGridCou(in_GridCount);
   GridPanel2.ChangeGridCou(in_GridCount);

   in_GridColor := clWhite;
   in_GridActiveColor := clOlive;

   in_PlayerGuessFirst := MyIniFile.ReadInteger(str_General, 'PlayerGuessFirst', 1) = 1;
   MenuPlayerGuessFirst.Checked := in_PlayerGuessFirst;

   in_PlaneCou := MyIniFile.ReadInteger(str_General, 'PlaneCou', 3);
   in_ShowMsgList := True;
   MenuShowMsgList.Checked := True;

   if not in_PlaneCou in [1..9] then
      in_PlaneCou := 3;
   in_ConPlay := True;

   in_TimedGame := MyIniFile.ReadBool(str_General, 'TimedGame', False);
   MenuTimedGame.Checked := in_TimedGame;

   in_ShowOnStart := MyIniFile.ReadBool(str_General, 'ShowOnStart', True);
   in_GridFlashType := MyIniFile.ReadInteger(str_General, 'GridFlashType', 1);
   in_AudioEffect := MyIniFile.ReadBool(str_General, 'AudioEffect', True);
   MenuAudioEffect.Checked := in_AudioEffect;

   in_AutoActive := MyIniFile.ReadBool(str_General, 'AutoActive', True);
   if in_AutoActive then
      ServerSocket.Active := True;
end;

procedure TfrmMain.GridPanel1GridsMouseMove(Sender: TObject);
begin
   StatusBar1.Panels[(Sender as TComponent).Tag].Text := GridPosToChar((Sender as TPlanePanel).ActiveGridX, (Sender as TPlanePanel).ActiveGridY);
end;

procedure TfrmMain.ShowMsgInList(Msg: string; TextType: Byte = 0);
begin
   InfoList.Items.Add(msg);
   in_InfoListType := in_InfoListType + IntToStr(TextType);
   InfoList.Selected[InfoList.Count - 1] := True;
   InfoList.Repaint;
end;

procedure TfrmMain.MenuNewGameDrawPlaneClick(Sender: TObject);
begin
   case MessageDlg(msg_DropThisRound, mtConfirmation, [mbYes, mbNo], 0) of
      mrYes: begin
            LocalGameEnd;
            InfoListClear;
            if in_ConPlay then begin
               CheckPlaneCou;
               ShowMsgInList(msg_NewGame, 1);
               GridPanel1.NewGame((Sender as TComponent).Tag = 2, in_PlaneCou);
            end else
               GridPanel1.NewGame(False, in_PlaneCou, False);
         end;
      mrNo: ;
   end;
end;

procedure TfrmMain.MenuPlaneNumClick(Sender: TObject);
var i: string; t, code: Integer;
begin
   case MessageDlg(msg_DropThisRound, mtConfirmation, [mbYes, mbNo], 0) of
      mrYes: begin
            LocalGameEnd;
            InfoListClear;
            ShowMsgInList(msg_NewGame, 1);
            i := inputbox('输入飞机数目', '飞机数目(1~9):      ', IntToStr(in_PlaneCou));
            val(i, t, Code);
            if (Code = 0) and (t in [1..9]) then
               in_PlaneCou := t;
            CheckPlaneCou;
            GridPanel1.NewGame(False, in_PlaneCou);
         end;
      mrNo: ;
   end;
end;

procedure TfrmMain.MenuPlayerGuessFirstClick(Sender: TObject);
begin
   if MessageDlg(msg_DropThisRound, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
      LocalGameEnd;
      in_PlayerGuessFirst := not in_PlayerGuessFirst;
      InfoListClear;
      ShowMsgInList(msg_NewGame, 1);
      GridPanel1.NewGame(True, in_PlaneCou);
   end;
   MenuPlayerGuessFirst.Checked := in_PlayerGuessFirst;
end;

procedure TfrmMain.GridPanel2SameGridGuessed;
begin
   PerformAudioEffect(3);
   ShowMsgInList(msg_SameGridGuesses + chr(GridPanel2.ActiveGridX + 65) + IntToStr(GridPanel2.ActiveGridY + 1), 3);
end;

procedure TfrmMain.RefreshHitData;
begin
   with GridPanel2.GuessData do begin
      if tryCount = 0 then exit;
      StatusBar1.Panels[2].Text := '总发弹数:' + IntToStr(tryCount) +
         '   击中数:' + IntToStr(Hit) +
         '   击落飞机数:' + IntToStr(KnockDown) +
         '   还剩飞机数:' + IntToStr(in_PlaneCou - KnockDown) +
         '   命中率:' + FormatFloat('#,###0.000', Hit / tryCount);
   end;
end;

//使用一个线程是为了防止拨放声音的时候程序不进行其它活动,造成延迟

procedure TAudioEffectThread.Execute;
begin
   while in_NotExited do begin
      PlaySound(pChar('A' + IntToStr(Kind)), HInstance, SND_RESOURCE);
      AudioEffectThread.Suspend;
   end;
end;

procedure TfrmMain.PerformAudioEffect(idx: Byte);
begin
   AudioEffectThread.Kind := idx;
   AudioEffectThread.Resume;
end;

procedure TfrmMain.MenuConPlayClick(Sender: TObject);
begin
   if MessageDlg(msg_DropThisRound, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
      LocalGameEnd;
      in_ConPlay := not in_ConPlay;
      if in_ConPlay = True then begin
         MessageDlg(msg_ConPlay, mtConfirmation, [mbOK], 0);
         InfoListClear;
         CheckPlaneCou;
         ShowMsgInList(msg_NewGame, 1);
         GridPanel1.NewGame(False, in_PlaneCou);
         MenuNewGameDrawPlane.Enabled := True;
      end else begin
         MessageDlg(msg_NotConPlay, mtConfirmation, [mbOK], 0);
         GridPanel1.NewGame(False, in_PlaneCou, False);
         MenuNewGameDrawPlane.Enabled := False;
      end;
   end;
   MenuConPlay.Checked := in_ConPlay;
end;

procedure TfrmMain.MenuTimedGameClick(Sender: TObject);
begin
   in_TimedGame := not in_TimedGame;
   MenuTimedGame.Checked := in_TimedGame;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
label quit;
begin
   if in_OnlineGame then
      if MessageDlg('正与' + ActiveGame.OtherIP + '连接中,' + msg_ReallyWantToQuit, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
         SocketSend('18 ' + '#');
         goto Quit
      end else begin
         CanClose := False;
         exit;
      end;
   quit:
   in_NotExited := False;
   MyIniFile.WriteInteger(str_General, 'GridCount', in_GridCount);
   MyIniFile.WriteBool(str_General, 'PlayerGuessFirst', in_PlayerGuessFirst);
   MyIniFile.WriteInteger(str_General, 'PlaneCou', in_PlaneCou);
   MyIniFile.WriteBool(str_General, 'TimedGame', in_TimedGame);
   MyIniFile.WriteBool(str_General, 'ShowOnStart', in_ShowOnStart);
   MyIniFile.WriteInteger(str_General, 'GridFlashType', in_GridFlashType);
   MyIniFile.WriteBool(str_General, 'AudioEffect', in_AudioEffect);
   MyIniFile.WriteBool(str_General, 'AutoActive', in_AutoActive);
   AudioEffectThread.DoTerminate;
   AudioEffectThread.Free;
   MyIniFile.Free;
   Computer.Free;
   canclose := True;
end;

procedure TfrmMain.GridPanel1NewGameStart;
begin
   if in_OnlineGame = True then begin
      MenuOnlineGameAutoGeneratePlane.Enabled := False;
      ActiveGame.SelfPlaneReady := True;
      ChangeActiveGame_In_State(6);
      PackPlaneDataAndSend;
      if ActiveGame.OpponentPlaneReady = True then
         if ActiveGame.GameBuilder then
            PlaneReady
         else
            SocketSend('13 ' + '#')
      else
         ShowMsgInList(msg_PlaneDrawnAndWait, 1);
      exit;
   end;

   in_GameOnSeconds := 0;
   GameTimer.Enabled := True;

   Computer.NewGameInit;
   Computer.GeneratePlanes;
   MenuQuit.Enabled := True;
   in_PlayerInRisk := False;
   if in_ConPlay = True then
      if in_PlayerGuessFirst = True then begin
         ShowMsgInList(msg_PlaneDrawn + msg_PlayerGuess, 1);
         GridPanel2.Mode := 3; //User Guess
      end else begin
         ShowMsgInList(msg_PlaneDrawn + msg_ComputerGuess, 1);
         GridPanel2.Mode := 4; //Computer Guess
         Computer.Think;
      end
   else begin
      ShowMsgInList(msg_PlaneDrawn + msg_PlayerGuess, 1);
      GridPanel2.Mode := 3; //User Guess
   end;
end;

procedure TfrmMain.GameTimerTimer(Sender: TObject); //记时器
var min, sec: Word; sMin, sSec: string;
begin
   inc(in_GameOnSeconds);
   if in_TimedGame = False then begin
      StatusBar1.Panels[3].Text := '';
      exit;
   end;
   Min := in_GameOnSeconds div 60; sMin := IntToStr(Min);
   sec := in_GameOnSeconds mod 60; sSec := IntToStr(sec);
   if Length(sMin) = 1 then sMin := '0' + sMin;
   if Length(sSec) = 1 then sSec := '0' + sSec;
   StatusBar1.Panels[3].Text := msg_GameOnTime + ' ' + sMin + ':' + sSec;
end;

function TfrmMain.GridPosToChar(x, y: Byte): string;
begin
   Result := chr(X + 65) + IntToStr(Y + 1);
end;

procedure TfrmMain.GridPanel2OneGridGuessed(x, y, GridType, PlaneIdx: Byte); //GridPanel2的一个格子被点击
begin
   if in_AudioEffect then PerformAudioEffect(GridType);
   ShowMsgInList(msg_OneGridGuessed[GridType] + GridPosToChar(GridPanel2.ActiveGridX, GridPanel2.ActiveGridY), 2);
   RefreshHitData;
   if in_OnlineGame = True then begin
      Lock;
      SocketSend('16 ' + IntToStr(x) + ',' + IntToStr(y) + '#');
      if GridType = 1 then
         SocketSend('21 ' + IntToStr(PlaneIdx) + '#'); //Hit opponent plane's head
      if ActiveGame.inRisk = True then
         if GridPanel2.GuessData.KnockDown = ActiveGame.PlaneCou then begin
            SocketSend('25 ' + '#'); //Game end in tie
            OnlineGameShowResult(3); // 3:Tie
         end else begin
            SocketSend('24 ' + '#'); // opponent win
            OnlineGameShowResult(2); // 2:lose
         end;
      if GridPanel2.GuessData.KnockDown <> ActiveGame.PlaneCou then
         SocketSend('28 ' + '#'); //Safe Asked
   end else
      if in_PlayerInRisk then begin
         if GridPanel2.GuessData.KnockDown = in_PlaneCou then //平局
            LocalGameShowResult(3) // 3:Tie
         else
            LocalGameShowResult(2); // 2:lose
      end else
         if (in_ConPlay = True) then begin
            GridPanel2.Mode := 4;
            Computer.Think; //电脑思考
         end;
end;

procedure TfrmMain.GridPanel2PlanesAllKnockedDown(playerWin: Boolean);  //所有飞机都被击落
begin
   if in_OnlineGame then begin
      GridPanel2.Mode := 5;
      if ActiveGame.inRisk = True then exit; //已交由GridPanel2OneGridGuessed处理了
      if (ActiveGame.GameBuilder <> ActiveGame.GameBuilderFirst) then begin //比如说,你是GameBuilder,可GameBuilderFirst却为False,对手先猜,那你一定赢了,不可能平局
         SocketSend('23 ' + '#'); //you win
         OnlineGameShowResult(1); //win
      end else begin
         SocketSend('22 ' + '#');
         MessageDlg(msg_HaveHitDownAllPlanesButYouFirstGuessed, mtInformation, [mbOK], 0);
         Lock;
      end;
      exit;
   end;

   if in_ConPlay then begin
      if Computer.inRisk or in_PlayerInRisk then exit; //不在这里处理
      if playerWin <> in_PlayerGuessFirst then begin //胜负已定
         if playerWin then
            LocalGameShowResult(1)
         else
            LocalGameShowResult(2);
      end else //先手先猜完,可能出现平局
         if playerWin then begin
            Computer.inRisk := True; //电脑危险了
            MessageDlg(msg_ComputerInRisk, mtInformation, [mbOK], 0);
            GridPanel2.Mode := 4;
            Computer.Think; //电脑思考
         end else begin
            in_PlayerInRisk := True;  //选手危险了
            MessageDlg(msg_PlayerInRisk, mtInformation, [mbOK], 0);
            GridPanel2.Mode := 3;
         end;
   end else
      if MessageDlg(msg_NotConGamePlaneAllDown, mtInformation, [mbYes, mbNo], 0) = mrYes then
         GridPanel1.NewGame(False, in_PlaneCou, False)
      else
         GridPanel2.Mode := 5;
end;

procedure TfrmMain.LocalGameShowResult(r: Byte); //Player what? 1:Win 2:Lose 3:Tie
begin
   GameTimer.Enabled := False;
   if MessageDlg(msg_Win[r], mtInformation, [mbYes, mbNo], 0) = mrYes then begin
      InfoListClear;
      CheckPlaneCou;
      ShowMsgInList(msg_NewGame, 1);
      GridPanel1.NewGame(True, in_PlaneCou);
   end else
      GridPanel2.Mode := 5;
end;

procedure TfrmMain.LocalGameEnd;
begin
   GameTimer.Enabled := False;
   MenuQuit.Enabled := False;
end;

procedure TfrmMain.GridPanel2ComputerHitPlayerPlaneHead;
begin
   PerformAudioEffect(4);
   ShowMsgInList(msg_ComputerHitPlayerPlane, 4);
end;

procedure TfrmMain.MenuQuitClick(Sender: TObject);
var i: Byte;
begin
   if MessageDlg(msg_QuitThisGame, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
      for i := 1 to in_PlaneCou do
         GridPanel2.ShowPlane(i);
      GridPanel2.Mode := 5;
      ShowMsgInList(msg_GameEnded, 1);
      LocalGameEnd;
   end;
end;

procedure TfrmMain.MenuAboutClick(Sender: TObject);
begin

⌨️ 快捷键说明

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