⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 Directx游戏制作开发包DGCBETA6
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DGCPlay, ExtCtrls, Menus, DPLAY, OLE2, Buttons;

const
  TTT_MOVEMSG = 20;
  TTT_NEWMSG  = 21;

type
  TTT_MOVE = record
    dwType : DWORD;
    Square : Integer;
  end;
  TTT_NEWGAME = record
    dwType : DWORD;
  end;

  TForm1 = class(TForm)
    DPlay: TDGCPlay;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    MainMenu1: TMainMenu;
    Game1: TMenuItem;
    New1: TMenuItem;
    Join1: TMenuItem;
    End1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Button1: TBitBtn;
    Button2: TBitBtn;
    Button3: TBitBtn;
    Button4: TBitBtn;
    Button5: TBitBtn;
    Button6: TBitBtn;
    Button7: TBitBtn;
    Button8: TBitBtn;
    Button9: TBitBtn;
    Game2: TMenuItem;
    NewGame1: TMenuItem;
    procedure Exit1Click(Sender: TObject);
    procedure New1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Join1Click(Sender: TObject);
    procedure DPlayAddPlayer(ID: Integer; LongName, ShortName: string);
    procedure Button1Click(Sender: TObject);
    procedure DPlayGameMessage(From, MsgType: Integer; GameMsg: Pointer);
    procedure NewGame1Click(Sender: TObject);
    procedure End1Click(Sender: TObject);
    procedure DPlayDeletePlayer(ID: Integer; LongName, ShortName: string);
  private
    { Private declarations }
    Procedure DrawAllSquares;
    Procedure ClearAllSquares;
    function  CheckForWinner : Integer;
    Procedure WeHaveAWinner(Line : Integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MyGameGUID   : TGUID = (D1:$C936BB40;D2:$5A82;D3:$11D0;D4:($BA,$6C,$00,$A0,$24,$D0,$D1,$DF));
  MyTurn       : Boolean;
  RemotePlayer : DPID;
  IAmHost      : Boolean;
  MoveMessage  : TTT_MOVE;
  Square       : Array[1..9] of Char;
  Winner       : Char;
  GameOver     : Boolean;

implementation

uses Unit2;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
     End1.Enabled := False;
     //Give my game a unique id on the network
     DPlay.GameGUID  := MyGameGUID;
     ClearAllSquares;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
     Close;
end;

procedure TForm1.New1Click(Sender: TObject);
begin
     //This will be the name of the Player that STARTED the game
     DPlay.ShortName := 'Player 1';
     //Clear out the listbox and populate it with the names of the providers
     Form2.ListBox1.Clear;
     Form2.ListBox1.Items := Dplay.ProviderNames;

     //Form2 is used several times to save resources.
     //Change the caption so the user knows what type of prompt this is
     //which will ask for the service provider they want to use.
     Form2.Caption := 'Choose Provider';
     Form2.ShowModal;
     If Form2.ListBox1.ItemIndex < 0 then exit;

     With Form2.ListBox1 do
          DPlay.OpenProvider(Items[ItemIndex],True);

     New1.Enabled     := False;
     Join1.Enabled := False;
     End1.Enabled     := True;
     Panel4.Caption   := 'Waiting for Player 2 to join.';
     IAmHost := True;
end;

procedure TForm1.Join1Click(Sender: TObject);
begin
     //This will be the name of the Player that STARTED the game
     DPlay.ShortName := 'Player 2';
     //Clear out the listbox and populate it with the names of the providers
     Form2.ListBox1.Clear;
     Form2.ListBox1.Items := DPlay.ProviderNames;

     //Form2 is used several times to save resources.
     //Change the caption so the user knows what type of prompt this is
     //which will ask for the service provider they want to use.
     Form2.Caption := 'Choose Provider';
     Form2.ShowModal;
     If Form2.ListBox1.ItemIndex < 0 then Exit;

     With Form2.ListBox1 do
          DPlay.OpenProvider(Items[ItemIndex], False);

     New1.Enabled     := False;
     Join1.Enabled    := False;
     End1.Enabled     := True;
     NewGame1.Enabled := False;

     If DPlay.NumberOfSessions < 1 then
     begin
        ShowMessage('No sessions running on this provider.');
        exit;
     end;
     Form2.Caption := 'Select Game Session';
     Form2.ListBox1.Clear;
     Form2.ListBox1.Items := DPlay.Sessions;
     Form2.ShowModal;
     If Form2.ListBox1.ItemIndex < 0 then exit;
     With Form2.ListBox1 do
          DPlay.OpenSession(dword(Items.Objects[ItemIndex]));

     With DPlay.PlayerSNames do
          RemotePlayer := dword(Objects[IndexOf('Player 1')]);

     IAmHost := False;
     MyTurn  := False;
     Panel4.Caption := 'Waiting for Player 1''s Move.';
end;

procedure TForm1.End1Click(Sender: TObject);
begin
     DPlay.CloseSession;
     ClearAllSquares;
     DrawAllSquares;
     Panel4.Caption := 'Waiting for Menu Selection.';
     New1.Enabled     := True;
     Join1.Enabled    := True;
     End1.Enabled     := False;
     NewGame1.Enabled := False;
end;

procedure TForm1.DPlayAddPlayer(ID: Integer; LongName, ShortName: string);
begin
     Panel4.Caption := 'Player 2 Connected!';
     Sleep(1000);
     Panel4.Caption := 'Your Move! Choose a square.';
     NewGame1.Enabled := True;
     MyTurn := True;
end;

procedure TForm1.DPlayDeletePlayer(ID: Integer; LongName, ShortName: string);
begin
     ClearAllSquares;
     DrawAllSquares;
     if IAmHost then
        Panel4.Caption := 'Player 2 Quit!'
     else
        Panel4.Caption := 'Player 1 Quit!';
end;

procedure TForm1.DPlayGameMessage(From, MsgType: Integer; GameMsg: Pointer);
var
     WhatPlayer : Char;
begin
     Case MsgType of
      TTT_MOVEMSG:
        begin
          If IAmHost then WhatPlayer := 'O' else WhatPlayer := 'X';
          Square[TTT_MOVE(GameMsg^).Square] := WhatPlayer;
          MyTurn := True;
          Panel4.Caption := 'It''s your move!';
          DrawAllSquares;
        end;
      TTT_NEWMSG:
        Form1.NewGame1Click(Self);
     end; //end of case
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     If GameOver = True then exit;
     If Square[ (Sender as TButton).Tag ] <> '' then exit;
     If Not MyTurn then exit;

     If IAmHost then
        Square[(Sender as TButton).Tag] := 'X'
     else
        Square[(Sender as TButton).Tag] := 'O';

     MoveMessage.dwType := TTT_MOVEMSG;
     MoveMessage.Square := (Sender as TButton).Tag;
     DPlay.SendMessage(RemotePlayer, MoveMessage);
     If IAmHost then
        Panel4.Caption := 'Waiting for Player 2''s Move'
     else
        Panel4.Caption := 'Waiting for Player 1''s Move';

     DrawAllSquares;
     MyTurn := False;
end;

Procedure TForm1.DrawAllSquares;
var
   Line : Integer;
begin
   Button1.Caption := Square[1];
   Button2.Caption := Square[2];
   Button3.Caption := Square[3];
   Button4.Caption := Square[4];
   Button5.Caption := Square[5];
   Button6.Caption := Square[6];
   Button7.Caption := Square[7];
   Button8.Caption := Square[8];
   Button9.Caption := Square[9];
   Line := CheckForWinner;
   If Line > 0 then WeHaveAWinner(Line);
end;

Procedure TForm1.ClearAllSquares;
var
     Loop : Integer;
begin
     For Loop := 1 to 9 do
         Square[Loop] := #0;
     DrawAllSquares;
     GameOver := False;
end;

function TForm1.CheckForWinner : Integer;
Var
     Loop : Integer;
     C    : Char;
     Tie  : Boolean;
begin
     For Loop := 1 to 2 do
     begin
       If Loop = 1 then
          C := 'X'
       else
          C := 'O';
       if Square[1] + Square[2] + Square[3] = C+C+C then
          begin
            Result := 1;
            Winner := C;
            exit;
          end;
       if Square[4] + Square[5] + Square[6] = C+C+C then
          begin
            Result := 2;
            Winner := C;
            exit;
          end;
       If Square[7] + Square[8] + Square[9] = C+C+C then
          begin
            Result := 3;
            Winner := C;
            exit;
          end;
       If Square[1] + Square[4] + Square[7] = C+C+C then
          begin
            Result := 4;
            Winner := C;
            exit;
          end;
       If Square[2] + Square[5] + Square[8] = C+C+C then
          begin
            Result := 5;
            Winner := C;
            exit;
          end;
       If Square[3] + Square[6] + Square[9] = C+C+C then
          Begin
            Result := 6;
            Winner := C;
            exit;
          end;
       If Square[1] + Square[5] + Square[9] = C+C+C then
          Begin
            Result := 7;
            Winner := C;
            exit;
          end;
       If Square[3] + Square[5] + Square[7] = C+C+C then
          begin
            Result := 8;
            Winner := C;
            exit;
          end;
     end;
     Result := 0;
     Tie := True;
     For Loop := 1 to 9 do
         If Square[Loop] = #0 then Tie := False;
     If Tie = True then
     begin
       Result := 9;
       Winner := 'T';
       exit;
     end;
end;

Procedure TForm1.WeHaveAWinner(Line : Integer);
begin
     Case Winner of
       'X': Panel4.Caption := 'Player 1 Wins!';
       'O': Panel4.Caption := 'Player 2 Wins!';
       'T': Panel4.Caption := 'It''s A Tie!';
     end;
     GameOver := True;

     Case Line of
       1:
         Begin
           Button1.Font.Color := clRed;
           Button2.Font.Color := clRed;
           Button3.Font.Color := clRed;
         end;
       2:
         Begin
           Button4.Font.Color := clRed;
           Button5.Font.Color := clRed;
           Button6.Font.Color := clRed;
         end;
       3:
         Begin
           Button7.Font.Color := clRed;
           Button8.Font.Color := clRed;
           Button9.Font.Color := clRed;
         end;
       4:
         Begin
           Button1.Font.Color := clRed;
           Button4.Font.Color := clRed;
           Button7.Font.Color := clRed;
         end;
       5:
         Begin
           Button2.Font.Color := clRed;
           Button5.Font.Color := clRed;
           Button8.Font.Color := clRed;
         end;
       6:
         Begin
           Button3.Font.Color := clRed;
           Button6.Font.Color := clRed;
           Button9.Font.Color := clRed;
         end;
       7:
         Begin
           Button1.Font.Color := clRed;
           Button5.Font.Color := clRed;
           Button9.Font.Color := clRed;
         end;
       8:
         Begin
           Button3.Font.Color := clRed;
           Button5.Font.Color := clRed;
           Button7.Font.Color := clRed;
         end;
     end;
end;

procedure TForm1.NewGame1Click(Sender: TObject);
var
     NewGameMsg  : TTT_NEWGAME;
begin
     Button1.Font.Color := clBlack;
     Button2.Font.Color := clBlack;
     Button3.Font.Color := clBlack;
     Button4.Font.Color := clBlack;
     Button5.Font.Color := clBlack;
     Button6.Font.Color := clBlack;
     Button7.Font.Color := clBlack;
     Button8.Font.Color := clBlack;
     Button9.Font.Color := clBlack;
     ClearAllSquares;
     DrawAllSquares;
     If IAmHost = True then
     begin
        MyTurn := True;
        Panel4.Caption := 'Choose a square!';
        NewGameMsg.dwType := TTT_NEWMSG;
        DPlay.SendMessage(RemotePlayer, NewGameMsg);
     end
     else
     begin
        MyTurn := False;
        Panel4.Caption := 'Waiting on Player 1''s Move';
     end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -