📄 unit1.pas
字号:
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 + -