unit1.pas

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

{ *********************************************************************** }
{ 打飞机V1.0人机对奕版   主窗口                                           }
{                                                                         }
{
作者:wqy
QQ:466798985
E-Mail:[e-mail]
你可以随意传播该源码，但请保证源码完整以及该文件头的存在
}



unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, Menus, ExtCtrls, inifiles, ComCtrls, StdCtrls,
   ScktComp, XPMan, Clipbrd, MMSystem, PlanePanel;
type
   PTShape = ^TShape;
   TfrmMain = class(TForm)
      MainMenu1: TMainMenu;
      MenuControl: TMenuItem;
      MenuNewGameDrawPlane: TMenuItem;
      MenuGroundSize: TMenuItem;
      MenuSize1: TMenuItem;
      MenuSize2: TMenuItem;
      MenuSize3: TMenuItem;
      MenuHelp: TMenuItem;
      MenuPlaneNum: TMenuItem;
      MenuAbout: TMenuItem;
      GridPanel1: TPlanePanel;
      GridPanel2: TPlanePanel;
      Bevel1: TBevel;
      MenuSepter4: TMenuItem;
      MenuPlayerGuessFirst: TMenuItem;
      MenuHelpSub: TMenuItem;
      MenuSepter5: TMenuItem;
      MenuConPlay: TMenuItem;
      MenuNew: TMenuItem;
      MenuGenerateGame: TMenuItem;
      MenuTimedGame: TMenuItem;
      GameTimer: TTimer;
      MenuSepter7: TMenuItem;
      MenuQuit: TMenuItem;
      Label1: TLabel;
      Label2: TLabel;
      Bevel3: TBevel;
      Bevel4: TBevel;
      MenuSepter8: TMenuItem;
      MenuBuiltGame: TMenuItem;
      MenuBuiltGameSub: TMenuItem;
      ClientSocket: TClientSocket;
      ServerSocket: TServerSocket;
      Bevel2: TBevel;
      MenuOnlineGameControl: TMenuItem;
      MenuOnlineGameSendMessage: TMenuItem;
      MenuOnlineGameSurrender: TMenuItem;
      MenuOnlineGameChangeProperty: TMenuItem;
      MenuSepter10: TMenuItem;
      MenuLink: TMenuItem;
      MenuGetLocalIP: TMenuItem;
      MenuBreakLink: TMenuItem;
      MenuSepter9: TMenuItem;
      MenuOnlineGameAutoGeneratePlane: TMenuItem;
      MenuSepter11: TMenuItem;
      MenuSepter12: TMenuItem;
      MenuOption: TMenuItem;
      FlashTimer: TTimer;
      XPManifest1: TXPManifest;
      MenuAudioEffect: TMenuItem;
      MenuChangePort: TMenuItem;
      IP1: TMenuItem;
      MenuChkPort: TMenuItem;
      MenuNowPort: TMenuItem;
      N4: TMenuItem;
      N5: TMenuItem;
      MenuNowIP: TMenuItem;
      MenuIPPortKnowledge: TMenuItem;
      InfoList: TListBox;
      MenuClearMsgList: TMenuItem;
      N2: TMenuItem;
      MenuSendUrging: TMenuItem;
      MenuShowMsgList: TMenuItem;
      StatusBar1: TStatusBar;
    MenuAllowLink: TMenuItem;
      procedure MenuSize1Click(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      procedure GridPanel1GridsMouseMove(Sender: TObject);
      procedure MenuNewGameDrawPlaneClick(Sender: TObject);
      procedure MenuPlaneNumClick(Sender: TObject);
      procedure MenuPlayerGuessFirstClick(Sender: TObject);
      procedure GridPanel2SameGridGuessed;
      procedure GridPanel2OneGridGuessed(x, y, GridType, PlaneIdx: Byte);
      procedure MenuConPlayClick(Sender: TObject);
      procedure MenuTimedGameClick(Sender: TObject);
      procedure GridPanel1NewGameStart;
      procedure GameTimerTimer(Sender: TObject);
      procedure GridPanel2PlanesAllKnockedDown(playerWin: Boolean);
      procedure GridPanel2ComputerHitPlayerPlaneHead;
      procedure MenuQuitClick(Sender: TObject);
      procedure MenuAboutClick(Sender: TObject);
      procedure MenuHelpSubClick(Sender: TObject);
      procedure GridPanel1HandDrawPlaneBegin;
      procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
      procedure MenuLinkClick(Sender: TObject);
      procedure MenuOnlineGameAutoGeneratePlaneClick(Sender: TObject);
      procedure MenuGetLocalIPClick(Sender: TObject);
      procedure MenuOptionClick(Sender: TObject);
      procedure MenuBreakLinkClick(Sender: TObject);
      procedure MenuOnlineGameSendMessageClick(Sender: TObject);
      procedure MenuOnlineGameSurrenderClick(Sender: TObject);
      procedure MenuOnlineGameChangePropertyClick(Sender: TObject);
      procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
         ErrorEvent: TErrorEvent; var ErrorCode: Integer);
      procedure MenuAudioEffectClick(Sender: TObject);
      procedure MenuChkPortClick(Sender: TObject);
      procedure MenuChangePortClick(Sender: TObject);
      procedure MenuIPPortKnowledgeClick(Sender: TObject);
      procedure InfoListDrawItem(Control: TWinControl; Index: Integer;
         Rect: TRect; State: TOwnerDrawState);
      procedure InfoListMouseDown(Sender: TObject; Button: TMouseButton;
         Shift: TShiftState; X, Y: Integer);
      procedure InfoListMouseMove(Sender: TObject; Shift: TShiftState; X,
         Y: Integer);
      procedure InfoListMouseUp(Sender: TObject; Button: TMouseButton;
         Shift: TShiftState; X, Y: Integer);
      procedure MenuClearMsgListClick(Sender: TObject);
      procedure ServerSocketAccept(Sender: TObject;
         Socket: TCustomWinSocket);
      procedure MenuAllowLinkClick(Sender: TObject);
      procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
      procedure ServerSocketClientRead(Sender: TObject;
         Socket: TCustomWinSocket);
      procedure MenuSendUrgingClick(Sender: TObject);
      procedure GridPanel1OnePlaneDrawed;
      procedure MenuShowMsgListClick(Sender: TObject);
   private
      procedure Readini;
      procedure ShowMsgInList(Msg: string; TextType: Byte = 0);
      procedure CheckPlaneCou;
      procedure OnlineGameHideShowMenus(bool: Boolean);
      procedure RefreshHitData;
      procedure PerformAudioEffect(idx: Byte);
      procedure InfoListClear;

      procedure CustomSocketRead(Text: string);
      procedure DivideSendData(s: string);
   public
      procedure SocketSend(s: string);
      procedure ChangePort(i: Integer);
      procedure NewOnlineGame;
      procedure QuitOnlineGame;
      procedure ReturnToLocalGame;
      procedure Connect;
      procedure SendGameData;
      procedure JoinGame;
      procedure Hang;
      procedure BreakHang;
      procedure Lock;
      procedure Unlock;
      procedure ChangeGamePropertiesCanceled;
      procedure ChangeGameProperties;
      procedure PlaneReady;
      procedure SelfBegin(GuessFirst: Boolean);
      procedure PackPlaneDataAndSend;
      procedure ReceivePlanePosData(s: string);
      procedure GetGameData(str: string);
      procedure PerformAGridFlash(x, y: Byte);
      procedure OnlineGameShowResult(r: Byte); //1:Win 2:Lose 3:Tie
      procedure LocalGameShowResult(r: Byte); //Player what? 1:Win 2:Lose 3:Tie
      procedure LocalGameEnd;
      procedure ChangeActiveGame_In_State(new: Byte);
     ///////////////////////////////////////////
      procedure BeginFlash(DoOn: PTShape; FlashType: Byte; GridType: Byte);
      procedure SubFlash1(Sender: TObject);
      procedure SubFlash2(Sender: TObject);
      procedure EndFlash;
      procedure DrawGridShowPlane(idx: Byte);

      function GridPosToChar(x, y: Byte): string;
   end;

   TAudioEffectThread = class(TThread)
      procedure Execute; override;
   public
      Kind: Byte;
   end;

   PTOnlineGame = ^TOnlineGame;
   TOnlineGame = record
      in_Connected: Boolean;
      in_State: Byte; //0.Not Connected 1.Connected and waiting for game built/Building Game 2.Drawing Planes 3.Playing 4.Showing Results 5.Changing Game properties 6.PlaneDrawn and wait 7.Hanging
      in_GameResult: Byte;
      GameBuilder: Boolean;
      SelfPlaneReady, OpponentPlaneReady: Boolean;
      PlanesAllGuessed: Boolean;
      IP, OtherIP: string;
      GameSize, PlaneCou: Byte;
      GameBuilderFirst, TimedGame: Boolean;
      op_tryCount, op_Hit, op_KnockDown: Byte;
      inRisk: Boolean; //inRisk=True 时，你的下一发炮弹必须击落对方的所有飞机才能平局
      ResultCou: array[0..3] of Byte; //0:All 1:Win 2:Lose 3:Tie
      HangOldMode: Byte;
      HangOldState: Byte;

      SelfClient: Boolean;
   end;

var
   frmMain: TfrmMain;
   MyIniFile: TIniFile;

   in_GridCount: Byte;
   in_GridColor: TColor;
   in_GridActiveColor: TColor;
   in_PlaneColor: TColor;
   in_PlayerGuessFirst: Boolean;
   in_PlaneCou: Byte;
   in_ConPlay: Boolean;
   in_TimedGame: Boolean;
   in_PlayerInRisk: Boolean;

   in_GridFlashType: Byte;
   in_FlashShape: PTShape;
   in_FlashTick: Byte;
   in_FlashBool: Boolean;
   in_FlashEnd: Boolean;

   in_GameOnSeconds: Word;
   in_DirectoryPath: string;

   in_ShowOnStart: Boolean;
   in_From3Created: Boolean;
   in_NotExited: Boolean;
   in_AudioEffect: Boolean;
   in_ShowMsgList: Boolean;

   in_AutoActive: Boolean;

   in_OnlineGame: Boolean;
   ActiveGame: TOnlineGame;

   in_InfoListType: string;
   in_InfoListMouseDown: Boolean;
const
   InfoListColors: array[0..5] of TColor = (clBlue, clBlack, clPurple, clRed, clGreen, clTeal);
   num_AllowPlaneCou: array[2..4] of Byte = (3, 6, 9);
   chg_BoolToStr: array[False..True] of Char = ('0', '1');
   chg_StrToBool: array[0..1] of Boolean = (False, True);
   str_General = 'General';
   msg_DropThisRound = '放弃此局吗？';
   msg_QuitThisGame = '真的要放弃吗？';
   msg_NewGame = '新游戏开始啦，请画你的飞机。';
   msg_PlaneDrawn = '飞机画完了，';
   msg_ComputerGuess = '电脑先猜。';
   msg_PlayerGuess = '你猜吧。';
   msg_SameGridGuesses = '这个格子已经被猜过了。';
   msg_GameEnded = '游戏结束。';
   msg_OneGridGuessed: array[0..2] of string = ('很遗憾，打空了。', '恭喜你，你击落了敌人的这架飞机！', '恭喜你，你打中机身了！');
   msg_GridCount: array[2..4] of string = ('10个格子的场地最多允许有3架飞机。', '15个格子的场地最多允许有6架飞机。', '20个格子的场地最多允许有9架飞机。');
   msg_ConPlay = '你已调为对弈模式，你可以和电脑比比谁打飞机打得准。';
   msg_NotConPlay = '你已调为非对弈模式，你可以看看自己用多少发导弹能打掉所有的飞机。请在右边的格子打飞机。';
   msg_Win: array[1..3] of string = ('恭喜你，你赢了，自动开始下一局吗？', '很遗憾，你输了，自动开始下一局吗？', '有点遗憾，你和电脑打成平手，继续努力！自动开始下一局吗？');
   msg_PlayerInRisk = '电脑已经把你的飞机全部打掉了，但它是先手，如果你下一发炮弹能击落电脑的所有飞机，你们就打成平局，否则你就输了。';
   msg_ComputerInRisk = '恭喜你，你击落了电脑的所有飞机，但你是先手，如果电脑的下一发炮弹不能击落你的所有飞机，你就赢了。';
   msg_NotConGamePlaneAllDown = '恭喜你，你击落了电脑的所有飞机，自动开始下一局吗？';
   msg_GameOnTime = '游戏已进行:';
   msg_ComputerHitPlayerPlane = '不好意思，电脑打中你的飞机了。';
   msg_HandDrawPlaneBegin = '请在左边的格子里画';
   msg_DrawTip = '在格子上点击左键，然后拖动鼠标。点右键取消飞机。';
   msg_HaveLinked = '对方正和别人处于连接状态，你的连接被拒绝了。';
   msg_WantLink = '想与你进行联网游戏，接受吗？';
   msg_AvoidLink = '拒绝了你的联接。';
   msg_LinkSucceed = '连接成功，下面由你来建立游戏。';
   msg_LinkFailed = '连接失败。';
   msg_LinkError = '与远方主机连接时发生错误！请检查端口，并且确保对方已经允许连接。';
   msg_IPAddError = 'IP地址有错误！请重新输入。';
   msg_SameIP = '目标主机IP地址不能和本机相同。';
   msg_YouBuildGame = '由你来建立游戏，继续吗？';
   msg_BuildingGameAndWait = '对方正在建立游戏，请稍等。';
   msg_GameBuiltJoin = '对方已建立游戏，点击确定加入游戏，开始网上对战。';
   msg_OpponentJoin = '对方已加入游戏。';
   msg_GameDataSent = '游戏数据已发送，请稍候。';
   msg_GameInMenu = '的游戏已生成，点击加入游戏。';
   msg_NoAvailableLink = '无可用连接';
   msg_DrawPlane = '请在左边格子画你的飞机，或点击"联网游戏控制->自动生成飞机"让电脑替你生成飞机。';
   msg_PlaneDrawnAndWait = '飞机画完了，请稍等对方。';
   msg_OpponentPlaneReady = '对方的飞机已经画好。';
   msg_GameBeginYouGuessFirst = '双方飞机都已画好，你先猜。';
   msg_GameBeginOpponentGuessFirst = '双方飞机都已画好，对方先猜，请稍等。';
   msg_IPCopyToClipBoard = 'IP地址已经存入剪切板，按Ctrl+V调出，将其发给对方。不要忘了让对方允许连接。';
   msg_YourPlaneHitDown = '你的一架飞机被对方猜中了，加油啊。';
   msg_YourPlaneHit = '对方击中了你的飞机。';
   msg_ReallyWantToQuit = '真的想退出联网游戏吗？';
   msg_OpponentQuitOnlineGame = '对方退出了与你的联网游戏。你可以继续进行本地游戏。';
   msg_OpponentHitDownAllYourPlanes = '对方已击落你的所有飞机。但他是先手，如果你下一发炮弹能击落他的所有飞机，你们就打成平局，否则你就输了。';
   msg_HaveHitDownAllPlanesButYouFirstGuessed = '恭喜你，你击落了对方的所有飞机，但你是先手，如果对方的下一发炮弹不能击落你的所有飞机，你就赢了。';
   msg_OpponentSurrenders = '你真厉害，对方认输了！';
   msg_OpponentChangeGameProperties = '对方想更改游戏属性，同意吗？';
   msg_OpponentAllowChangeGameProperties = '对方同意更改游戏属性。';
   msg_OpponentNotAllowChangeGameProperties = '对方拒绝了你更改游戏属性的申请。';
   msg_ChangingGamePropertiesCanceled = '对方放弃了更改游戏属性，游戏继续。';
   msg_ReallyWantToSurrender = '真的想认输吗？';
   msg_ApplySent = '申请已发出。';
   msg_PleaseWainForPermission = '申请已发出，请等待对方的回应。';
   msg_GameChanged = '游戏已更改好，点击查看。';
   msg_Hanging = '正在通讯或者轮到对手猜测，你不能进行操作。';
   msg_BreakHanging = '锁定已解除。';
   msg_PortOK = '当前端口未被占用。';
   msg_PortNotOK = '当前端口已被占用。';
   msg_WrongInput = '输入错误！';
   msg_CannotChangePort = '正在进行联网游戏，不能更改端口。';
   msg_PortChangeOK = '端口更改成功，请通知对方改为此端口，才可进行游戏。';
   msg_SingleLinkMsg = '进行连接时只须一方进行操作即可，另一方只要将IP地址传送过去就行。继续吗？';
   msg_YourLinkQuit = '已经与对方连接成功,你的自建连接将被终止。';
   msg_ChangingPortNotSuggested = '不建议更改默认端口，继续吗？';
   msg_HaveReturedToLoaclGame = '你已经退出了联网游戏。';
   msg_OpponentFinishedViewingGameResult = '对方已开始新游戏了。';
   msg_ReallyWantToSendUrgingMsg = '真的要发催促令吗？';
   msg_Urge = '快点呀，要不然我不玩了！';

   {Socket Text
   1. Link   //  idx,IP
   2. Link Succeed  //idx
   3. Link Avoided
   4. Building Game,please wait

   7. Add Game   //idx,GameSize,PlaneCou,GameBuilderFirst,TimedGame
   8. Opponent Joins Game   //idx
   9. Receive Opponent Plane Data

   13. plane ready
   14. Game begins and opponent guesses first
   15. Game begins and you guess first
   16. A Grid Guessed (Perform Falsh)  //idx,x,y
   17. Surrender  //idx
   18. QuitGame  //idx
   19. Want Change Game properties //
   20. Allow Change Game properties //
   21. Opponent Hit you plane's head
   22. Opponent Hit down all your planes
   23. Opponent Wins
   24. You Win
   25. Game ends in tie
   26. Opponent Started new game
   27. Change Game Properties //idx,GameSize,PlaneCou,GameBuilderFirst,TimedGame
   28. A Grid Safe Asked (Process BreakHang)
   29. Opponent Viewing Game Result
   30. Opponent Finished viewing game Result
   31. Opponent Has Changed Game Properties

   50. Chat
   51. Show MessageBox //21 Message
   }

implementation
uses Unit4, unit3, unit5;
var Computer: TComputer;
   AudioEffectThread: TAudioEffectThread;
{$R *.dfm}
{$R plane.RES}

procedure TfrmMain.CheckPlaneCou;
begin
   in_GameOnSeconds := 0;
   if in_PlaneCou > num_AllowPlaneCou[in_GridCount div 5] then begin
      MessageDlg(msg_GridCount[in_GridCount div 5], mtInformation, [mbOK], 0);
      in_PlaneCou := num_AllowPlaneCou[in_GridCount div 5];
   end;
   case in_GridCount of
      10: MenuSize1.Checked := True;
      20: MenuSize2.Checked := True;
      30: MenuSize3.Checked := True;
   end;
   MenuTimedGame.Checked := in_TimedGame;
   StatusBar1.Panels[2].Text := '';
   StatusBar1.Panels[3].Text := '';
end;

procedure TfrmMain.MenuSize1Click(Sender: TObject);
begin
   case MessageDlg(msg_DropThisRound, mtConfirmation, [mbYes, mbNo], 0) of
      mrYes: begin
            LocalGameEnd;
            GridPanel1.ChangeGridCou((Sender as TComponent).Tag);
            GridPanel2.ChangeGridCou((Sender as TComponent).Tag);
            in_GridCount := GridPanel1.GridCou;
            case in_GridCount of
               10: MenuSize1.Checked := True;
               15: MenuSize2.Checked := True;
               20: MenuSize3.Checked := True;
            end;
            InfoListClear;
            in_PlaneCou := num_AllowPlaneCou[in_GridCount div 5];