1. Tech

{
Article: 
Your First Delphi Game: Tic Tac Toe

http://delphi.about.com/library/library/weekly/aa021803a.htm

A Beginner’s Guide to Delphi Programming: Chapter 10. 
Designing and developing a real game using Delphi: Tic Tac Toe.

Download the ZIPed source.
Download only EXE.
}



Main.PAS

unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, StrUtils; type TXOPosArray = array [1..3, 1..3] of Integer; type TfrMain = class(TForm) lblCell0: TLabel; lblCell1: TLabel; lblCell2: TLabel; lblCell3: TLabel; lblCell4: TLabel; lblCell5: TLabel; lblCell6: TLabel; lblCell7: TLabel; lblCell8: TLabel; gbScoreBoard: TGroupBox; rgPlayFirst: TRadioGroup; lblX: TLabel; lblMinus: TLabel; Label1: TLabel; lblXScore: TLabel; lblColon: TLabel; lblOScore: TLabel; btnNewGame: TButton; btnResetScore: TButton; procedure FormCreate(Sender: TObject); procedure lblCell0Click(Sender: TObject); procedure btnNewGameClick(Sender: TObject); procedure btnResetScoreClick(Sender: TObject); private procedure InitPlayGround; function GamePlay(xo_Move : Integer) : integer; function CheckWin(iPos : TXOPosArray) : integer; public { Public declarations } end; var frMain: TfrMain; iXPos : TXOPosArray; iOPos : TXOPosArray; sPlaySign : String; bGameOver : Boolean; iMove : Integer; iXScore : Integer; iOScore : Integer; implementation {$R *.dfm} procedure TfrMain.InitPlayGround; var i, j, k: integer; begin for i := 1 to 3 do begin for j := 1 To 3 do begin k:= (i - 1) * 3 + j - 1; // 0 .. 8 TLabel(FindComponent('lblCell' + IntToStr(k))).Caption := ''; iXPos[i, j] := 0; iOPos[i][j] := 0; end; end; if rgPlayFirst.ItemIndex = 0 then sPlaySign := 'X'; if rgPlayFirst.ItemIndex = 1 then sPlaySign := 'O'; bGameOver := False; iMove := 0; end; procedure TfrMain.FormCreate(Sender: TObject); begin iXScore := 0; iOScore := 0; InitPlayGround; end; function TfrMain.CheckWin(iPos : TXOPosArray) : Integer; var iScore : Integer; i : Integer; j : Integer; begin Result := -1; //in rows? iScore := 0; for i := 1 to 3 do begin iScore := 0; Inc(Result); for j := 1 To 3 do Inc(iScore, iPos[i,j]); if iScore = 3 Then Exit end;//for i //top-left bottom-right diagonal? iScore := 0; Inc(Result); for i := 1 to 3 do Inc(iScore, iPos[i,i]); if iScore = 3 then Exit; //top-right bottom-left diagonal? iScore := 0; Inc(Result); for i := 1 to 3 do Inc(iScore, iPos[i,4-i]); if iScore = 3 then Exit; //columns? for i := 1 to 3 do begin iScore := 0; Inc(Result); for j := 1 to 3 do Inc(iScore, iPos[j,i]); if iScore = 3 then Exit; end;//for i Result := -1; end; function TfrMain.GamePlay(xo_Move : Integer):integer; var x, y : 1..3; iWin : integer; begin Result := -1; Inc(iMove); x := (xo_Move Div 3) + 1; y := (xo_Move Mod 3) + 1; if sPlaySign = 'O' then begin iOPos[x,y] := 1; iWin := CheckWin(iOPos); end else begin iXPos[x,y] := 1; iWin := CheckWin(iXPos); end; TLabel(FindComponent('lblCell' + IntToStr(xo_Move))).Caption := sPlaySign; Result := iWin; if iWin >= 0 then begin bGameOver := True; //mark victory if sPlaySign = 'X' then begin iXScore := iXScore + 1; lblXScore.Caption := IntToStr(iXScore); end else begin iOScore := iOScore + 1; lblOScore.Caption := IntToStr(iOScore); end; ShowMessage(sPlaySign + ' - Wins!'); end; if (iMove = 9) AND (bGameOver = False) Then begin ShowMessage('It''s a Draw!'); bGameOver := True end; if sPlaySign = 'O' Then sPlaySign := 'X' else sPlaySign := 'O'; end; procedure TfrMain.lblCell0Click(Sender: TObject); var iWin : integer; CellIndex : 0..8; begin if bGameOver = True Then Exit; if TLabel(Sender).Caption <> '' then begin ShowMessage('Cell ocupied!'); Exit; end; CellIndex := StrToInt(RightStr(TLabel(Sender).Name,1)); iWin := GamePlay(CellIndex); end; procedure TfrMain.btnNewGameClick(Sender: TObject); begin if bGameOver = False then begin if MessageDlg('End the current game?', mtConfirmation, mbOKCancel,0) = mrCancel then Exit; end; InitPlayGround; end; procedure TfrMain.btnResetScoreClick(Sender: TObject); begin if MessageDlg( 'Reset the scores?', mtConfirmation, mbOKCancel,0) = mrCancel then Exit; iXScore := 0; iOScore := 0; lblXScore.Caption := IntToStr(iXScore); lblOScore.Caption := IntToStr(iOScore); end; end.

frMain.DFM

Select frMain, Select View As Text, Paste the text into Editor, Select View As Form. object frMain: TfrMain Left = 292 Top = 237 Width = 400 Height = 299 Caption = 'About Delphi Programming: Tic Tac Toe' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object lblCell0: TLabel Left = 8 Top = 8 Width = 81 Height = 81 Alignment = taCenter AutoSize = False Caption = 'lblCell0' Color = clCream Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter OnClick = lblCell0Click end object lblCell1: TLabel Left = 96 Top = 8 Width = 81 Height = 81 Alignment = taCenter AutoSize = False Caption = 'lblCell1' Color = clCream Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter OnClick = lblCell0Click end object lblCell2: TLabel Left = 184 Top = 8 Width = 81 Height = 81 Alignment = taCenter AutoSize = False Caption = 'lblCell2' Color = clCream Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter OnClick = lblCell0Click end object lblCell3: TLabel Left = 8 Top = 96 Width = 81 Height = 81 Alignment = taCenter AutoSize = False Caption = 'lblCell3' Color = clCream Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter OnClick = lblCell0Click end object lblCell4: TLabel Left = 96 Top = 96 Width = 81 Height = 81 Alignment = taCenter AutoSize = False Caption = 'lblCell4' Color = clCream Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter OnClick = lblCell0Click end object lblCell5: TLabel Left = 184 Top = 96 Width = 81 Height = 81 Alignment = taCenter AutoSize = False Caption = 'lblCell5' Color = clCream Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter OnClick = lblCell0Click end object lblCell6: TLabel Left = 8 Top = 184 Width = 81 Height = 81 Alignment = taCenter AutoSize = False Caption = 'lblCell6' Color = clCream Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter OnClick = lblCell0Click end object lblCell7: TLabel Left = 96 Top = 184 Width = 81 Height = 81 Alignment = taCenter AutoSize = False Caption = 'lblCell7' Color = clCream Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter OnClick = lblCell0Click end object lblCell8: TLabel Left = 184 Top = 184 Width = 81 Height = 81 Alignment = taCenter AutoSize = False Caption = 'lblCell8' Color = clCream Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter OnClick = lblCell0Click end object gbScoreBoard: TGroupBox Left = 272 Top = 104 Width = 113 Height = 97 Caption = 'Score Board' TabOrder = 0 object lblX: TLabel Left = 8 Top = 16 Width = 33 Height = 41 Alignment = taCenter AutoSize = False Caption = 'X' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter end object lblMinus: TLabel Left = 48 Top = 16 Width = 25 Height = 41 Alignment = taCenter AutoSize = False Caption = '-' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter end object Label1: TLabel Left = 72 Top = 16 Width = 33 Height = 41 Alignment = taCenter AutoSize = False Caption = 'O' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter end object lblXScore: TLabel Left = 8 Top = 48 Width = 33 Height = 41 Alignment = taCenter AutoSize = False Caption = '0' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter end object lblColon: TLabel Left = 48 Top = 48 Width = 25 Height = 41 Alignment = taCenter AutoSize = False Caption = ':' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter end object lblOScore: TLabel Left = 72 Top = 48 Width = 33 Height = 41 Alignment = taCenter AutoSize = False Caption = '0' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -21 Font.Name = 'Tahoma' Font.Style = [fsBold] ParentColor = False ParentFont = False Layout = tlCenter end end object rgPlayFirst: TRadioGroup Left = 272 Top = 8 Width = 113 Height = 89 Caption = 'First to play' ItemIndex = 0 Items.Strings = ( 'X - Player 1' 'O - Player 2') TabOrder = 1 end object btnNewGame: TButton Left = 272 Top = 240 Width = 113 Height = 25 Caption = 'New Game' TabOrder = 2 OnClick = btnNewGameClick end object btnResetScore: TButton Left = 272 Top = 208 Width = 113 Height = 25 Caption = 'Reset Score' TabOrder = 3 OnClick = btnResetScoreClick end end { ******************************************** Zarko Gajic About.com Guide to Delphi Programming http://delphi.about.com email: delphi@aboutguide.com free newsletter: http://delphi.about.com/library/blnewsletter.htm forum: http://forums.about.com/ab-delphi/start/ ******************************************** }

©2014 About.com. All rights reserved.