unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Grids, Menus, StdCtrls;
type
{ TForm1 }
TForm1 =
class(TForm)
Button1: TButton;
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
StringGrid1: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
type
Feld =
array[1..8, 1..8]
of Integer;
var
a: Feld;
zaehler: byte;
Hoehe, Breite, testerX, testerY: Integer;
dran: boolean;
procedure SpielFeld();
var
i, j: Integer;
begin
for i := 1
to 8
do
begin
for j := 1
to 8
do
begin
a[i, j] := 0;
form1.stringgrid1.cells[i - 1, j - 1] := IntToStr(a[i, j]);
end;
end;
// 0 = leere Felder (egal welche Farbe)
for i := 1
to 8
do
begin
for j := 1
to 3
do
begin
if (i
mod 2 = 0)
xor (j
mod 2 = 0)
then
begin
a[i, j] := 1;
form1.stringgrid1.cells[i - 1, j - 1] := IntToStr(a[i, j]);
end;
end;
end;
// 1 = weiße Spielsteine (2 ---> weiße Dame)
for i := 1
to 8
do
begin
for j := 6
to 8
do
begin
if (i
mod 2 = 0)
xor (j
mod 2 = 0)
then
begin
a[i, j] := 3;
form1.stringgrid1.cells[i - 1, j - 1] := IntToStr(a[i, j]);
end;
end;
end;
// 3 = schwarze Spielsteine (4 ---> schwarze Dame)
Form1.Image1.Height := Hoehe * 8;
Form1.Image1.Width := Breite * 8;
// 8*8 Felder
for i := 1
to 8
do
begin
for j := 1
to 8
do
begin
if (i
mod 2 = 0)
xor (j
mod 2 = 0)
then
begin
Form1.Image1.Canvas.Brush.Color := clblack;
case a[i, j]
of
1:
begin
Form1.Image1.Canvas.Brush.Color := clBlue;
Form1.Image1.Canvas.Ellipse((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
end;
3:
begin
Form1.Image1.Canvas.Brush.Color := clRed;
Form1.Image1.Canvas.Ellipse((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
end;
end;
end
else
begin
Form1.Image1.Canvas.Brush.Color := clwhite;
Form1.Image1.Canvas.Rectangle((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
end;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
zaehler := 0;
// zählt wie oft Maus geklickt wurde
dran := true;
// Wer ist dran? 0 = unten; 1 = oben
Hoehe := 40;
Breite := 40;
SpielFeld();
end;
procedure visual(i, j: Integer);
begin
form1.stringgrid1.cells[i - 1, j - 1] := IntToStr(a[i, j]);
form1.label1.caption := inttostr(i);
form1.label2.caption := inttostr(j);
case a[i, j]
of
0:
begin
Form1.Image1.Canvas.Brush.Color := clBlack;
Form1.Image1.Canvas.Rectangle((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
end;
1:
begin
Form1.Image1.Canvas.Brush.Color := clBlue;
Form1.Image1.Canvas.Ellipse((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
end;
3:
begin
Form1.Image1.Canvas.Brush.Color := clRed;
Form1.Image1.Canvas.Ellipse((i - 1) * Breite, (j - 1) * Hoehe, (i) * Breite, (j) * Hoehe);
end;
end;
end;
procedure reset(i, j, testerX, testerY: Integer);
begin
a[testerX, testerY] := 3;
a[i, j] := 0;
end;
procedure test(i, j, testerX, testerY: Integer);
begin
if (a[i, j] = 1)
then
showmessage('
Ungültiger Zug');
if (j = testerY - 1)
and (i = 1 + testerX)
or (i = testerX - 1)
then
begin
// fehlt hier was?
end
else
begin
reset(i, j, testerX, testerY);
showmessage('
Ungültiger Zug');
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i, j: Integer;
begin
i := X
div 40 + 1;
j := Y
div 40 + 1;
if dran = true
then
begin // wer dran ist
if (zaehler = 0)
and (a[i, j] = 3)
then
begin
a[i, j] := 0;
inc(zaehler);
testerX := i;
//Hilfsvariablen um über Gültigkeit in Procedure Test zu prüfen
testerY := j;
end
else
if (zaehler = 1)
and (a[i, j] = 0)
then
begin
a[i, j] := 3;
dec(zaehler);
//dran:=false;
test(i, j, testerX, testerY);
end;
end
else
if (a[i, j] = 1)
or (a[i, j] = 2)
then
begin
showmessage('
Nimm deinen eigenen Stein du Schummler!');
end;
form1.stringgrid1.cells[i - 1, j - 1] := IntToStr(a[i, j]);
visual(i, j);
refresh;
end;
end.