nerons
چهارشنبه 31 اردیبهشت 1393, 16:49 عصر
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls;
type
TForm1 = class(TForm)
lblCurrent: TLabel;
lblStatus: TLabel;
bllAmZug: TLabel;
memAI: TMemo;
imgTitle: TImage;
gbPlaymode: TGroupBox;
rdHVsH: TRadioButton;
rdHVSC: TRadioButton;
chckHumanStarts: TCheckBox;
Panel1: TPanel;
btn11: TButton;
btn12: TButton;
btn13: TButton;
btn21: TButton;
btn22: TButton;
btn23: TButton;
btn31: TButton;
btn32: TButton;
btn33: TButton;
btnReset: TButton;
scMind: TScrollBar;
lblKILevel: TLabel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure btn11Click(Sender: TObject);
procedure btn12Click(Sender: TObject);
procedure btn13Click(Sender: TObject);
procedure btn21Click(Sender: TObject);
procedure btn22Click(Sender: TObject);
procedure btn23Click(Sender: TObject);
procedure btn31Click(Sender: TObject);
procedure btn32Click(Sender: TObject);
procedure btn33Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnResetClick(Sender: TObject);
procedure rdHVSCClick(Sender: TObject);
procedure rdHVsHClick(Sender: TObject);
procedure chckHumanStartsClick(Sender: TObject);
private
public
{ Public declarations }
end;
var
Form1: TForm1;
playmode:string;
playfield:array [1..3,1..3] of integer; //0.. Empty 1..Cpu 2..Human
playButton:array [1..3,1..3] of tbutton;
implementation
{$R *.dfm}
//------------------------------------------------------------------------------
// Expresses the playfield as integer
function Situation:integer;
var x,y:short;
var temp:string;
begin
temp:='';
for x:=1 to 3 do
for y:=1 to 3 do
temp:=temp + inttostr(playfield[x,y]);
result:=strtoint(temp);
end;
//------------------------------------------------------------------------------
// Displays the current AI output
procedure aiout(str:string);
begin
form1.memai.Lines.Add(str);
0end;
//------------------------------------------------------------------------------
// Building Plan for field
procedure BuildPlayfield;
var x,y:short;
begin
aiout('Building Field...');
for x:=1 to 3 do
for y:=1 to 3 do
playfield[x,y]:=0;
if form1.btn11.caption='' then playfield[1,1]:=0
else playfield[1,1]:=form1.btn11.tag;
if form1.btn21.caption='' then playfield[2,1]:=0
else playfield[2,1]:=form1.btn21.tag;
if form1.btn31.caption='' then playfield[3,1]:=0
else playfield[3,1]:=form1.btn31.tag;
if form1.btn12.caption='' then playfield[1,2]:=0
else playfield[1,2]:=form1.btn12.tag;
if form1.btn22.caption='' then playfield[2,2]:=0
else playfield[2,2]:=form1.btn22.tag;
if form1.btn32.caption='' then playfield[3,2]:=0
else playfield[3,2]:=form1.btn32.tag;
if form1.btn13.caption='' then playfield[1,3]:=0
else playfield[1,3]:=form1.btn13.tag;
if form1.btn23.caption='' then playfield[2,3]:=0
else playfield[2,3]:=form1.btn23.tag;
if form1.btn33.caption='' then playfield[3,3]:=0
else playfield[3,3]:=form1.btn33.tag;
end;
//------------------------------------------------------------------------------
// Plays the given button
procedure compselect(btn:tbutton);
begin
btn.caption:=form1.lblcurrent.caption;
btn.tag:=1;
end;
//------------------------------------------------------------------------------
// Plays the stragety "Cross"
// x . x
// . x .
// x . x
function stragetyCross:boolean;
begin
aiout('~ Starting Cross strageties ~');
stragetyCross:=false;
if form1.scmind.Position < 2 then exit;
aiout('Stragety "Cross" 13-22-31 inizialised:');
if (playfield[1,3]=0)and ((playfield[3,1]=0) or (playfield[3,1]=1)) then
begin
aiout('Playing Stragety 13-22-31');
compselect(form1.btn13);
stragetycross:=true;
exit;
end;
aiout('Stragety "Cross" 13-22-31 canceled!');
aiout('Stragety "Cross" 31-13-13 inizialised:');
if (playfield[3,1]=0)and ((playfield[1,3]=0) or (playfield[1,3]=1)) then
begin
aiout('Playing Stragety 31-13-13');
compselect(form1.btn31);
stragetycross:=true;
exit;
end;
aiout('Stragety "Cross" 31-13-13 canceled');
aiout('Stragety 33-11-11 inizialised:');
if (playfield[3,3]=0)and ((playfield[1,1]=0) or (playfield[1,1]=1)) then
begin
aiout('Playing Stragety 11-22-33');
compselect(form1.btn33);
stragetycross:=true;
exit;
end;
aiout('Stragety "Cross" 33-11-11 canceled');
aiout('Stragety 11-33-33 inizialised:');
if (playfield[1,1]=0)and ((playfield[3,3]=0) or (playfield[3,3]=1)) then
begin
aiout('Playing Stragety 11-33-33');
compselect(form1.btn11);
stragetycross:=true;
exit;
end;
aiout('~ Cross-Stragety failed! ~');
end;
//------------------------------------------------------------------------------
// This starts the defence
// o is the Enemy
//
// o o . o o . o . o . . . o . o
// o . o o . o . . . . o . . o .
// . o o . o o o . o o . o . . .
function stratetyDefend:boolean;
var x,y:short;
begin
aiout('~ Starting defence~');
stratetyDefend:=false;
if form1.scmind.Position < 2 then exit;
for y:=1 to 3 do
begin
aiout('Checking Strategy ' + inttostr(y) + ' for leaks');
if playfield[y,1]+playfield[y,2]+playfield[y,3]=4 then
begin
aiout('Leak in Row' + inttostr(y) + ' found');
for x:=1 to 3 do
if playfield[y,x]=0 then
begin
aiout('Possibility to defend in: '+ inttostr(x));
playbutton[y,x].Caption:=form1.lblCurrent.caption;
playbutton[y,x].tag:=1;
stratetyDefend:=true;
exit;
end;
end;
end;
for y:=1 to 3 do
begin
aiout('Checking Row ' + inttostr(y) + ' for leaks');
if playfield[1,y]+playfield[2,y]+playfield[3,y]=4 then
begin
aiout('Leak in Row' + inttostr(y) + ' found');
for x:=1 to 3 do
if playfield[x,y]=0 then
begin
aiout('Possibility to defend in: '+ inttostr(x));
playbutton[x,y].Caption:=form1.lblCurrent.caption;
playbutton[x,y].tag:=1;
stratetyDefend:=true;
exit;
end;
end;
end;
aiout('Checking Strategy 11-22-33 for leaks');
if playfield[1,1]+playfield[2,2]+playfield[3,3]=4 then
begin
aiout('Leak in Stragety 11-22-33 found!');
for x:=1 to 3 do
if playfield[x,x]=0 then
begin
aiout('Possibility to defend in: '+ inttostr(x) + '-' + inttostr(x));
playbutton[x,x].Caption:=form1.lblCurrent.caption;
playbutton[x,x].tag:=1;
stratetyDefend:=true;
exit;
end;
end;
aiout('Checking Strategy 13-22-33 for leaks');
if playfield[1,3]+playfield[2,2]+playfield[3,1]=4 then
begin
for x:=1 to 3 do
if playfield[x,4-x]=0 then
begin
aiout('Possibility to defend in: '+ inttostr(x) + '-' + inttostr(4-x));
playbutton[x,4-x].Caption:=form1.lblCurrent.caption;
playbutton[x,4-x].tag:=1;
stratetyDefend:=true;
exit;
end;
end;
aiout('~ No need of defence ~');
end;
//------------------------------------------------------------------------------
// Plays the stragety "Horizontal"
// x x . x . x . x x . . . x . . . x . . . x
function stragetyhor:boolean;
var x,y:short;
begin
stragetyhor:=false;
aiout('~ Starting stragety "Horizontal" ~');
for y:=1 to 3 do
begin
if playfield[y,1]+playfield[y,2]+playfield[y,3] <=1 then
for x:=1 to 3 do
if playfield[y,x]=0 then
begin
aiout('Playing stragety "Horizontal" in ' + inttostr(y));
playbutton[y,x].Caption:=form1.lblCurrent.caption;
playbutton[y,x].tag:=1;
result:=true;
exit;
end;
end;
aiout('~ Stragety "Horizontal" failed ~');
end;
//------------------------------------------------------------------------------
// This plays the stragety "Vertical"
// x | x | . | . | x | . | .
// x | . | x | . | . | x | .
// . | x | x | . | . | . | x
function stragetyver:boolean;
var x,y:short;
begin
stragetyver:=false;
aiout('~ Begin stragety "Vertical" ~');
for y:=1 to 3 do
begin
if playfield[1,y]+playfield[2,y]+playfield[3,y] =1 then
for x:=1 to 3 do
if playfield[x,y]=0 then
begin
aiout('Playing Stragety "Vertical" in ' + inttostr(y));
playbutton[x,y].Caption:=form1.lblCurrent.caption;
playbutton[x,y].tag:=1;
result:=true;
exit;
end;
end;
aiout('~ Strategy "Vertical" failed ~');
end;
//------------------------------------------------------------------------------
// This procedure is the "main IQ" of the Master Mind AI
// It analyses the Field and decides if the AI should stop
// the "defending" algorithm and win the match by positioning
// ONE mark.
function Specialstragety:boolean;
var x:short;
begin
aiout('~ Starting Specialstragety ~');
result:=false;
if form1.scmind.Position < 3 then exit;
for x:= 1 to 3 do
begin
if playfield[x,1]=1 then
begin
if playfield[x,2] = 1 then
begin
if playfield[x,3] = 0 then
begin
aiout('Specialstragety playable in' + inttostr(x) + ' 3');
playbutton[x,3].caption:=form1.lblcurrent.caption;
playbutton[x,3].Tag:=1;
result:=true;
exit;
end;
end
else
begin
if (playfield[x,2]=0) and (playfield[x,3]=1) then
begin
aiout('Specialstragety playable in ' + inttostr(x) + ' 2');
playbutton[x,2].caption:=form1.lblcurrent.caption;
playbutton[x,2].Tag:=1;
result:=true;
exit;
end;
end;
end
else
begin
if (playfield[x,1]=0) and (playfield[x,2]=1) and (playfield[x,3]=1) then
begin
aiout('Specialstragety playable in ' + inttostr(x) + ' 1');
playbutton[x,1].caption:=form1.lblcurrent.caption;
playbutton[x,1].Tag:=1;
result:=true;
exit;
end;
end;
end;
for x:= 1 to 3 do
begin
if playfield[1,x]=1 then
begin
if playfield[2,x] = 1 then
begin
if playfield[3,x] = 0 then
begin
aiout('Specialstragety playable in 3 ' + inttostr(x) );
playbutton[3,x].caption:=form1.lblcurrent.caption;
playbutton[3,x].Tag:=1;
result:=true;
exit;
end;
end
else
begin
if (playfield[2,x]=0) and (playfield[3,x]=1) then
begin
aiout('Specialstragety playable in 2 ' + inttostr(x) );
playbutton[2,x].caption:=form1.lblcurrent.caption;
playbutton[2,x].Tag:=1;
result:=true;
exit;
end;
end;
end
else
begin
if (playfield[1,x]=0) and (playfield[2,x]=1) and (playfield[3,x]=1) then
begin
aiout('Specialstragety playable in 1 ' + inttostr(x) );
playbutton[1,x].caption:=form1.lblcurrent.caption;
playbutton[1,x].Tag:=1;
result:=true;
exit;
end;
end;
end;
end;
//------------------------------------------------------------------------------
// Checks the win-situations
function isWon:string;
var x,y:short;
Bat:boolean;
begin
if (form1.btn11.caption=form1.btn12.caption) and (form1.btn12.caption=form1.btn13.caption) and (form1.btn13.caption<>'') then
begin
form1.btn11.Font.Color:=clred;
form1.btn12.Font.Color:=clred;
form1.btn13.Font.Color:=clred;
result:= form1.btn12.caption;
exit;
end;
if (form1.btn21.caption=form1.btn22.caption) and (form1.btn23.caption=form1.btn22.caption) and (form1.btn23.caption<>'') then
begin
form1.btn21.Font.Color:=clred;
form1.btn22.Font.Color:=clred;
form1.btn23.Font.Color:=clred;
result:= form1.btn22.caption;
exit;
end;
if (form1.btn31.caption=form1.btn32.caption) and (form1.btn33.caption=form1.btn32.caption) and (form1.btn33.caption<>'') then
begin
form1.btn31.Font.Color:=clred;
form1.btn32.Font.Color:=clred;
form1.btn33.Font.Color:=clred;
result:= form1.btn33.caption;
exit;
end;
if (form1.btn11.caption=form1.btn21.caption) and (form1.btn31.caption=form1.btn21.caption) and (form1.btn31.caption<>'') then
begin
form1.btn21.Font.Color:=clred;
form1.btn11.Font.Color:=clred;
form1.btn31.Font.Color:=clred;
result:= form1.btn21.caption;
exit;
end;
if (form1.btn12.caption=form1.btn22.caption) and (form1.btn32.caption=form1.btn22.caption) and(form1.btn32.caption<>'') then
begin
form1.btn12.Font.Color:=clred;
form1.btn22.Font.Color:=clred;
form1.btn32.Font.Color:=clred;
result:= form1.btn22.caption;
exit;
end;
if (form1.btn13.caption=form1.btn23.caption) and (form1.btn23.caption=form1.btn33.caption) and (form1.btn33.caption<>'') then
begin
form1.btn13.Font.Color:=clred;
form1.btn23.Font.Color:=clred;
form1.btn33.Font.Color:=clred;
result:= form1.btn33.caption;
exit;
end;
if (form1.btn11.caption=form1.btn22.caption) and(form1.btn33.caption=form1.btn22.caption) and (form1.btn33.caption<>'') then
begin
form1.btn22.Font.Color:=clred;
form1.btn33.Font.Color:=clred;
form1.btn11.Font.Color:=clred;
result:= form1.btn11.caption;
exit;
end;
if (form1.btn31.caption=form1.btn22.caption) and (form1.btn13.caption=form1.btn22.caption) and (form1.btn13.caption<>'') then
begin
result:= form1.btn22.caption;
exit;
end;
bat:=true;
for x:= 1 to 3 do //Check if the game ended in a draw
for y:=1 to 3 do
if playfield[x,y]=0 then bat:=false;
if bat= true then
begin
result:= 'Nobody';
exit;
end;
result:=''; // No one has won
end;
//------------------------------------------------------------------------------
// Play several Strageties
procedure compplay;
var x,y:short;
begin
if form1.scmind.position = 1 then //Low Lewel AI operations
begin
for x:=1 to 3 do
for y:=1 to 3 do
begin
aiout ('Low Lewel Choice: ' + inttostr(x) + '-' + inttostr(y));
if playfield[x,y]=0 then
begin
playbutton[x,y].Caption := form1.lblcurrent.caption;
playbutton[x,y].tag:=1;
exit;
end;
end;
end;
if not specialstragety then
if (stratetyDefend=false) then //High priority operation
begin
if playfield[2,2]=0 then //Start cross stragety
begin
compselect(form1.btn22); // Get 2-2 Field
exit;
end
else
begin
if form1.btn22.tag=1 then //If occupied by PC
begin
if StragetyCross = true then exit; //Play Stragety "Cross"
end
else
if stragetyhor = true then exit;
end;
if stragetyhor = true then exit; //Play stragety "Horizontal"
if stragetyver = true then exit; //Play stragety "Vertical"
for x:=1 to 3 do //Otherwise try first possible
for y:=1 to 3 do
begin
aiout ('Check "Nonsenese" stragety: ' + inttostr(x) + '-' + inttostr(y));
if playfield[x,y]=0 then
begin
playbutton[x,y].Caption := form1.lblcurrent.caption;
playbutton[x,y].tag:=1;
if iswon <>'' then form1.lblstatus.caption:= iswon + ' has won'; //Won?
exit;
end;
end;
if iswon <>'' then form1.lblstatus.caption:= iswon + ' has won'; //Won?
end;
end;
//------------------------------------------------------------------------------
// Resets everything for a new game
procedure resetall;
var x,y:short;
begin
for x:=1 to 3 do //Reset the tags and the color
for y:=1 to 3 do
begin
playfield[x,y]:=0;
playbutton[x,y].font.color:=clblack;
end;
form1.lblStatus.caption:=''; //Reset the caption
form1.btn11.Caption:='';
form1.btn12.Caption:='';
form1.btn13.Caption:='';
form1.btn21.Caption:='';
form1.btn22.Caption:='';
form1.btn23.Caption:='';
form1.btn31.Caption:='';
form1.btn32.Caption:='';
form1.btn33.Caption:='';
if form1.chckHumanStarts.checked=true then
begin
compplay;
if form1.lblCurrent.Caption= 'X' then form1.lblCurrent.Caption:='O'
else form1.lblCurrent.Caption:='X'; //Next turn
end;
form1.memai.Lines.clear; //AI filed reset
end;
//------------------------------------------------------------------------------
// This Procedure checks for a click on a square
// and determines several things:
// 1) Is the move legal?
// 2) Which symbol must be displayed?
procedure PlayerPlays(Btn:Tbutton);
begin
if btn.Caption <> '' then // Is the field already occupied?
begin
application.MessageBox('Fild is already occupied!','');
exit;
end;
if form1.lblstatus.caption <> '' then // Is the game still runnung
begin
application.messagebox('The game has ended!','');
exit;
end;
btn.caption:=form1.lblCurrent.caption; // Put O or X
btn.Tag:=2; // Mark as played by Human
if form1.lblCurrent.Caption= 'X' then form1.lblCurrent.Caption:='O' //after X comes o and v.v.
else form1.lblCurrent.Caption:='X';
if playmode='HumanVSHuman' then // Determine if Playmode is Human VS Human
begin
if iswon <> '' then form1.lblstatus.caption:= iswon + ' has won!';
aiout('Analyse: ' +inttostr(situation));
exit;
end;
buildplayfield; // H VS CPU
compPlay; // CPU plays
if iswon <>'' then form1.lblstatus.caption:= iswon + ' has won'; //Won?
if form1.lblCurrent.Caption= 'X' then form1.lblCurrent.Caption:='O' //Print next player
else form1.lblCurrent.Caption:='X';
aiout('Anylse: ' +inttostr(situation)); //Put Analyse
end;
//------------------------------------------------------------------------------
// Those procedures are used to get the user's choice
procedure TForm1.btn11Click(Sender: TObject);
begin
playerplays(form1.btn11);
end;
procedure TForm1.btn12Click(Sender: TObject);
begin
playerplays(form1.btn12);
end;
procedure TForm1.btn13Click(Sender: TObject);
begin
playerplays(form1.btn13);
end;
procedure TForm1.btn21Click(Sender: TObject);
begin
playerplays(form1.btn21);
end;
procedure TForm1.btn22Click(Sender: TObject);
begin
playerplays(form1.btn22);
end;
procedure TForm1.btn23Click(Sender: TObject);
begin
playerplays(form1.btn23);
end;
procedure TForm1.btn31Click(Sender: TObject);
begin
playerplays(form1.btn31);
end;
procedure TForm1.btn32Click(Sender: TObject);
begin
playerplays(form1.btn32);
end;
procedure TForm1.btn33Click(Sender: TObject);
begin
playerplays(form1.btn33);
end;
//-----------------------------------------------------------------------------
//------------------------------------------------------------------------------
// Create and pre set up the data
procedure TForm1.FormCreate(Sender: TObject);
begin
playmode:='HumanVSCpu'; //Standard Playmode
playbutton[1,1]:=form1.btn11; // Fields are used for an easy Button
playbutton[1,2]:=form1.btn12; // control
playbutton[1,3]:=form1.btn13;
playbutton[2,1]:=form1.btn21;
playbutton[2,2]:=form1.btn22;
playbutton[2,3]:=form1.btn23;
playbutton[3,1]:=form1.btn31;
playbutton[3,2]:=form1.btn32;
playbutton[3,3]:=form1.btn33;
resetAll; // Reset all
end;
//------------------------------------------------------------------------------
// Reset everything
procedure TForm1.btnResetClick(Sender: TObject);
begin
resetall;
end;
//------------------------------------------------------------------------------
// These procedures are used to switch the palymodes: Either H VS C or H VS H
procedure TForm1.rdHVSCClick(Sender: TObject);
begin
if rdhvsc.Checked= true then playmode:='HumanVSCpu';
end;
procedure TForm1.rdHVsHClick(Sender: TObject);
begin
if rdhvsh.Checked= true then playmode:='HumanVSHuman';
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
// Either CPU or Human goes first
procedure TForm1.chckHumanStartsClick(Sender: TObject);
begin
application.MessageBox('A new game will be started!','');
resetall;
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls;
type
TForm1 = class(TForm)
lblCurrent: TLabel;
lblStatus: TLabel;
bllAmZug: TLabel;
memAI: TMemo;
imgTitle: TImage;
gbPlaymode: TGroupBox;
rdHVsH: TRadioButton;
rdHVSC: TRadioButton;
chckHumanStarts: TCheckBox;
Panel1: TPanel;
btn11: TButton;
btn12: TButton;
btn13: TButton;
btn21: TButton;
btn22: TButton;
btn23: TButton;
btn31: TButton;
btn32: TButton;
btn33: TButton;
btnReset: TButton;
scMind: TScrollBar;
lblKILevel: TLabel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
procedure btn11Click(Sender: TObject);
procedure btn12Click(Sender: TObject);
procedure btn13Click(Sender: TObject);
procedure btn21Click(Sender: TObject);
procedure btn22Click(Sender: TObject);
procedure btn23Click(Sender: TObject);
procedure btn31Click(Sender: TObject);
procedure btn32Click(Sender: TObject);
procedure btn33Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnResetClick(Sender: TObject);
procedure rdHVSCClick(Sender: TObject);
procedure rdHVsHClick(Sender: TObject);
procedure chckHumanStartsClick(Sender: TObject);
private
public
{ Public declarations }
end;
var
Form1: TForm1;
playmode:string;
playfield:array [1..3,1..3] of integer; //0.. Empty 1..Cpu 2..Human
playButton:array [1..3,1..3] of tbutton;
implementation
{$R *.dfm}
//------------------------------------------------------------------------------
// Expresses the playfield as integer
function Situation:integer;
var x,y:short;
var temp:string;
begin
temp:='';
for x:=1 to 3 do
for y:=1 to 3 do
temp:=temp + inttostr(playfield[x,y]);
result:=strtoint(temp);
end;
//------------------------------------------------------------------------------
// Displays the current AI output
procedure aiout(str:string);
begin
form1.memai.Lines.Add(str);
0end;
//------------------------------------------------------------------------------
// Building Plan for field
procedure BuildPlayfield;
var x,y:short;
begin
aiout('Building Field...');
for x:=1 to 3 do
for y:=1 to 3 do
playfield[x,y]:=0;
if form1.btn11.caption='' then playfield[1,1]:=0
else playfield[1,1]:=form1.btn11.tag;
if form1.btn21.caption='' then playfield[2,1]:=0
else playfield[2,1]:=form1.btn21.tag;
if form1.btn31.caption='' then playfield[3,1]:=0
else playfield[3,1]:=form1.btn31.tag;
if form1.btn12.caption='' then playfield[1,2]:=0
else playfield[1,2]:=form1.btn12.tag;
if form1.btn22.caption='' then playfield[2,2]:=0
else playfield[2,2]:=form1.btn22.tag;
if form1.btn32.caption='' then playfield[3,2]:=0
else playfield[3,2]:=form1.btn32.tag;
if form1.btn13.caption='' then playfield[1,3]:=0
else playfield[1,3]:=form1.btn13.tag;
if form1.btn23.caption='' then playfield[2,3]:=0
else playfield[2,3]:=form1.btn23.tag;
if form1.btn33.caption='' then playfield[3,3]:=0
else playfield[3,3]:=form1.btn33.tag;
end;
//------------------------------------------------------------------------------
// Plays the given button
procedure compselect(btn:tbutton);
begin
btn.caption:=form1.lblcurrent.caption;
btn.tag:=1;
end;
//------------------------------------------------------------------------------
// Plays the stragety "Cross"
// x . x
// . x .
// x . x
function stragetyCross:boolean;
begin
aiout('~ Starting Cross strageties ~');
stragetyCross:=false;
if form1.scmind.Position < 2 then exit;
aiout('Stragety "Cross" 13-22-31 inizialised:');
if (playfield[1,3]=0)and ((playfield[3,1]=0) or (playfield[3,1]=1)) then
begin
aiout('Playing Stragety 13-22-31');
compselect(form1.btn13);
stragetycross:=true;
exit;
end;
aiout('Stragety "Cross" 13-22-31 canceled!');
aiout('Stragety "Cross" 31-13-13 inizialised:');
if (playfield[3,1]=0)and ((playfield[1,3]=0) or (playfield[1,3]=1)) then
begin
aiout('Playing Stragety 31-13-13');
compselect(form1.btn31);
stragetycross:=true;
exit;
end;
aiout('Stragety "Cross" 31-13-13 canceled');
aiout('Stragety 33-11-11 inizialised:');
if (playfield[3,3]=0)and ((playfield[1,1]=0) or (playfield[1,1]=1)) then
begin
aiout('Playing Stragety 11-22-33');
compselect(form1.btn33);
stragetycross:=true;
exit;
end;
aiout('Stragety "Cross" 33-11-11 canceled');
aiout('Stragety 11-33-33 inizialised:');
if (playfield[1,1]=0)and ((playfield[3,3]=0) or (playfield[3,3]=1)) then
begin
aiout('Playing Stragety 11-33-33');
compselect(form1.btn11);
stragetycross:=true;
exit;
end;
aiout('~ Cross-Stragety failed! ~');
end;
//------------------------------------------------------------------------------
// This starts the defence
// o is the Enemy
//
// o o . o o . o . o . . . o . o
// o . o o . o . . . . o . . o .
// . o o . o o o . o o . o . . .
function stratetyDefend:boolean;
var x,y:short;
begin
aiout('~ Starting defence~');
stratetyDefend:=false;
if form1.scmind.Position < 2 then exit;
for y:=1 to 3 do
begin
aiout('Checking Strategy ' + inttostr(y) + ' for leaks');
if playfield[y,1]+playfield[y,2]+playfield[y,3]=4 then
begin
aiout('Leak in Row' + inttostr(y) + ' found');
for x:=1 to 3 do
if playfield[y,x]=0 then
begin
aiout('Possibility to defend in: '+ inttostr(x));
playbutton[y,x].Caption:=form1.lblCurrent.caption;
playbutton[y,x].tag:=1;
stratetyDefend:=true;
exit;
end;
end;
end;
for y:=1 to 3 do
begin
aiout('Checking Row ' + inttostr(y) + ' for leaks');
if playfield[1,y]+playfield[2,y]+playfield[3,y]=4 then
begin
aiout('Leak in Row' + inttostr(y) + ' found');
for x:=1 to 3 do
if playfield[x,y]=0 then
begin
aiout('Possibility to defend in: '+ inttostr(x));
playbutton[x,y].Caption:=form1.lblCurrent.caption;
playbutton[x,y].tag:=1;
stratetyDefend:=true;
exit;
end;
end;
end;
aiout('Checking Strategy 11-22-33 for leaks');
if playfield[1,1]+playfield[2,2]+playfield[3,3]=4 then
begin
aiout('Leak in Stragety 11-22-33 found!');
for x:=1 to 3 do
if playfield[x,x]=0 then
begin
aiout('Possibility to defend in: '+ inttostr(x) + '-' + inttostr(x));
playbutton[x,x].Caption:=form1.lblCurrent.caption;
playbutton[x,x].tag:=1;
stratetyDefend:=true;
exit;
end;
end;
aiout('Checking Strategy 13-22-33 for leaks');
if playfield[1,3]+playfield[2,2]+playfield[3,1]=4 then
begin
for x:=1 to 3 do
if playfield[x,4-x]=0 then
begin
aiout('Possibility to defend in: '+ inttostr(x) + '-' + inttostr(4-x));
playbutton[x,4-x].Caption:=form1.lblCurrent.caption;
playbutton[x,4-x].tag:=1;
stratetyDefend:=true;
exit;
end;
end;
aiout('~ No need of defence ~');
end;
//------------------------------------------------------------------------------
// Plays the stragety "Horizontal"
// x x . x . x . x x . . . x . . . x . . . x
function stragetyhor:boolean;
var x,y:short;
begin
stragetyhor:=false;
aiout('~ Starting stragety "Horizontal" ~');
for y:=1 to 3 do
begin
if playfield[y,1]+playfield[y,2]+playfield[y,3] <=1 then
for x:=1 to 3 do
if playfield[y,x]=0 then
begin
aiout('Playing stragety "Horizontal" in ' + inttostr(y));
playbutton[y,x].Caption:=form1.lblCurrent.caption;
playbutton[y,x].tag:=1;
result:=true;
exit;
end;
end;
aiout('~ Stragety "Horizontal" failed ~');
end;
//------------------------------------------------------------------------------
// This plays the stragety "Vertical"
// x | x | . | . | x | . | .
// x | . | x | . | . | x | .
// . | x | x | . | . | . | x
function stragetyver:boolean;
var x,y:short;
begin
stragetyver:=false;
aiout('~ Begin stragety "Vertical" ~');
for y:=1 to 3 do
begin
if playfield[1,y]+playfield[2,y]+playfield[3,y] =1 then
for x:=1 to 3 do
if playfield[x,y]=0 then
begin
aiout('Playing Stragety "Vertical" in ' + inttostr(y));
playbutton[x,y].Caption:=form1.lblCurrent.caption;
playbutton[x,y].tag:=1;
result:=true;
exit;
end;
end;
aiout('~ Strategy "Vertical" failed ~');
end;
//------------------------------------------------------------------------------
// This procedure is the "main IQ" of the Master Mind AI
// It analyses the Field and decides if the AI should stop
// the "defending" algorithm and win the match by positioning
// ONE mark.
function Specialstragety:boolean;
var x:short;
begin
aiout('~ Starting Specialstragety ~');
result:=false;
if form1.scmind.Position < 3 then exit;
for x:= 1 to 3 do
begin
if playfield[x,1]=1 then
begin
if playfield[x,2] = 1 then
begin
if playfield[x,3] = 0 then
begin
aiout('Specialstragety playable in' + inttostr(x) + ' 3');
playbutton[x,3].caption:=form1.lblcurrent.caption;
playbutton[x,3].Tag:=1;
result:=true;
exit;
end;
end
else
begin
if (playfield[x,2]=0) and (playfield[x,3]=1) then
begin
aiout('Specialstragety playable in ' + inttostr(x) + ' 2');
playbutton[x,2].caption:=form1.lblcurrent.caption;
playbutton[x,2].Tag:=1;
result:=true;
exit;
end;
end;
end
else
begin
if (playfield[x,1]=0) and (playfield[x,2]=1) and (playfield[x,3]=1) then
begin
aiout('Specialstragety playable in ' + inttostr(x) + ' 1');
playbutton[x,1].caption:=form1.lblcurrent.caption;
playbutton[x,1].Tag:=1;
result:=true;
exit;
end;
end;
end;
for x:= 1 to 3 do
begin
if playfield[1,x]=1 then
begin
if playfield[2,x] = 1 then
begin
if playfield[3,x] = 0 then
begin
aiout('Specialstragety playable in 3 ' + inttostr(x) );
playbutton[3,x].caption:=form1.lblcurrent.caption;
playbutton[3,x].Tag:=1;
result:=true;
exit;
end;
end
else
begin
if (playfield[2,x]=0) and (playfield[3,x]=1) then
begin
aiout('Specialstragety playable in 2 ' + inttostr(x) );
playbutton[2,x].caption:=form1.lblcurrent.caption;
playbutton[2,x].Tag:=1;
result:=true;
exit;
end;
end;
end
else
begin
if (playfield[1,x]=0) and (playfield[2,x]=1) and (playfield[3,x]=1) then
begin
aiout('Specialstragety playable in 1 ' + inttostr(x) );
playbutton[1,x].caption:=form1.lblcurrent.caption;
playbutton[1,x].Tag:=1;
result:=true;
exit;
end;
end;
end;
end;
//------------------------------------------------------------------------------
// Checks the win-situations
function isWon:string;
var x,y:short;
Bat:boolean;
begin
if (form1.btn11.caption=form1.btn12.caption) and (form1.btn12.caption=form1.btn13.caption) and (form1.btn13.caption<>'') then
begin
form1.btn11.Font.Color:=clred;
form1.btn12.Font.Color:=clred;
form1.btn13.Font.Color:=clred;
result:= form1.btn12.caption;
exit;
end;
if (form1.btn21.caption=form1.btn22.caption) and (form1.btn23.caption=form1.btn22.caption) and (form1.btn23.caption<>'') then
begin
form1.btn21.Font.Color:=clred;
form1.btn22.Font.Color:=clred;
form1.btn23.Font.Color:=clred;
result:= form1.btn22.caption;
exit;
end;
if (form1.btn31.caption=form1.btn32.caption) and (form1.btn33.caption=form1.btn32.caption) and (form1.btn33.caption<>'') then
begin
form1.btn31.Font.Color:=clred;
form1.btn32.Font.Color:=clred;
form1.btn33.Font.Color:=clred;
result:= form1.btn33.caption;
exit;
end;
if (form1.btn11.caption=form1.btn21.caption) and (form1.btn31.caption=form1.btn21.caption) and (form1.btn31.caption<>'') then
begin
form1.btn21.Font.Color:=clred;
form1.btn11.Font.Color:=clred;
form1.btn31.Font.Color:=clred;
result:= form1.btn21.caption;
exit;
end;
if (form1.btn12.caption=form1.btn22.caption) and (form1.btn32.caption=form1.btn22.caption) and(form1.btn32.caption<>'') then
begin
form1.btn12.Font.Color:=clred;
form1.btn22.Font.Color:=clred;
form1.btn32.Font.Color:=clred;
result:= form1.btn22.caption;
exit;
end;
if (form1.btn13.caption=form1.btn23.caption) and (form1.btn23.caption=form1.btn33.caption) and (form1.btn33.caption<>'') then
begin
form1.btn13.Font.Color:=clred;
form1.btn23.Font.Color:=clred;
form1.btn33.Font.Color:=clred;
result:= form1.btn33.caption;
exit;
end;
if (form1.btn11.caption=form1.btn22.caption) and(form1.btn33.caption=form1.btn22.caption) and (form1.btn33.caption<>'') then
begin
form1.btn22.Font.Color:=clred;
form1.btn33.Font.Color:=clred;
form1.btn11.Font.Color:=clred;
result:= form1.btn11.caption;
exit;
end;
if (form1.btn31.caption=form1.btn22.caption) and (form1.btn13.caption=form1.btn22.caption) and (form1.btn13.caption<>'') then
begin
result:= form1.btn22.caption;
exit;
end;
bat:=true;
for x:= 1 to 3 do //Check if the game ended in a draw
for y:=1 to 3 do
if playfield[x,y]=0 then bat:=false;
if bat= true then
begin
result:= 'Nobody';
exit;
end;
result:=''; // No one has won
end;
//------------------------------------------------------------------------------
// Play several Strageties
procedure compplay;
var x,y:short;
begin
if form1.scmind.position = 1 then //Low Lewel AI operations
begin
for x:=1 to 3 do
for y:=1 to 3 do
begin
aiout ('Low Lewel Choice: ' + inttostr(x) + '-' + inttostr(y));
if playfield[x,y]=0 then
begin
playbutton[x,y].Caption := form1.lblcurrent.caption;
playbutton[x,y].tag:=1;
exit;
end;
end;
end;
if not specialstragety then
if (stratetyDefend=false) then //High priority operation
begin
if playfield[2,2]=0 then //Start cross stragety
begin
compselect(form1.btn22); // Get 2-2 Field
exit;
end
else
begin
if form1.btn22.tag=1 then //If occupied by PC
begin
if StragetyCross = true then exit; //Play Stragety "Cross"
end
else
if stragetyhor = true then exit;
end;
if stragetyhor = true then exit; //Play stragety "Horizontal"
if stragetyver = true then exit; //Play stragety "Vertical"
for x:=1 to 3 do //Otherwise try first possible
for y:=1 to 3 do
begin
aiout ('Check "Nonsenese" stragety: ' + inttostr(x) + '-' + inttostr(y));
if playfield[x,y]=0 then
begin
playbutton[x,y].Caption := form1.lblcurrent.caption;
playbutton[x,y].tag:=1;
if iswon <>'' then form1.lblstatus.caption:= iswon + ' has won'; //Won?
exit;
end;
end;
if iswon <>'' then form1.lblstatus.caption:= iswon + ' has won'; //Won?
end;
end;
//------------------------------------------------------------------------------
// Resets everything for a new game
procedure resetall;
var x,y:short;
begin
for x:=1 to 3 do //Reset the tags and the color
for y:=1 to 3 do
begin
playfield[x,y]:=0;
playbutton[x,y].font.color:=clblack;
end;
form1.lblStatus.caption:=''; //Reset the caption
form1.btn11.Caption:='';
form1.btn12.Caption:='';
form1.btn13.Caption:='';
form1.btn21.Caption:='';
form1.btn22.Caption:='';
form1.btn23.Caption:='';
form1.btn31.Caption:='';
form1.btn32.Caption:='';
form1.btn33.Caption:='';
if form1.chckHumanStarts.checked=true then
begin
compplay;
if form1.lblCurrent.Caption= 'X' then form1.lblCurrent.Caption:='O'
else form1.lblCurrent.Caption:='X'; //Next turn
end;
form1.memai.Lines.clear; //AI filed reset
end;
//------------------------------------------------------------------------------
// This Procedure checks for a click on a square
// and determines several things:
// 1) Is the move legal?
// 2) Which symbol must be displayed?
procedure PlayerPlays(Btn:Tbutton);
begin
if btn.Caption <> '' then // Is the field already occupied?
begin
application.MessageBox('Fild is already occupied!','');
exit;
end;
if form1.lblstatus.caption <> '' then // Is the game still runnung
begin
application.messagebox('The game has ended!','');
exit;
end;
btn.caption:=form1.lblCurrent.caption; // Put O or X
btn.Tag:=2; // Mark as played by Human
if form1.lblCurrent.Caption= 'X' then form1.lblCurrent.Caption:='O' //after X comes o and v.v.
else form1.lblCurrent.Caption:='X';
if playmode='HumanVSHuman' then // Determine if Playmode is Human VS Human
begin
if iswon <> '' then form1.lblstatus.caption:= iswon + ' has won!';
aiout('Analyse: ' +inttostr(situation));
exit;
end;
buildplayfield; // H VS CPU
compPlay; // CPU plays
if iswon <>'' then form1.lblstatus.caption:= iswon + ' has won'; //Won?
if form1.lblCurrent.Caption= 'X' then form1.lblCurrent.Caption:='O' //Print next player
else form1.lblCurrent.Caption:='X';
aiout('Anylse: ' +inttostr(situation)); //Put Analyse
end;
//------------------------------------------------------------------------------
// Those procedures are used to get the user's choice
procedure TForm1.btn11Click(Sender: TObject);
begin
playerplays(form1.btn11);
end;
procedure TForm1.btn12Click(Sender: TObject);
begin
playerplays(form1.btn12);
end;
procedure TForm1.btn13Click(Sender: TObject);
begin
playerplays(form1.btn13);
end;
procedure TForm1.btn21Click(Sender: TObject);
begin
playerplays(form1.btn21);
end;
procedure TForm1.btn22Click(Sender: TObject);
begin
playerplays(form1.btn22);
end;
procedure TForm1.btn23Click(Sender: TObject);
begin
playerplays(form1.btn23);
end;
procedure TForm1.btn31Click(Sender: TObject);
begin
playerplays(form1.btn31);
end;
procedure TForm1.btn32Click(Sender: TObject);
begin
playerplays(form1.btn32);
end;
procedure TForm1.btn33Click(Sender: TObject);
begin
playerplays(form1.btn33);
end;
//-----------------------------------------------------------------------------
//------------------------------------------------------------------------------
// Create and pre set up the data
procedure TForm1.FormCreate(Sender: TObject);
begin
playmode:='HumanVSCpu'; //Standard Playmode
playbutton[1,1]:=form1.btn11; // Fields are used for an easy Button
playbutton[1,2]:=form1.btn12; // control
playbutton[1,3]:=form1.btn13;
playbutton[2,1]:=form1.btn21;
playbutton[2,2]:=form1.btn22;
playbutton[2,3]:=form1.btn23;
playbutton[3,1]:=form1.btn31;
playbutton[3,2]:=form1.btn32;
playbutton[3,3]:=form1.btn33;
resetAll; // Reset all
end;
//------------------------------------------------------------------------------
// Reset everything
procedure TForm1.btnResetClick(Sender: TObject);
begin
resetall;
end;
//------------------------------------------------------------------------------
// These procedures are used to switch the palymodes: Either H VS C or H VS H
procedure TForm1.rdHVSCClick(Sender: TObject);
begin
if rdhvsc.Checked= true then playmode:='HumanVSCpu';
end;
procedure TForm1.rdHVsHClick(Sender: TObject);
begin
if rdhvsh.Checked= true then playmode:='HumanVSHuman';
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
// Either CPU or Human goes first
procedure TForm1.chckHumanStartsClick(Sender: TObject);
begin
application.MessageBox('A new game will be started!','');
resetall;
end;
end.