unit1.pas

这个软件是用Delphi 7开发的。 原本它是两个人在纸面上玩的益智游戏

   if in_From3Created = False then
      Form3 := TForm3.Create(frmMain);
   Form3.PageControl1.ActivePageIndex := 4;
   Form3.Show;
end;

procedure TfrmMain.MenuHelpSubClick(Sender: TObject);
begin
   if in_From3Created = False then
      Form3 := TForm3.Create(frmMain);
   Form3.PageControl1.ActivePageIndex := 0;
   Form3.Show;
end;

procedure TfrmMain.GridPanel1HandDrawPlaneBegin;  //开始手画飞机
begin
   MessageDlg(msg_HandDrawPlaneBegin + IntToStr(in_PlaneCou) + '架飞机。', mtInformation, [mbOK], 0);
   ShowMsgInList(msg_DrawTip, 1);
end;

//以下4个过程用来处理点击一个格子后的闪烁框
procedure TfrmMain.BeginFlash(DoOn: PTShape; FlashType: Byte; GridType: Byte);
begin
   in_FlashShape := DoOn;
   if FlashType = 1 then begin
      FlashTimer.OnTimer := SubFlash1;
      FlashTimer.Interval := 200;
   end else begin
      FlashTimer.OnTimer := SubFlash2;
      FlashTimer.Interval := 50;
   end;
   FlashTimer.Tag := GridType;
   in_FlashTick := FlashType - 1;
   in_FlashBool := False;
   in_FlashEnd := False;
   FlashTimer.Enabled := True;
end;

procedure TfrmMain.EndFlash;
begin
   FlashTimer.Enabled := False;
   if FlashTimer.Tag = 0 then begin
      with in_FlashShape^ do begin
         Brush.Style := bsDiagCross;
         Brush.Color := clBlack;
         Pen.Width := 1;
      end;
   end else if FlashTimer.Tag = 2 then
      in_FlashShape^.Pen.Width := 2;
   if FlashTimer.Tag = 9 then exit;
   if in_OnlineGame = True then
      exit;
   if Computer.ThinkEnded = True then
      GridPanel2.Mode := 3;
   in_FlashEnd := True;
end;

procedure TfrmMain.SubFlash1(Sender: TObject);
begin
   inc(in_FlashTick);
   in_FlashShape^.Pen.Width := (in_FlashTick mod 2) + 1;
   if in_FlashTick = 4 then
      EndFlash;
end;

procedure TfrmMain.SubFlash2(Sender: TObject);
begin
   in_FlashShape^.Pen.Width := in_FlashTick;
   if in_FlashBool = False then inc(in_FlashTick) else dec(in_FlashTick);
   if in_FlashTick = 6 then begin
      in_FlashBool := True;
      in_FlashTick := 4;
   end;
   if (in_FlashTick = 0) and (in_FlashBool = True) then
      EndFlash;
end;

procedure TfrmMain.DrawGridShowPlane(idx: Byte);
var i: Byte;
begin
   with GridPanel1.Planes[idx] do
      for i := 0 to 9 do
         with GridPanel1.Grids[TenPoints[i].y, TenPoints[i].x] do begin
            Brush.Color := clGray;
            Pen.Width := 1;
         end;
end;

procedure TfrmMain.InfoListDrawItem(Control: TWinControl; Index: Integer;
   Rect: TRect; State: TOwnerDrawState);
begin
   with InfoList.Canvas do begin
      FillRect(Rect);
      if Index = InfoList.ItemIndex then
         Font.Color := clwhite
      else
         Font.Color := InfoListColors[StrToInt(in_InfoListType[Index + 1])];
      TextOut(Rect.Left + 2, Rect.Top + 2, InfoList.Items[Index]);
   end;
end;

procedure TfrmMain.InfoListMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
   in_InfoListMouseDown := True;
   InfoList.Repaint;
end;

procedure TfrmMain.InfoListMouseMove(Sender: TObject; Shift: TShiftState;
   X, Y: Integer);
begin
   if in_InfoListMouseDown = True then
      InfoList.Repaint;
end;

procedure TfrmMain.InfoListMouseUp(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
begin
   in_InfoListMouseDown := False;
end;

procedure TfrmMain.MenuClearMsgListClick(Sender: TObject);
begin
   InfoListClear;
end;

procedure TfrmMain.GridPanel1OnePlaneDrawed;
begin
   ShowMsgInList('还剩 ' + IntToStr(in_PlaneCou - GridPanel1.PlaneDraw.NowPlaneCou) + ' 架飞机', 1);
end;

//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$网络部分$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$网络部分$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$网络部分$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
//$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

procedure TfrmMain.ChangeActiveGame_In_State(new: Byte);
begin
   ActiveGame.in_State := new;
   MenuOnlineGameSurrender.Enabled := ActiveGame.in_State = 3;
   MenuOnlineGameAutoGeneratePlane.Enabled := ActiveGame.in_State = 2;
end;

procedure TfrmMain.NewOnlineGame;
begin
   in_PlaneCou := ActiveGame.PlaneCou;
   if in_GridCount <> ActiveGame.GameSize then begin
      in_GridCount := ActiveGame.GameSize;
      GridPanel1.ChangeGridCou(ActiveGame.GameSize);
      GridPanel2.ChangeGridCou(ActiveGame.GameSize);
   end;
   with ActiveGame do begin
      inRisk := False;
      SelfPlaneReady := False;
      OpponentPlaneReady := False;
      PlanesAllGuessed := False;
      op_tryCount := 0;
      op_Hit := 0;
      op_KnockDown := 0;
   end;
   in_TimedGame := ActiveGame.TimedGame;
   InfoListClear;
   ShowMsgInList(msg_NewGame, 1);
   GridPanel1.NewGame(False, ActiveGame.PlaneCou, False, True);
   MenuOnlineGameAutoGeneratePlane.Enabled := True;
   ChangeActiveGame_In_State(2); //Drawing planes
   MessageDlg(msg_DrawPlane, mtInformation, [mbOK], 0);
end;

procedure TfrmMain.ReturnToLocalGame;
begin
   //Return to local game
   OnlineGameHideShowMenus(True);
   LocalGameEnd;
   InfoListClear;
   in_ConPlay := True;
   CheckPlaneCou;
   MessageDlg(msg_HaveReturedToLoaclGame, mtInformation, [mbOK], 0);
   GridPanel1.NewGame(True, in_PlaneCou);
   ShowMsgInList(msg_NewGame, 1);
end;

procedure TfrmMain.QuitOnlineGame;
begin
   ActiveGame.in_Connected := False;
   in_OnlineGame := False;
   ClientSocket.Socket.Close;
   MenuBuiltGameSub.Caption := '无可用连接';
   MenuBuiltGameSub.Enabled := False;
   MenuBreakLink.Enabled := False;
   MenuOnlineGameControl.Enabled := False;
   MenuBuiltGame.Enabled := False;
   ReturnToLocalGame;
end;

procedure TfrmMain.OnlineGameShowResult(r: Byte); //1:Win 2:Lose 3:Tie
begin
   GameTimer.Enabled := False;
   StatusBar1.Panels[3].Text := '';
   ChangeActiveGame_In_State(4);
   ActiveGame.in_GameResult := r;
   ActiveGame.SelfPlaneReady := False;
   SocketSend('29 ' + '#');
   inc(ActiveGame.ResultCou[0]);
   inc(ActiveGame.ResultCou[r]);
   frmOnlineGame.pre_Show(4);
   frmOnlineGame.ShowModal;
end;

procedure TfrmMain.Connect;
begin
   ClientSocket.Host := ActiveGame.OtherIP;
   ClientSocket.Open;
   ActiveGame.SelfClient := True;
end;

procedure TfrmMain.ChangeGameProperties;
var s: string;
begin
   with ActiveGame do begin
      s := '27 ' + IntToStr(GameSize) + ',' + IntToStr(PlaneCou) + ',' +
         chg_BoolToStr[GameBuilderFirst] + ',' + chg_BoolToStr[TimedGame] + '#';
   end;
   SocketSend('31 ' + '#');
   SocketSend(s);
   ActiveGame.OpponentPlaneReady := False;
   NewOnlineGame;
end;

procedure TfrmMain.ChangeGamePropertiesCanceled;
begin
   SocketSend('19 0' + '#');
   BreakHang;
end;

procedure TfrmMain.SendGameData;
var s: string;
begin
{GameSize,PlaneCou,GameBuilderFirst,TimedGame}
   with ActiveGame do begin
      s := '7 ' + IntToStr(GameSize) + ',' + IntToStr(PlaneCou) + ',' +
         chg_BoolToStr[GameBuilderFirst] + ',' + chg_BoolToStr[TimedGame] + '#';
   end;
   SocketSend(s);
   MessageDlg(msg_GameDataSent, mtInformation, [mbOK], 0);
end;

procedure TfrmMain.GetGameData(str: string);
var i, t: Byte; tmpS: array[1..4] of shortstring;
begin
   i := 1; str := str + ',';
   while i <= 4 do begin
      t := pos(',', str);
      tmpS[i] := copy(str, 1, t - 1);
      delete(str, 1, t);
      inc(i);
   end;
   with ActiveGame do begin
      for i := 0 to 3 do
         ResultCou[i] := 0;
      GameSize := StrToInt(tmpS[1]);
      PlaneCou := StrToInt(tmpS[2]);
      GameBuilderFirst := tmpS[3] = '1';
      TimedGame := tmpS[4] = '1';
   end;
   MenuBuiltGameSub.Caption := '与' + ActiveGame.OtherIP + '的对战';
   MenuBuiltGame.Enabled := True;
   MenuBuiltGameSub.Enabled := True;
end;

procedure TfrmMain.OnlineGameHideShowMenus(bool: Boolean);
begin
   MenuQuit.Enabled := False;
   MenuConPlay.Enabled := bool;
   MenuPlayerGuessFirst.Enabled := bool;
   MenuTimedGame.Enabled := bool;
   MenuGroundSize.Enabled := bool;
   MenuPlaneNum.Enabled := bool;
   MenuNewGameDrawPlane.Enabled := bool;
   MenuNew.Enabled := bool;
end;

procedure TfrmMain.JoinGame;
begin
   SocketSend('8 ' + '#');
   OnlineGameHideShowMenus(False);
   in_OnlineGame := True;
   MenuOnlineGameControl.Enabled := True;
   NewOnlineGame;
end;

procedure TfrmMain.PlaneReady;
begin
   with ActiveGame do
      if GameBuilder = True then begin
         if GameBuilderFirst = True then begin
            MessageDlg(msg_GameBeginYouGuessFirst, mtInformation, [mbOK], 0);
            SocketSend('14 ' + '#');
            SelfBegin(True);
         end else begin
            MessageDlg(msg_GameBeginOpponentGuessFirst, mtInformation, [mbOK], 0);
            SocketSend('15 ' + '#');
            SelfBegin(False);
         end;
      end else begin
         if GameBuilderFirst = True then begin
            MessageDlg(msg_GameBeginOpponentGuessFirst, mtInformation, [mbOK], 0);
            SocketSend('15 ' + '#');
            SelfBegin(False);
         end else begin
            MessageDlg(msg_GameBeginYouGuessFirst, mtInformation, [mbOK], 0);
            SocketSend('14 ' + '#');
            SelfBegin(True);
         end;
      end;
end;

procedure TfrmMain.SelfBegin(GuessFirst: Boolean);
begin
   if GuessFirst = True then
      GridPanel2.Mode := 3 //You Guess First
   else
      GridPanel2.Mode := 4; //Opponent Guess First
   ChangeActiveGame_In_State(3); //Playing
   in_GameOnSeconds := 0;
   GameTimer.Enabled := True;
end;

procedure TfrmMain.PerformAGridFlash(x, y: Byte);
begin
   BeginFlash(@GridPanel1.Grids[y, x], in_GridFlashType, GridPanel1.GridState[y, x].GridType);
   inc(ActiveGame.op_tryCount);
   case GridPanel1.GridState[y, x].GridType of
      0: begin

         end;
      1: begin
            inc(ActiveGame.op_Hit);
            inc(ActiveGame.op_KnockDown);
         end;
      2: begin
            inc(ActiveGame.op_Hit);
            ShowMsgInList(msg_YourPlaneHit + GridPosToChar(x, y), 4);
         end;
   end;
end;

procedure TfrmMain.ReceivePlanePosData(s: string); //给GridPanel2
var tmpS: string;
   i, t, tmpX, tmpY, nowPX, nowPY, dir: Byte;
   pp: PTArr_Planes; pps: PTArr_GridState;
begin
   pp := @GridPanel2.Planes;
   pps := @GridPanel2.GridState;
   for i := 1 to ActiveGame.PlaneCou do begin
      t := pos(';', s);
      tmpS := Copy(s, 1, t - 1);
      Delete(s, 1, t);

      t := pos(' ', tmpS);
      tmpX := StrToInt(copy(tmpS, 1, t - 1));
      delete(tmpS, 1, t);
      t := pos(' ', tmpS);
      tmpY := StrToInt(copy(tmpS, 1, t - 1));
      delete(tmpS, 1, t);
      dir := StrToInt(tmpS);

      pp^[i].Dirction := dir;
      for t := 0 to 9 do begin
         nowPX := tmpX + DPlaneBody[dir, t, 0];
         nowPY := tmpY + DPlaneBody[dir, t, 1];
         with pp^[i] do begin
            TenPoints[t].X := nowPX;
            TenPoints[t].Y := nowPY;
         end;
         pps^[nowPY, nowPX].GridType := 2;
      end;
      pps^[tmpY, tmpX].GridType := 1; //plane Head
      pps^[tmpY, tmpX].HoldPlaneIdx := i;
   end;

end;

procedure TfrmMain.PackPlaneDataAndSend;
var tmpS: string; i: Byte;
   function GetPlaneData: string;
   begin
      with GridPanel1.planes[i] do
         Result := IntToStr(TenPoints[0].x) + ' ' + IntToStr(TenPoints[0].y) + ' ' + IntToStr(Dirction);
   end;
begin