unit5.pas

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

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

unit Unit5;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, ExtCtrls, winsock, ComCtrls;

type
   TfrmOnlineGame = class(TForm)
      btnBulidGame: TButton;
      btnCancel: TButton;
      PageControl1: TPageControl;
      TabSheet1: TTabSheet;
      TabSheet2: TTabSheet;
      Label6: TLabel;
      Label7: TLabel;
      cboGameSize: TComboBox;
      cboPlaneCount: TComboBox;
      chkGameBuilderFirst: TCheckBox;
      chkTimedGame: TCheckBox;
      Bevel1: TBevel;
      Label2: TLabel;
      Bevel2: TBevel;
      Label4: TLabel;
      Label9: TLabel;
      editIP: TEdit;
      editOtherIP: TEdit;
      lblGameBuiltBy: TLabel;
      TabSheet4: TTabSheet;
      Label1: TLabel;
      Label3: TLabel;
      Label8: TLabel;
      RadioButtonFlashType1: TRadioButton;
      RadioButtonFlashType2: TRadioButton;
      Shape1: TShape;
      Bevel3: TBevel;
      TabSheet5: TTabSheet;
      ListBoxGameResult: TListBox;
      TabSheet3: TTabSheet;
      Label5: TLabel;
      editPort: TEdit;
      chkAutoActive: TCheckBox;
      procedure cboGameSizeChange(Sender: TObject);
      procedure btnBulidGameClick(Sender: TObject);
      procedure btnCancelClick(Sender: TObject);
      procedure RadioButtonFlashType1Click(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
   private
    { Private declarations }
   public
      in_PageIdx: Byte; //0.Link 1.BuildGame  2.Join Game  3.Game properties
      procedure pre_Show(PageIdx: Byte);
      procedure GameInfoEnable(bool: Boolean);
   end;

function GetLocalIP: string;
function ChkIP(s: string): Boolean;
function ChkPort(port: Integer): Boolean;
var frmOnlineGame: TfrmOnlineGame;

implementation
uses unit1;
const msg_GameResults: array[1..3] of string = ('恭喜你，这局比赛你赢了！', '很遗憾，这局比赛你输了。', '这局比赛你和对手打成平手。');

{$R *.dfm}

function ChkPort(port: Integer): Boolean;
var
   err: Integer;
   sockHandle: WinSock.TSocket;
   WData: TWSAData;
   Addr: TSockAddr;
begin
   err := WSAStartup(MakeWord(2, 2), WData);
   if err <> 0 then begin
      result := False;
      exit;
   end;

   sockHandle := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
   if sockHandle = INVALID_SOCKET then begin
    //winsock创建失败
      result := False;
      exit;
   end;

   Addr.sin_family := AF_INET;
   Addr.sin_port := htons(port); //端口号参数
   Addr.sin_addr.s_addr := INADDR_ANY;
   if bind(sockHandle, Addr, SizeOf(Addr)) = SOCKET_ERROR then begin
    //winsock绑定失败，可能是端口被占用
      result := False;
      exit;
   end;

   result := True; //返回成功
   CloseSocket(sockHandle);
end;

function ChkIP(s: string): Boolean;
var i, t, Code: Integer; tmpS: string; ps: array[1..4] of Byte;
label Jump;
begin
   s := Trim(s);
   if Length(s) > 15 then goto Jump;
   tmpS := s;
   for i := 1 to 3 do begin
      t := pos('.', tmpS);
      if t = 0 then goto Jump;
      ps[i] := t;
      delete(tmpS, 1, t);
   end;
   ps[4] := Length(tmpS) + 1;
   for i := 1 to 4 do begin
      tmpS := Copy(s, 1, ps[i] - 1);
      val(tmpS, t, Code);
      if Code <> 0 then goto Jump;
      if not ((t >= 0) and (t <= 255)) then goto Jump;
      delete(s, 1, ps[i]);
   end;
   Result := True;
   exit;
   Jump:
   Result := False;
end;

function GetLocalIP: string;
var
   HostEnt: PHostEnt;
   Ip: string;
   addr: pchar;
   Buffer: array[0..63] of char;
   GInitData: TWSADATA;
begin
   try
      WSAStartup(2, GInitData);
      GetHostName(Buffer, SizeOf(Buffer));
      HostEnt := GetHostByName(buffer);
      if HostEnt = nil then Exit;
      addr := HostEnt^.h_addr_list^;
      ip := Format('%d.%d.%d.%d', [Byte(addr[0]),
         Byte(addr[1]), Byte(addr[2]), Byte(addr[3])]);
      Result := ip;
   finally
      WSACleanup;
   end;
end;

procedure TfrmOnlineGame.GameInfoEnable(bool: Boolean);
begin
   cboGameSize.Enabled := bool;
   cboPlaneCount.Enabled := bool;
   chkTimedGame.Enabled := bool;
   chkGameBuilderFirst.Enabled := bool;
end;

procedure TfrmOnlineGame.pre_Show(PageIdx: Byte);
var i: Byte; s: string;
begin
   in_PageIdx := PageIdx;
   for i := 0 to PageControl1.PageCount - 1 do
      PageControl1.Pages[i].TabVisible := False;
   lblGameBuiltBy.Visible := False;
   btnCancel.Enabled := True;
   btnBulidGame.Caption := '确定';
   case PageIdx of
      0: begin //连接
            btnBulidGame.Caption := '连接';
            ActiveGame.IP := GetLocalIP;
            editIP.Text := ActiveGame.IP;
            TabSheet1.TabVisible := True;
         end;
      1: begin //建立游戏
            btnBulidGame.Caption := '建立游戏';
            TabSheet2.Caption := btnBulidGame.Caption;
            cboGameSizeChange(cboGameSize);
            chkTimedGame.Checked := True;
            chkGameBuilderFirst.Checked := True;
            TabSheet2.TabVisible := True;
            GameInfoEnable(True);
         end;
      2, 7: begin //加入游戏
            btnBulidGame.Caption := '加入游戏';
            TabSheet2.Caption := btnBulidGame.Caption;
            cboGameSize.ItemIndex := (ActiveGame.GameSize div 5) - 2;
            cboGameSizeChange(cboGameSize);
            chkTimedGame.Checked := ActiveGame.TimedGame;
            chkGameBuilderFirst.Checked := ActiveGame.GameBuilderFirst;
            TabSheet2.TabVisible := True;
            lblGameBuiltBy.Caption := '本游戏由' + ActiveGame.OtherIP + '建立';
            lblGameBuiltBy.Visible := True;
            GameInfoEnable(False);
            if PageIdx = 7 then
               btnCancel.Enabled := False;
         end;
      3: begin //游戏属性
            TabSheet2.Caption := '游戏属性';
            TabSheet2.TabVisible := True;
            lblGameBuiltBy.Visible := True;
            lblGameBuiltBy.Caption := '你可以在这里更改游戏属性';
            GameInfoEnable(True);
            cboGameSize.ItemIndex := (ActiveGame.GameSize div 5) - 2;
            cboPlaneCount.ItemIndex := ActiveGame.PlaneCou - 1;
            chkTimedGame.Checked := ActiveGame.TimedGame;
            chkGameBuilderFirst.Checked := ActiveGame.GameBuilderFirst;
         end;
      4: begin //显示游戏结果
            ListBoxGameResult.Clear;
            with ListBoxGameResult.Items do begin
               Add(msg_GameResults[ActiveGame.in_GameResult]);
               Add('数据统计(前者为你)：');
               Add('击落敌机数：' + IntToStr(frmMain.GridPanel2.GuessData.KnockDown) + ':' + IntToStr(ActiveGame.op_KnockDown));
               Add('发弹数：' + IntToStr(frmMain.GridPanel2.GuessData.tryCount) + ':' + IntToStr(ActiveGame.op_tryCount));
               Add('击中数：' + IntToStr(frmMain.GridPanel2.GuessData.Hit) + ':' + IntToStr(ActiveGame.op_Hit));
               if (frmMain.GridPanel2.GuessData.tryCount = 0) then
                  s := '--/--:'
               else
                  s := FormatFloat('#,###0.000', frmMain.GridPanel2.GuessData.Hit / frmMain.GridPanel2.GuessData.tryCount) + ':';
               if ActiveGame.op_tryCount = 0 then
                  s := s + '--/--'
               else
                  s := s + FormatFloat('#,###0.000', ActiveGame.op_Hit / ActiveGame.op_tryCount);
               Add('命中率：' + s);
               Add('');
               Add('总成绩：' + IntToStr(ActiveGame.ResultCou[1]) + '胜 ' + IntToStr(ActiveGame.ResultCou[2]) + '负 ' + IntToStr(ActiveGame.ResultCou[3]) + '平');
               Add('胜率：' + FormatFloat(('#,###0.0'), ActiveGame.ResultCou[1] / ActiveGame.ResultCou[0] * 100) + '%');
               Add('');
               Add('点击确定开始新游戏');
            end;
            btnCancel.Enabled := False;
            TabSheet5.TabVisible := True;
         end;
      5: begin //选项
            TabSheet4.TabVisible := True;
            RadioButtonFlashType1.Checked := in_GridFlashType = 1;
            RadioButtonFlashType2.Checked := in_GridFlashType = 2;
            chkAutoActive.Checked := in_AutoActive;
         end;
      6: begin
            TabSheet3.TabVisible := True;
            frmOnlineGame.editPort.Text := IntToStr(frmMain.ClientSocket.Port);
         end;
   end;
end;

procedure TfrmOnlineGame.cboGameSizeChange(Sender: TObject);
var i, t: Byte;
begin
   i := 3 * (cboGameSize.ItemIndex + 1);
   cboPlaneCount.Clear;
   for t := 1 to i do
      cboPlaneCount.Items.Add(IntToStr(t));
   cboPlaneCount.ItemIndex := i - 1;
end;

procedure TfrmOnlineGame.btnBulidGameClick(Sender: TObject);
var code, i: Integer;
begin
   case in_PageIdx of
      0: begin //Link
            if (ChkIP(editIP.Text)) and (ChkIp(editOtherIP.Text)) then begin
               ActiveGame.Ip := Trim(editIP.Text);
               ActiveGame.OtherIP := Trim(editOtherIP.Text);
              { if ActiveGame.Ip = ActiveGame.OtherIP then begin
                  MessageDlg(msg_SameIP, mtError, [mbOK], 0);
                  exit;
               end;  }
               frmMain.Connect;
               frmOnlineGame.Close
            end else
               MessageDlg(msg_IPAddError, mtError, [mbOK], 0);
         end;
      1: begin //BuildGame
            with ActiveGame do begin
               for i := 0 to 3 do
                  ResultCou[i] := 0;
               GameBuilder := True;
               GameSize := (cboGameSize.ItemIndex + 2) * 5;
               PlaneCou := cboPlaneCount.ItemIndex + 1;
               GameBuilderFirst := chkGameBuilderFirst.Checked;
               TimedGame := chkTimedGame.Checked;
            end;
            frmOnlineGame.Close;
            frmMain.SendGameData;
         end;
      2: begin //2.Join Game
            frmOnlineGame.Close;
            frmMain.JoinGame;
         end;
      3: begin //Game properties
            with ActiveGame do begin
               GameSize := (cboGameSize.ItemIndex + 2) * 5;
               PlaneCou := cboPlaneCount.ItemIndex + 1;
               GameBuilderFirst := chkGameBuilderFirst.Checked;
               TimedGame := chkTimedGame.Checked;
            end;
            frmMain.ChangeGameProperties;
            frmOnlineGame.Close;
         end;
      4: begin
            frmMain.SocketSend('30 ' + '#');
            frmMain.NewOnlineGame;
            frmOnlineGame.close;
         end;
      5: begin
            if RadioButtonFlashType1.Checked then
               in_GridFlashType := 1
            else
               in_GridFlashType := 2;
            in_AutoActive := chkAutoActive.Checked;
            frmOnlineGame.Close;
         end;
      6: begin
            val(EditPort.Text, i, code);
            if (code <> 0) or (not ((i <= 65535) and (i >= 1))) then
               MessageDlg(msg_WrongInput, mtInformation, [mbOK], 0)
            else
               if ChkPort(i) = False then
                  MessageDlg(msg_PortNotOK, mtInformation, [mbOK], 0)
               else begin
                  frmMain.ChangePort(i);
                  frmOnlineGame.Close;
               end;
         end;
      7: begin //Join Changed Game
            frmMain.NewOnlineGame;
            frmOnlineGame.close;
         end;
   end;
end;

procedure TfrmOnlineGame.btnCancelClick(Sender: TObject);
begin
   case in_PageIdx of
      0, 4, 5, 6: begin
            frmOnlineGame.Close;
         end;
      1: begin
            if MessageDlg(msg_ReallyWantToQuit, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
               frmMain.QuitOnlineGame;
               frmOnlineGame.Close;
            end;
         end;
      2: begin
            if MessageDlg(msg_ReallyWantToQuit, mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
               frmMain.QuitOnlineGame;
               frmOnlineGame.Close;
            end;
         end;
      3: begin
            frmMain.ChangeGamePropertiesCanceled;
            frmOnlineGame.Close;
         end;
   end;
end;

procedure TfrmOnlineGame.RadioButtonFlashType1Click(Sender: TObject);
begin
   frmMain.BeginFlash(@Shape1, (Sender as TComponent).Tag, 9);
end;

procedure TfrmOnlineGame.FormCreate(Sender: TObject);
begin
   in_PageIdx := 100;
end;

procedure TfrmOnlineGame.FormClose(Sender: TObject;
   var Action: TCloseAction);
begin
   in_PageIdx := 100;
end;

initialization
end.