unit Schiebepuzzel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons, Grids;
type
Tmyarray=array[0..9]
of integer;
Tpuzzel =
class(Tpanel)
private
FRelPosX,FRelPosY, faltleft,falttop: Integer;
public
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer);
override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer);
override;
constructor Create(AOwner: TComponent);
override;
end;
Tform1 =
class(TForm)
Label1: TLabel;
NeuerVersuch: TButton;
LoesungZeigen: TButton;
beenden: TButton;
Edit1: TEdit;
Speichern: TButton;
Higscore: TButton;
Memo1: TMemo;
Edit2: TEdit;
Label2: TLabel;
Label3: TLabel;
StringGrid1: TStringGrid;
verlauf: TButton;
procedure FormCreate(Sender: TObject);
procedure NeuerVersuchClick(Sender: TObject);
procedure BeendenClick(Sender: TObject);
procedure LoesungZeigenClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure SpeichernClick(Sender: TObject);
procedure HigscoreClick(Sender: TObject);
private
schritte:integer;
public
puzzel: Tpuzzel;
end;
const klotznr:
array[1..59]
of byte=(5,4,1,2,3,4,1,6,7,8,9,5,4,1,6,7,8,9,5,9,8,5,4,1,3,2,7,6,4,6,7,4,5,6,7,5,3,2,5,4,3,2,4,2,3,6,7,1,4,5,2,3,6,7,1,4,9,8,1);
LageLeftTop:
array[1..59,1..2]
of byte=((150,100),(100,100),(0,50),(0,0),(100,0),(150,50),(50,50),(0,50),(0,150),(50,150),(50,200),(150,200),(150,150)
,(100,50),(50,50),(0,50),(0,150),(0,200),(100,150),(100,200),(0,200),(0,150),(50,150),(100,100),(100,50),(100,0),(0,0),(50,0),
(0,100),(50,100),(50,0),(0,0),(0,50),(0,100),(50,100),(50,0),(0,50),(100,50),(150,0),(100,0),
(0,0),(0,50),(150,50),(50,50),(50,0),(0,0),(0,100),(50,100),(150,150),(150,100),(100,50),(100,0),(50,0),(0,0),(0,100),(100,100),(100,150),(100,200),(0,150));
var
form1: Tform1;puzzle:
array [0..9]
of tpuzzel;nummer:byte; breite,Hoehe,links,
oben:Tmyarray;
implementation
{$R *.dfm}
procedure Tform1.FormCreate(Sender: TObject);
var i:byte;
begin
nummer:=0;schritte:=0;edit1.Text:='
1000';
for i:=1
to 9
do breite[i]:=100;
for i:=4
to 7
do breite[i]:=breite[1]
div 2;
for i:=2
to 9
do hoehe[i]:=breite[1]
div 2;
for i:=6
to 7
do hoehe[i]:=breite[1]; hoehe[1]:=breite[1];
for i:=2
to 3
do links[i]:=breite[1];
for i:=8
to 9
do links[i]:=breite[1];
links[1]:=0;links[4]:=0;links[6]:=0;links[5]:=breite[1]
div 2;
links[7]:=links[5];oben[1]:=0;
for i:=2
to 3
do oben[i]:=(breite[1]
div 2)*(i-2);
for i:=4
to 5
do oben[i]:=breite[1];
for i:=6
to 7
do oben[i]:=breite[1]+ breite[1]
div 2;
oben[8]:=oben[6];oben[9]:=oben[6]+ breite[1]
div 2;
for i:=1
to 9
do puzzle[i]:=Tpuzzel.Create(self);
end;
procedure Tpuzzel.MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var z,s:byte;
begin
inherited MouseDown(Button, Shift, X, Y);
FRelPosX := X;FRelPosY := Y;
faltleft:=left;falttop:=top;
for z :=round(int(top/50)+1)
to round(int((top+height)/50))
do
for s:=round(int(left/50))+1
to round(int((left+width)/50))
do
form1.stringgrid1.cells[s-1,z-1]:='
';
//format('%d %d %d %d',[round(int(left/50))+1,round(int(top/50))+1,round(int((left+width)/50)),round(int((top+height)/50))]);
end;
procedure Tpuzzel.MouseMove(Shift: TShiftState;X, Y: Integer);
var spiel:integer;
begin
inherited MouseMove(Shift, X, Y);
if (ssLeft
in Shift)
and (left>=-10)
and ( top+height <=260)
and (left+width<=210)
and (top>=-10)
then
begin
SetBounds(Left+X-FRelPosX, Top+Y-FRelPosY,Width, Height);bringtofront;
end;
end;
procedure Tpuzzel.MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var rasterx,s,z:integer;noregel:boolean;
begin
inherited MouseUp(Button, Shift, X, Y);
rasterx:=50;inc(form1.schritte);
form1.Label1.caption:=inttostr(form1.schritte);
left:=round(left/rasterx)*rasterx;top:=round(top /rasterx)*rasterx;
//showmessage(format('%d %d %d %d',[round(int(left/50))+1,round(int(top/50))+1,round(int((left+width)/50)),round(int((top+height)/50))]));
noregel:=false;
for z :=round(int(top/50)+1)
to round(int((top+height)/50))
do
for s:=round(int(left/50))+1
to round(int((left+width)/50))
do
if form1.stringgrid1.cells[s-1,z-1]<>'
'
then begin noregel:=true;
end;
if noregel =false
then
for z :=round(int(top/50)+1)
to round(int((top+height)/50))
do
for s:=round(int(left/50))+1
to round(int((left+width)/50))
do
begin
form1.stringgrid1.cells[s-1,z-1]:=format('
%d %d %d %d',[round(int(left/50))+1,round(int(top/50))+1,
round(int((left+width)/50)),round(int((top+height)/50))]);
SetBounds(Left, Top,width, Height);bringtofront;
end
else
begin
for z :=round(int(Falttop/50)+1)
to round(int((Falttop+height)/50))
do
for s:=round(int(Faltleft/50))+1
to round(int((Faltleft+width)/50))
do
form1.stringgrid1.cells[s-1,z-1]:=format('
%d %d %d %d',[round(int(Faltleft/50))+1,round(int(Falttop/50))+1,
round(int((Faltleft+width)/50)),round(int((Falttop+height)/50))]);
SetBounds(FaltLeft, FaltTop,width, Height);bringtofront;
end;
if form1.stringgrid1.cells[0,4]='
1 4 2 5'
then
showmessage('
Du hasst es in '+inttostr(form1.schritte)+'
Schritten'+'
geschaft');
end;
constructor Tpuzzel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if nummer>=9
then nummer:=0;inc(nummer);tag:=nummer;
caption:=inttostr(tag);width:=breite[tag];height:=hoehe[tag];
left:=links[tag];top:=oben[tag];cursor:=CrhandPoint;bevelwidth:=4;
repeat color:=random($FFFFFF);
until color <> clblack;
self.parent:=form1;
end;
procedure Tform1.NeuerVersuchClick(Sender: TObject);
var i,z,s:byte;
begin
schritte:=0;form1.Label1.caption:='
0 ';
for i:=1
to 9
do begin puzzle[i].Free;puzzle[i]:=Tpuzzel.Create(self);
end;
for z:=0
to 4
do for s:=0
to 3
do
stringgrid1.cells[s,z]:='
**';
stringgrid1.cells[3,2]:='
';stringgrid1.cells[2,2]:='
';
end;
procedure Tform1.BeendenClick(Sender: TObject);
var i:byte;
begin for i:=1
to 9
do
puzzle[i].Free;
close;
end;
procedure Tform1.LoesungZeigenClick(Sender: TObject);
var i:byte;
begin
neuerVersuchClick(Sender);
for i:=1
to 59
do
begin
puzzle[klotznr[i]].Left:=lageLeftTop[i,1];
puzzle[klotznr[i]].top:=lageLeftTop[i,2];
label1.Caption:=inttostr(i);
application.ProcessMessages;
sleep(strtoint(edit1.text));
end;
end;
procedure Tform1.FormActivate(Sender: TObject);
var skizze:trect;s,z:integer;
begin
refresh;
skizze:=rect(220,0,420,250);
canvas.Brush.Color:=clwhite;
canvas.FillRect(skizze);
skizze:=rect(220,150,320,250);
canvas.Brush.Color:=clred;
canvas.FillRect(skizze);
canvas.TextOut(270,200,'
1');
for z:=0
to 4
do for s:=0
to 3
do
stringgrid1.cells[s,z]:='
**';
stringgrid1.cells[3,2]:='
';stringgrid1.cells[2,2]:='
';
end;
procedure Tform1.SpeichernClick(Sender: TObject);
var f:textfile;
begin
Name:=edit2.text;
assignfile(f,'
Higscore');
append(f);
writeln(f,
Name,'
',datetimetostr(now),'
',Label1.caption);
closefile(f);
end;
procedure Tform1.HigscoreClick(Sender: TObject);
begin
Memo1.lines.LoadFromFile('
Higscore');
//showmessage(memo1.Lines[memo1.Lines.count-1]);
end;
end.