unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls, StdCtrls;
type
TFieldType = ( ftX, ftO, ftNone );
TForm1 =
class(TForm)
ImageK0: TImage;
ImageK8: TImage;
ImageK4: TImage;
ImageK1: TImage;
ImageK2: TImage;
ImageK5: TImage;
ImageK3: TImage;
ImageK6: TImage;
ImageK7: TImage;
Label1: TLabel;
ImageO: TImage;
ImageX: TImage;
Memo1: TMemo;
Button1: TButton;
ImageBlank: TImage;
procedure ImageK0Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
bMovePlayerX : boolean;
bGameOver : boolean;
GameBoard :
array[ 0..2,0..2 ]
of TFieldType;
function CheckForFreeField( nFieldIdx : integer ) : boolean;
procedure SetField( img : TImage; nFieldIdx : integer; fieldType : TFieldType );
procedure ResetGameBoard();
procedure SimpleKI();
function FindField( nIdx : integer ) : TImage;
function CheckForWinner( ft : TFieldType ) : boolean;
function HasWinner() : TFieldType;
procedure ProcessWinnerFunc();
function IsGameOver() : boolean;
procedure ClearImages;
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//Sucht ein TImage Objekt, aus der Objektliste von Form1, mit dem Tag 'nIdx'
function TForm1.FindField( nIdx : integer ) : TImage;
var
i : integer;
begin
//Durchlauf aller Komponenten auf Form1
for i := 0
to Form1.ComponentCount - 1
do begin
//Falls Komponente 'i' von Typ TImage ist UND Komponente 'i' den Tag 'nIdx' hat, diese
//als Funktionsrückgabewert festlegen und aus der Schleife springen
if ( Form1.Components[ i ]
is TImage )
and ( ( Form1.Components[ i ]
as TImage ).Tag = nIdx )
then begin
result := Form1.Components[ i ]
as TImage;
break;
end;
end;
end;
//Resetet das Spielfeld
procedure TForm1.ResetGameBoard();
var
i,x,y : integer;
begin
for x := 0
to 2
do
begin
for y := 0
to 2
do
begin
//Setzt alle Einträge des Arrays 'GameBoard' auf den Wert ftNone
GameBoard[x,y] := ftNone;
//Setzt die globale Variable 'bGameOver' auf false
bGameOver := false;
end;
end;
end;
//Prüft ob das Spielfeld 'nFieldIdx' noch frei ist
function TForm1.CheckForFreeField( nFieldIdx : integer ) : boolean;
var x,y : integer;
begin
//Result standardmäßig auf false
result := false;
//Wenn 'nFieldIdx' größer als 8 ist false zurückgeben
if ( nFieldIdx > 8 )
then
result := false;
for x := 0
to 2
do
begin
for y := 0
to 2
do
begin
//Wenn das Spielfeld 'nFielIdx' den Wert ftNone hat, true zurückgeben
if ( GameBoard[ x,y ] = ftNone )
then
result := true;
end;
end;
end;
//Setzt das Spielfeld 'nFieldIdx' auf den wert 'fieldType' und weist 'img' das passende Bild zu
procedure TForm1.SetField( img : TImage; nFieldIdx : integer; fieldType : TFieldType );
var x,y : integer;
begin
//Ist das Feld 'nFieldIdx' noch frei?
if ( CheckForFreeField( nFieldIdx ) )
then begin
//Setzt das Feld 'nFieldIdx' auf den Wert 'fieldType'
for x := 0
to 2
do
begin
for y := 0
to 2
do
begin
GameBoard[ x,y ] := fieldType;
end;
end;
//Je nach 'fieldType' das passende Bild an 'img' übergeben
case fieldType
of
ftX : img.Picture.Assign( ImageX.Picture );
ftO : img.Picture.Assign( ImageO.Picture );
end;
end;
end;
//Event der allen Spielfeldern( Visell: TImage ) zugewießen wurde
procedure TForm1.ImageK0Click(Sender: TObject);
var
nFieldNum : integer;
nCurrImg : TImage;
begin
//Falls der Sender nicht von Typ TImage ist abbrechen
if not ( Sender
is TImage )
then
exit;
//Wenn 'bGameOver' auf true gesetzt ist, ebenfalls abbrechen
if bGameOver
then
exit;
//Den Sender einer Hilfvariable übergeben
nCurrImg := ( Sender
as TImage );
//Den Tag (Feldnummer) des Senders einer Hilfvariable übergeben
nFieldNum := nCurrImg.Tag;
//Überprüfen ob das geklickte Feld frei ist, falls nicht aus der
//Funktion springen
if (
not CheckForFreeField( nFieldNum ) )
then begin
Label1.Caption := '
Move again';
exit;
end;
//Passendes Bild bzw. passender Feldtype auswählen
if ( bMovePlayerX )
then
SetField( nCurrImg, nFieldNum, ftX )
else
SetField( nCurrImg, nFieldNum, ftO );
//Prüfen ob jemand gewonnen hat oder alle Felder belegt sind (unendschieden)
ProcessWinnerFunc();
//Wenn 'bGameOver' auf true gesetzt wurde aus der Funktion springen
if ( bGameOver )
then
exit;
//'bMovePlayerX' negieren'???
bMovePlayerX :=
not bMovePlayerX;
//Zufallszug für den Computer ausführen
SimpleKI();
//Nochmals Prüfen ob jemand gewonnen hat
ProcessWinnerFunc();
end;
//Create Event von Form1
procedure TForm1.FormCreate(Sender: TObject);
begin
//PlayerX fängt an
bMovePlayerX := true;
//Spielfeld reseten
ResetGameBoard;
Randomize;
end;
//Gane billige ZufallsKI
procedure TForm1.SimpleKI();
var
x,y,rndIdx : integer;
nCurrField : TImage;
begin
//Zufallswert zwischen 0 und 8
x := random (2);
y := random (2);
//Solang kein freies Feld für den jeweiligen Zufallswert gefunden wurde...
while not CheckForFreeField( rndIdx )
do begin
//...Neuen Zufallswert ermitteln
x := random (2);
y := random (2);
end;
//Finden des entprechenden TImage Objektes für den Index 'rndIdx'
nCurrField := FindField(rndIdx);
//Setzten des entsprechenden Wertes
if ( bMovePlayerX )
then
SetField( nCurrField,rndIdx, ftX )
else
SetField( nCurrField,rndIdx, ftO );
//Negieren von 'bMovePlayerX' (heisst das echt negieren???)
bMovePlayerX :=
not bMovePlayerX;
end;
//Prüft ob einer der beidem Player gewonnen hat
function TForm1.CheckForWinner( ft : TFieldType ) : boolean;
var
y,x,i : integer;
begin
{//Standardgemäß hat mal keiner gewonnen
result := false;
//Zähler auf 0
x := 0;
y :=0;
i:=0;
//Folgende zwei Schleifen könnte man in eine Funktion zusammenfassen
//Kleiner test
{while i < 8 do begin
if ( GameBoard[ y,x ] = ft ) and ( GameBoard[ y,x + 1 ] = ft ) and ( GameBoard[ y,x + 2 ] = ft ) then begin
result := true;
break;
end;
end;
end;
inc( i, 3 );
end;
//Zähler auf 0
i := 0;
//Nochmal ein kleiner test
while i <> 3 do begin
if ( GameBoard[ y,x ] = ft ) and ( GameBoard[ y,x + 3 ] = ft ) and ( GameBoard[ y,x + 6 ] = ft ) then begin
result := true;
break;
end;
inc( i, 1 );
end;
//Diagonale Reihen überpüfen
if ( GameBoard[ 0,0 ] = ft ) and ( GameBoard[ 1,1 ] = ft ) and ( GameBoard[ 2,2 ] = ft ) then
result := true;
//Ebenfalls diagonal
if ( GameBoard[ 0,2 ] = ft ) and ( GameBoard[ 1,1 ] = ft ) and ( GameBoard[ 2,0 ] = ft ) then
result := true; }
end;
//Checkt ob es einen Gewinner gibt, wenn ja wird der entsprechende Typ zurückgegeben
function TForm1.HasWinner() : TFieldType;
begin
//Standard auf ftNone
result := ftNone;
//Hat SpielerX gewonnen? Falls ja Rückgabewert auf ftX setzen
if ( CheckForWinner( ftX ) )
then
result := ftX
//Falls nicht, hat vielleicht SpielerO gewonnen?
else if ( CheckForWinner( ftO ) )
then
result := ftO;
end;
///////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////////
//Hilfsfunktion, auswerten des Gewinners
procedure TForm1.ProcessWinnerFunc();
var
winner : TFieldType;
begin
//Gewinnertyp zuweisen
winner := HasWinner();
//Wenn SpielerX gewonnen hat, das dem Spieler deutlich machen
if ( winner = ftX )
then begin
label1.Caption := '
Player ''
x''
has won';
bGameOver := true;
end
//Wenn SpielerO gewonnen hat, ebenfalls ausgeben
else if ( winner = ftO )
then begin
label1.Caption := '
Player ''
o''
has won';
bGameOver := true;
end;
//Wenn jemand gewonnen hat, können wir uns den Rest sparen
if ( bGameOver )
then exit;
//Prüfen ob alle Felder belegt wurden
bGameOver := IsGameOver();
//Wenn 'bGameOver' auf true gesetzt wurde UND keiner gewonnen hat,
//ist unentschieden angesagt.
if ( bGameOver )
and ( winner = ftNone )
then
label1.Caption := '
Nobody has won';
end;
//Prüft ob alle Spielfelder mit einem Wert (nicht ftNone) belegt sind
function TForm1.IsGameOver() : boolean;
var
i,x,y : integer;
begin
//Standard mal auf true
result := true;
//Schleife die immer Feld 'i' überprüft
for x := 0
to 2
do begin
for y := 0
to 2
do begin
//Falls ein Feld auf ftNone gesetzt ist, false zurückgeben
//und aus der Schleife springen
if ( GameBoard[ x,y ] = ftNone )
then begin
result := false;
break;
end;
end;
end;
end;
//Belegt alle TImage Objekte mit dem weisen Standardbild
procedure TForm1.ClearImages();
var
currImg : TImage;
i : integer;
begin
for i := 0
to 8
do begin
currImg := FindField( i );
//Falls currImg nicht nil ist
if ( currImg <>
nil )
then
currImg.Picture := ImageBlank.Picture;
end;
end;
//Event für Button1 (New game)
procedure TForm1.Button1Click(Sender: TObject);
begin
//Board reseten
ResetGameBoard;
//Images mit Standardbild versehen
ClearImages;
end;
end.