unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls;
type
TForm1 =
class(TForm)
Spielfeld: TStringGrid;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure SpielfeldDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure SpielfeldClick(Sender: TObject);
private
{ Private declarations }
procedure pause(zeit:LongInt);
procedure neu;
function pruefen(x,y,dx,dy,tiefe:integer):integer;
procedure umdrehen(x,y,dx,dy,weite,tiefe:integer);
function istspielfeld(x,y:integer):boolean;
function punkte(farbe,tiefe:integer):integer;
function differenz(x,y,farbe,tiefe:integer):integer;
procedure kopiere(tiefe:integer);
function bewerte(x,y,farbe,tiefe:integer):integer;
procedure setze(x,y:integer);
public
{ Public declarations }
end;
const
BREITE=60;
ANZAHL=5;
ROT=1;
BLAU=-1;
TIEFE=1;
var
Form1: TForm1;
feld:
array[0..ANZAHL-1,0..Anzahl-1,0..TIEFE]
of integer;
//0:frei;1:Rot,-1:Blau
dransein,zahl:integer;
implementation
{$R *.dfm}
procedure TForm1.pause(zeit:LongInt);
var zeit1:LongInt;
begin
zeit1:=GetTickCount;
repeat
Application.ProcessMessages
until (GetTickCount-zeit1>zeit)
end;
procedure TForm1.kopiere(tiefe:integer);
var i,j:integer;
begin
for i:=0
to ANZAHL-1
do
for j:=0
to ANZAHL -1
do
feld[i,j,tiefe]:=feld[i,j,tiefe-1];
end;
function TForm1.differenz(x,y,farbe,tiefe:integer):integer;
begin
Result:=punkte(farbe,tiefe)-punkte(-farbe,tiefe);
end;
function TForm1.punkte(farbe,tiefe:integer):integer;
var i,j,zahl:integer;
begin
zahl:=0;
for i:=0
to ANZAHL-1
do
for j:=0
to ANZAHL-1
do
if feld[i,j,tiefe]=farbe
then zahl:=zahl+1;
Result:=zahl;
end;
function TForm1.istspielfeld(x,y:integer):boolean;
begin
if ((x>=0)
and (x<ANZAHL))
and ((y>=0)
and (y<ANZAHL))
then Result:=true
else Result:=false;
end;
procedure TForm1.umdrehen(x,y,dx,dy,weite,tiefe:integer);
var i:integer;
begin
if weite>0
then for i:=1
to weite
do feld[x+i*dx,y+i*dy,tiefe]:=dransein;
end;
function Tform1.pruefen(x,y,dx,dy,tiefe:integer):integer;
begin
Result:=-1000;
if istspielfeld(x+dx,y+dy)
then
begin
if feld[x+dx,y+dy,tiefe]=-dransein
then Result:=pruefen(x+dx,y+dy,dx,dy,tiefe)+1;
if feld[x+dx,y+dy,tiefe]=dransein
then Result:=0;
end;
end;
procedure TForm1.neu;
var i,j:integer;
begin
zahl:=0;
dransein:=ROT;
for i:=0
to ANZAHL-1
do
for j:=0
to ANZAHL-1
do
feld[i,j,0]:=0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
spielfeld.ColCount:=ANZAHL;
spielfeld.RowCount:=ANZAHL;
spielfeld.DefaultColWidth:=BREITE;
spielfeld.DefaultRowHeight:=BREITE;
spielfeld.Width:=(BREITE+2)*ANZAHL;
spielfeld.Height:=(BREITE+2)*ANZAHL;
Form1.Width:=spielfeld.Width+2*spielfeld.Left;
Form1.Height:=spielfeld.Height+2*spielfeld.Top;
neu;
end;
function TForm1.bewerte(x,y,farbe,tiefe:integer):integer;
var i,j,dif ,bestx, besty, dif1, dif2:integer;
begin
Result:=-1000;
if feld[x,y,tiefe-1]=0
then begin
kopiere(tiefe);
feld[x,y,tiefe]:=farbe;
dif1:=differenz(x,y,farbe,tiefe);
for i:=-1
to 1
do
for j:=-1
to 1
do
umdrehen(x,y,i,j,pruefen(x,y,i,j,tiefe),tiefe);
//hier die for-schleifen für den besten Gegnerzug
dif:=-1000;
for i:=0
to ANZAHL-1
do
for j:=0
to ANZAHL -1
do
if bewerte(i,j,-farbe,tiefe+1)>dif
then
begin
bestx:=i;
besty:=j;
dif:=bewerte(bestx,besty,-farbe,tiefe+1);
end;
//Zug setzen
dif2:=differenz(x,y,farbe,tiefe);
Result:=((dif2-dif1)
div 2)-dif;
end;
end;
procedure TForm1.setze(x,y:integer);
var i,j:integer;
begin
zahl:=zahl+1;
feld[x,y,0]:=dransein;
for i:=-1
to 1
do
for j:=-1
to 1
do
umdrehen(x,y,i,j,pruefen(x,y,i,j,0),0);
spielfeld.Refresh;
if dransein=BLAU
then dransein:=ROT
else dransein:=BLAU;
if zahl=ANZAHL*ANZAHL
then begin
spielfeld.Enabled:=false;
Label1.caption:='
Es ist unentschieden!:'+IntToStr(punkte(ROT,0))+'
:'+IntToStr(punkte(BLAU,0));
if punkte(ROT,0)>punkte(BLAU,0)
then Label1.caption:='
ROT hat gewonnen';
if punkte(ROT,0)<punkte(BLAU,0)
then Label1.caption:='
BLAU hat gewonnen';
end;
end;
procedure TForm1.SpielfeldDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
case feld[aCol,ARow,0]
of
ROT:
begin
spielfeld.Canvas.Brush.Color:=clRed;
spielfeld.Canvas.Ellipse((BREITE+1)*ACol,(BREITE+1)*ARow,(BREITE+1)*(ACol+1),(BREITE+1)*(ARow+1));
end;
BLAU:
begin
spielfeld.Canvas.Brush.Color:=clBlue;
spielfeld.Canvas.Ellipse((BREITE+1)*ACol,(BREITE+1)*ARow,(BREITE+1)*(ACol+1),(BREITE+1)*(ARow+1));
end else begin
spielfeld.Canvas.Brush.Color:=clCream;
spielfeld.Canvas.FillRect(Rect);
end;
end;
end;
procedure TForm1.SpielfeldClick(Sender: TObject);
var i,j,dif,bestx,besty:integer;
begin
if feld[spielfeld.Col,spielfeld.Row,0]=0
then
setze(spielfeld.Col,spielfeld.Row);
pause(1000);
if not(zahl=ANZAHL*ANZAHL)
then begin //
repeat //suche beliebiges freies Feld
bestx:=Random(ANZAHL);
besty:=Random(ANZAHL);
until feld[bestx,besty,0]=0;
dif:=bewerte(bestx,besty,dransein,1);
for i:=0
to ANZAHL-1
do
for j:=0
to ANZAHL -1
do
if bewerte(i,j,dransein,1)>dif
then
begin
bestx:=i;
besty:=j;
dif:=bewerte(bestx,besty,dransein,1);
end;
//Zug setzen
setze(bestx,besty);
end;
end;
end.