unit1.pas

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

   tmpS := '9 ';
   for i := 1 to ActiveGame.PlaneCou do
      tmpS := tmpS + GetPlaneData + ';';
   tmpS := tmpS + '#';
   SocketSend(tmpS); //send plane data
end;

procedure TfrmMain.Hang;
begin
   ShowMsgInList(msg_Hanging, 1);
   ActiveGame.HangOldMode := GridPanel2.Mode;
   ActiveGame.HangOldState := ActiveGame.in_State;
   GridPanel2.Mode := 5;
   ChangeActiveGame_In_State(7);
end;

procedure TfrmMain.BreakHang;
begin
   ShowMsgInList(msg_BreakHanging, 1);
   ChangeActiveGame_In_State(ActiveGame.HangOldState);
   GridPanel2.Mode := ActiveGame.HangOldMode;
end;

procedure TfrmMain.Lock;
begin
   ShowMsgInList(msg_Hanging, 1);
   GridPanel2.Mode := 4;
end;

procedure TfrmMain.Unlock;
begin
   ShowMsgInList(msg_BreakHanging, 1);
   GridPanel2.Mode := 3;
end;

procedure TfrmMain.MenuLinkClick(Sender: TObject);
begin
   if ActiveGame.in_Connected = True then begin
      MessageDlg('正与' + ActiveGame.OtherIP + '连接中，不能建立新连接！', mtInformation, [mbOK], 0);
      exit;
   end;
   if MessageDlg(msg_SingleLinkMsg, mtconfirmation, [mbYes, mbNo], 0) = mrYes then begin
      frmOnlinegame.pre_Show(0); //Link
      frmOnlinegame.ShowModal;
   end;
end;

procedure TfrmMain.MenuOnlineGameAutoGeneratePlaneClick(Sender: TObject);
begin
   GridPanel1.GenerateGame;
end;

procedure TfrmMain.MenuGetLocalIPClick(Sender: TObject);
var t: TClipboard;
begin
   try
      ActiveGame.IP := GetLocalIP;
      t := TClipboard.Create;
      t.AsText := ActiveGame.IP;
      MessageDlg(msg_IPCopyToClipBoard, mtinformation, [mbOK], 0);
   finally
      t.Free;
   end;
end;

procedure TfrmMain.MenuOptionClick(Sender: TObject);
begin
   frmOnlinegame.pre_Show(5); //Option
   frmOnlinegame.ShowModal;
end;

procedure TfrmMain.MenuBreakLinkClick(Sender: TObject);
begin
   if ActiveGame.in_Connected = False then exit;
   if MessageDlg(msg_ReallyWantToQuit, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
      SocketSend('18 ' + '#');
      QuitOnlineGame;
   end;
end;

procedure TfrmMain.MenuOnlineGameSendMessageClick(Sender: TObject);
var s: string;
begin
   s := InputBox('聊天', '你对他/她说：     ', '');
   if Trim(s) = '' then exit;
   SocketSend('50 ' + s + '#');
end;

procedure TfrmMain.MenuOnlineGameSurrenderClick(Sender: TObject);
begin
   if ActiveGame.in_State <> 3 then exit;
   if MessageDlg(msg_ReallyWantToSurrender, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
      SocketSend('17 ' + '#');
      OnlineGameShowResult(2);
   end;
end;

procedure TfrmMain.MenuOnlineGameChangePropertyClick(Sender: TObject);
begin
   SocketSend('19 1' + '#');
   MessageDlg(msg_PleaseWainForPermission, mtInformation, [mbOK], 0);
   ShowMsgInList(msg_ApplySent, 1);
   Hang;
end;

procedure TfrmMain.ClientSocketError(Sender: TObject;
   Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
   var ErrorCode: Integer);
begin
   MessageDlg(msg_LinkError, mtError, [mbOK], 0);
   ErrorCode := 0;
end;

procedure TfrmMain.MenuAudioEffectClick(Sender: TObject);
begin
   in_AudioEffect := not in_AudioEffect;
   MenuAudioEffect.Checked := in_AudioEffect;
end;

procedure TfrmMain.MenuChkPortClick(Sender: TObject);
begin
   if (ChkPort(ClientSocket.Port)) then
      MessageDlg(msg_PortOK, mtInformation, [mbOK], 0)
   else
      MessageDlg(msg_PortNotOK, mtInformation, [mbOK], 0);
end;

procedure TfrmMain.ChangePort(i: Integer);
begin
   ClientSocket.Port := i;
   ServerSocket.Port := i;
   MenuNowPort.Caption := '当前端口：' + IntToStr(ClientSocket.Port);
   MessageDlg(msg_PortChangeOK, mtInformation, [mbOK], 0);
end;

procedure TfrmMain.MenuChangePortClick(Sender: TObject);
begin
   if in_OnlineGame then begin
      MessageDlg(msg_CannotChangePort, mtInformation, [mbOK], 0);
      exit;
   end;
   if MessageDlg(msg_ChangingPortNotSuggested, mtConfirmation, [mbOK], 0) = mrNo then exit;
   frmOnlineGame.pre_Show(6);
   frmOnlineGame.ShowModal;
end;

procedure TfrmMain.InfoListClear;
begin
   in_InfoListType := '';
   InfoList.Clear;
   ShowMsgInList('====================信息====================', 0);
end;

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

procedure TfrmMain.SocketSend(s: string);
begin
   if ActiveGame.SelfClient then
      ClientSocket.Socket.SendText(s)
   else
      ServerSocket.Socket.Connections[0].SendText(s);
end;

procedure TfrmMain.ServerSocketAccept(Sender: TObject;
   Socket: TCustomWinSocket);
   procedure Reject;
   begin
      Socket.SendText('3 ' + msg_HaveLinked + '#');
      ShowMsgInList('拒绝了来自' + Socket.RemoteHost + '的连接。', 1);
   end;
begin
   if ActiveGame.in_Connected = True then begin
      Reject;
      exit;
   end;
   if MessageDlg(Socket.RemoteAddress + msg_WantLink, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
      LocalGameEnd;
      ActiveGame.SelfClient := False;
      SocketSend('2 ' + '#');
      if frmOnlineGame.in_PageIdx = 0 then begin //自已也在进行连接
         MessageDlg(msg_YourLinkQuit, mtInformation, [mbOK], 0);
         frmOnlineGame.Close;
      end;
      with ActiveGame do begin
         OtherIP := Socket.RemoteAddress;
         in_Connected := True;
         GameBuilder := False;
         ChangeActiveGame_In_State(1);
      end;
      MenuBreakLink.Enabled := True;
      MessageDlg(msg_BuildingGameAndWait, mtInformation, [mbOK], 0);
   end else begin
      Reject;
      QuitOnlineGame;
   end;
end;

procedure TfrmMain.CustomSocketRead(Text: string);
var s: string; i, msg: Integer;
begin
   s := Text;
   i := pos(' ', s);
   msg := StrToInt(copy(s, 1, i - 1));
   delete(s, 1, i);
   s := Trim(s);
   case msg of
      {1: begin //

         end;}
      2: begin //link succeed
            ActiveGame.in_Connected := True;
            MessageDlg('与' + ActiveGame.OtherIP + msg_LinkSucceed, mtInformation, [mbOK], 0);
            ChangeActiveGame_In_State(1);
            MenuBreakLink.Enabled := True;
            frmOnlinegame.pre_Show(1); //Build Game
            frmOnlinegame.ShowModal;
         end;
      3: begin //link avoided
            MessageDlg(ActiveGame.OtherIP + msg_AvoidLink, mtInformation, [mbOK], 0);
            QuitOnlineGame;
         end;
      {4: begin

         end;}
      ////////////////////////////////
      7: begin // Add Game
            GetGameData(s);
            MessageDlg(msg_GameBuiltJoin, mtInformation, [mbOK], 0);
            frmOnlinegame.pre_Show(2); //Join Game
            frmOnlinegame.ShowModal;
         end;
      8: begin //Opponent Joins Game
            MessageDlg(msg_OpponentJoin, mtInformation, [mbOK], 0);
            MenuBuiltGameSub.Caption := '与' + ActiveGame.OtherIP + '的对战';
            MenuBuiltGame.Enabled := True;
            MenuBuiltGameSub.Enabled := True;
            OnlineGameHideShowMenus(False);
            in_OnlineGame := True;
            MenuOnlineGameControl.Enabled := True;
            NewOnlineGame;
         end;
      9: begin //Receive opponent's planes data
            ReceivePlanePosData(s);
            ShowMsgInList(msg_OpponentPlaneReady, 1);
            ActiveGame.OpponentPlaneReady := True;
         end;
      13: begin //Opponent Plane Ready
            PlaneReady;
         end;
      14: begin // Game begins and opponent guesses first
            MessageDlg(msg_GameBeginOpponentGuessFirst, mtInformation, [mbOK], 0);
            SelfBegin(False);
         end;
      15: begin // Game begins and you guess first
            MessageDlg(msg_GameBeginYouGuessFirst, mtInformation, [mbOK], 0);
            SelfBegin(True);
         end;
      16: begin // A Grid asked   //idx x,y
            i := pos(',', s);
            PerformAGridFlash(StrToInt(Copy(s, 1, i - 1)), StrToInt(Copy(s, i + 1, Length(s) - i)));
         end;
      28: begin //Safe asked;
            Unlock;
         end;
      17: begin //Opponent Surrenders
            MessageDlg(msg_OpponentSurrenders, mtInformation, [mbOK], 0);
            OnlineGameShowResult(1);
         end;
      18: begin //QuitGame
            MessageDlg(msg_OpponentQuitOnlineGame, mtInformation, [mbOK], 0);
            QuitOnlineGame;
         end;
      19: begin //Want Change Game properties //
            if s = '1' then begin
               if MessageDlg(msg_OpponentChangeGameProperties, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
                  SocketSend('20 1' + '#');
                  Hang;
               end else
                  SocketSend('20 0' + '#');
            end else begin //0 Canceled
               MessageDlg(msg_ChangingGamePropertiesCanceled, mtInformation, [mbOK], 0);
               BreakHang;
            end;
         end;
      20: begin //  Allow Change Game properties //
            if s = '1' then begin //Allow
               MessageDlg(msg_OpponentAllowChangeGameProperties, mtInformation, [mbOK], 0);
               frmOnlinegame.pre_Show(3); //Change Game properties
               frmOnlinegame.ShowModal;
            end else begin
               MessageDlg(msg_OpponentNotAllowChangeGameProperties, mtInformation, [mbOK], 0);
               BreakHang;
            end;
         end;
      21: begin //Opponent Hit you plane's head
            DrawGridShowPlane(StrToInt(s));
            ShowMsgInList(msg_YourPlaneHitDown, 4);
         end;
      22: begin //Opponent Hit down all your planes
            MessageDlg(msg_OpponentHitDownAllYourPlanes, mtInformation, [mbOK], 0);
            ActiveGame.inRisk := True;
            Unlock;
         end;
      23: begin //Opponent Win
            OnlineGameShowResult(2); // 2:Lose
         end;
      24: begin // You Win
            OnlineGameShowResult(1);
         end;
      25: begin // Game in tie
            OnlineGameShowResult(3);
         end;
      26: begin //Opponent Started New Game

         end;
      27: begin // Change Game Properties //idx,GameSize,PlaneCou,GameBuilderFirst,TimedGame
            GetGameData(s);
            MessageDlg(msg_GameChanged, mtInformation, [mbOK], 0);
            frmOnlinegame.pre_Show(7); //Change Game Join Game
            frmOnlinegame.ShowModal;
         end;
      29: begin // Opponent Viewing Game Result
            ActiveGame.OpponentPlaneReady := False;
         end;
      30: begin //Opponent Finished viewing game Result
            ShowMsgInList(msg_OpponentFinishedViewingGameResult, 1);
         end;
      31: begin //Opponent Has Changed Game Properties
            ActiveGame.OpponentPlaneReady := False;
         end;
      ////////////////////////////////

      50: begin //Chat
            ShowMsgInList('对方对你说：' + s, 5);
         end;
      51: begin //MessageBox
            MessageDlg(s, mtInformation, [mbOK], 0);
         end;
   end;
end;

procedure TfrmMain.MenuAllowLinkClick(Sender: TObject);
begin
   ServerSocket.Active := True;
end;

procedure TfrmMain.DivideSendData(s: string);
var i: Byte;
begin
   while pos('#', s) <> 0 do begin
      i := pos('#', s);
      CustomSocketRead(copy(s, 1, i - 1));
      delete(s, 1, i);
   end;
end;

procedure TfrmMain.ClientSocketRead(Sender: TObject;
   Socket: TCustomWinSocket);
begin
   if ActiveGame.SelfClient then
      DivideSendData(Socket.ReceiveText);
end;

procedure TfrmMain.ServerSocketClientRead(Sender: TObject;
   Socket: TCustomWinSocket);
begin
   if ActiveGame.SelfClient = False then
      DivideSendData(Socket.ReceiveText);
end;

procedure TfrmMain.MenuSendUrgingClick(Sender: TObject);
begin
   if MessageDlg(msg_ReallyWantToSendUrgingMsg, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
      SocketSend('51 ' + msg_Urge + '#');
end;

procedure TfrmMain.MenuShowMsgListClick(Sender: TObject);
begin
   in_ShowMsgList := not in_ShowMsgList;
   MenuShowMsgList.Checked := in_ShowMsgList;
   if in_ShowMsgList then
      frmMain.ClientHeight := 451
   else
      frmMain.ClientHeight := 347;
end;

end.