RosettaCodeData/Task/Tic-tac-toe/Delphi/tic-tac-toe.pas

271 lines
5.9 KiB
ObjectPascal

{Array contain possiple winning lines}
type TWinLine = array [0..3-1] of TPoint;
var WinLines: array [0..8-1] of TWinLine = (
((X:0; Y:0), (X:1; Y:0), (X:2; Y:0)),
((X:0; Y:1), (X:1; Y:1), (X:2; Y:1)),
((X:0; Y:2), (X:1; Y:2), (X:2; Y:2)),
((X:0; Y:0), (X:0; Y:1), (X:0; Y:2)),
((X:1; Y:0), (X:1; Y:1), (X:1; Y:2)),
((X:2; Y:0), (X:2; Y:1), (X:2; Y:2)),
((X:0; Y:0), (X:1; Y:1), (X:2; Y:2)),
((X:2; Y:0), (X:1; Y:1), (X:0; Y:2))
);
{Array containing all characters in a line}
type TCellArray = array [0..3-1] of char;
var WinLineInx: integer;
var GameOver: boolean;
procedure ClearGrid;
{Clear TTT Grid by setting all cells to a space}
var X,Y: integer;
begin
with TicTacToeDlg do
begin
for Y:=0 to GameGrid.RowCount-1 do
for X:=0 to GameGrid.ColCount-1 do GameGrid.Cells[X,Y]:=' ';
WinLineInx:=-1;
Status1Dis.Caption:='';
GameOver:=False;
end;
end;
function FirstEmptyCell(var P: TPoint): boolean;
{Find first empty grid i.e. the one containing a space}
{Returns false if there are no empty cells (a tie game)}
var X,Y: integer;
begin
Result:=True;
with TicTacToeDlg do
begin
{Iterate through all cells in array}
for Y:=0 to GameGrid.RowCount-1 do
for X:=0 to GameGrid.ColCount-1 do
if GameGrid.Cells[X,Y]=' ' then
begin
P.X:=X; P.Y:=Y;
Exit;
end;
end;
Result:=False;
end;
procedure GetLineChars(Inx: integer; var CA: TCellArray);
{Get all the characters in a specific win line}
var P1,P2,P3: TPoint;
begin
with TicTacToeDlg do
begin
{Get cell position of specific win line}
P1:=WinLines[Inx,0];
P2:=WinLines[Inx,1];
P3:=WinLines[Inx,2];
{Get the characters from each and put in array}
CA[0]:=GameGrid.Cells[P1.X,P1.Y][1];
CA[1]:=GameGrid.Cells[P2.X,P2.Y][1];
CA[2]:=GameGrid.Cells[P3.X,P3.Y][1];
end;
end;
function IsWinner(var Inx: integer; var C: char): boolean;
{Test if the specified line is a winner}
{Return index of line and the char of winner}
var I,J: integer;
var CA: TCellArray;
begin
with TicTacToeDlg do
begin
Result:=False;
{Go through all winning patterns}
for J:=0 to High(WinLines) do
begin
{Get one winning pattern}
GetLineChars(J,CA);
{Look for line that has the same char in all three places}
if (CA[0]<>' ') and (CA[0]=CA[1]) and (CA[0]=CA[2]) then
begin
Result:=True;
Inx:=J;
C:=CA[0];
end;
end;
end;
end;
procedure DrawWinLine(Inx: integer);
{Draw line through winning squares}
var Line: TWinLine;
var C1,C2: TPoint;
var P1,P2: TPoint;
var W2,H2: integer;
begin
with TicTacToeDlg do
begin
{Offset to center of cell}
W2:=GameGrid.ColWidths[0] div 2;
H2:=GameGrid.RowHeights[0] div 2;
{Get winning pattern of lines}
Line:=WinLines[Inx];
{Get beginning and ending cell of win}
C1:=Line[0]; C2:=Line[2];
{Convert to screen coordinates}
P1.X:=C1.X * GameGrid.ColWidths[0] + W2;
P1.Y:=C1.Y * GameGrid.RowHeights[0] + H2;
P2.X:=C2.X * GameGrid.ColWidths[0] + W2;
P2.Y:=C2.Y * GameGrid.RowHeights[0] + H2;
{Set line attributes}
GameGrid.Canvas.Pen.Color:=clRed;
GameGrid.Canvas.Pen.Width:=5;
{Draw line}
GameGrid.Canvas.MoveTo(P1.X,P1.Y);
GameGrid.Canvas.LineTo(P2.X,P2.Y);
end;
end;
procedure DoBestComputerMove;
{Analyze game board and execute the best computer move}
var I,J,Inx: integer;
var CA: TCellArray;
var P: TPoint;
function UrgentMove(CA: TCellArray; var EmptyInx: integer): boolean;
{Test row, column or diagonal for an urgent move}
{This would be either an immediate win or immediate loss}
{Returns True if there is an urgent move and the index of location to respond}
var I: integer;
var OCnt,XCnt,EmptyCnt: integer;
begin
Result:=False;
OCnt:=0; XCnt:=0;
EmptyCnt:=0; EmptyInx:=-1;
{Count number of Xs, Os or Spaces in line}
for I:=0 to High(CA) do
begin
case CA[I] of
'O': Inc(OCnt);
'X': Inc(XCnt);
' ':
begin
Inc(EmptyCnt);
if EmptyCnt=1 then EmptyInx:=I;
end;
end;
end;
{Look for pattern of one empty and two Xs or two Os}
{Which means it's one move away from a win}
Result:=(EmptyCnt=1) and ((OCnt=2) or (XCnt=2));
end;
begin
with TicTacToeDlg do
begin
{Look for urgent moves in all patterns of wins}
for J:=0 to High(WinLines) do
begin
{Get a winning pattern of chars}
GetLineChars(J,CA);
if UrgentMove(CA,Inx) then
begin
{Urgent move found - take it}
P:=WinLines[J,Inx];
GameGrid.Cells[P.X,P.Y]:='O';
exit;
end;
end;
{No urgent moves, so use first empty}
{If there is no empty, the game is stalemated}
if FirstEmptyCell(P) then GameGrid.Cells[P.X,P.Y]:='O';
end;
end;
function TestWin: boolean;
{Test if last move resulted in win/draw}
var Inx: integer; var C: char;
var P: TPoint;
var S: string;
begin
Result:=True;
{Test if somebody won}
if IsWinner(Inx,C) then
begin
WinLineInx:=Inx;
TicTacToeDlg.GameGrid.Invalidate;
if C='O' then S:=' Computer Won!!' else S:=' You Won!!';
TicTacToeDlg.Status1Dis.Caption:=S;
GameOver:=True;
exit;
end;
{Test if game is a draw}
if not FirstEmptyCell(P) then
begin
TicTacToeDlg.Status1Dis.Caption:=' Game is Draw.';
GameOver:=True;
exit;
end;
Result:=False;
end;
procedure PlayTicTacToe;
{Show TicTacToe dialog box}
begin
ClearGrid;
TicTacToeDlg.ShowModal
end;
procedure TTicTacToeDlg.GameGridMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
{Handle user click on TicTacToe grid}
var Row,Col: integer;
begin
with TicTacToeDlg do
begin
if GameOver then exit;;
{Convert Mouse X,Y to Grid row and column}
GameGrid.MouseToCell(X,Y,Col,Row);
{Mark user's selection by placing X in the cell}
if GameGrid.Cells[Col,Row]=' 'then
GameGrid.Cells[Col,Row]:='X';
{Did this result in a win? }
if TestWin then exit;
{Get computer's response}
DoBestComputerMove;
{Did computer win}
TestWin;
end;
end;
procedure TTicTacToeDlg.ReplayBtnClick(Sender: TObject);
begin
ClearGrid;
end;
procedure TTicTacToeDlg.GameGridDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
{Draw winner line on top of Xs and Os}
begin
if WinLineInx>=0 then DrawWinLine(WinLineInx);
end;