var
Form1: TForm1;
spielfeld: array of array of array of shortint;
feldgr,haianzahl,fischanzahl,pos: integer;
fischbrut, haibrut, haitot: shortint;
//
procedure setzen();
var a,b,c,x,y,haie,fische:integer;
begin
haie:=0;
fische:=0;
randomize;
for a:=0 to feldgr-1 do
for b:= 0 to feldgr-1 do
for c:= 0 to 2 do
spielfeld[a,b,c]:=0;
repeat
x:=random(feldgr);
y:=random(feldgr);
if spielfeld[x,y,0]=0 then begin
spielfeld[x,y,0]:=1;
spielfeld[x,y,1]:=random(haibrut);
haie:=haie+1;
end;
until haie=haianzahl;
repeat
x:=random(feldgr);
y:=random(feldgr);
if spielfeld[x,y,0]=0 then begin
spielfeld[x,y,0]:=3;
spielfeld[x,y,1]:=random(fischbrut);
fische:=fische+1;
end;
until fische=fischanzahl;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
setlength(spielfeld,100,100,3);
haianzahl:=200;
fischanzahl:=1000;
feldgr:=100;
fischbrut:=8;
haibrut:=6;
haitot:=12;
pos:=0;
setzen;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var rastergr:shortint;
a,b,x,y: integer;
begin
a:=0;
b:=0;
rastergr:= PaintBox1.width div feldgr;
for x:=0 to feldgr-1 do begin
for y:= 0 to feldgr-1 do begin;
case spielfeld[x,y,0] of
0:PaintBox1.canvas.brush.color:=clblue;
1:PaintBox1.canvas.brush.color:=clred;
3:PaintBox1.canvas.brush.color:=clblack;
end;
PaintBox1.canvas.FillRect(rect(a,b,a+rastergr,b+rastergr));
a:=a+rastergr;
end;
a:=0;
b:=b+rastergr;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var richtung,art: shortint;
x,x2,y,y2,r,l,o,u: integer;
gefressen:boolean;
begin
randomize;
for x:=0 to feldgr-1 do
for y:=0 to feldgr-1 do begin
if spielfeld[x,y,0]=1 then begin //Fress-Abschitt der Prozedur
gefressen:=false;
if x=feldgr-1 then r:=0 else r:=x+1;
if x=0 then l:=feldgr-1 else l:=x-1;
if y=feldgr-1 then o:=0 else o:=y+1;
if y=0 then u:=feldgr-1 else u:=y-1;
if (spielfeld[r,y,0]=3) or (spielfeld[r,y,0]=-1) then begin
spielfeld[r,y,0]:=-1;
spielfeld[x,y,2]:=0;
gefressen:=true
end;
if (spielfeld[l,y,0]=3) or (spielfeld[l,y,0]=-1) then begin
spielfeld[l,y,0]:=-1;
spielfeld[x,y,2]:=0;
gefressen:=true;
end;
if (spielfeld[x,o,0]=3) or (spielfeld[x,o,0]=-1) then begin
spielfeld[x,o,0]:=-1;
spielfeld[x,y,2]:=0;
gefressen:=true;
end;
if (spielfeld[x,u,0]=3) or (spielfeld[x,u,0]=-1) then begin
spielfeld[x,u,0]:=-1;
spielfeld[x,y,2]:=0;
gefressen:=true;
end;
if not gefressen then begin
if spielfeld[x,y,2]=haitot then begin
spielfeld[x,y,0]:=0;
spielfeld[x,y,1]:=0;
spielfeld[x,y,2]:=0;
end;
spielfeld[x,y,2]:=spielfeld[x,y,2]+1;
end;
end; //Ende Fress-Abschnitt
//Beginn Bewegungsabschnitt
if (((spielfeld[x,y,0]=1)and (spielfeld[x,y,2]>0)) or (spielfeld[x,y,0]=3)) then begin
richtung:=random(4);
art:=spielfeld[x,y,0];
x2:=x;
y2:=y;
case richtung of
0: if x2=0 then x2:=feldgr-1 else x2:=x2-1;
1: if y2=0 then y2:=feldgr-1 else y2:=y2-1;
2: if x2=feldgr-1 then x2:=0 else x2:=x2+1;
3: if y2=feldgr-1 then y2:=0 else y2:=y2+1;
end;
if spielfeld[x2,y2,0]<1 then begin
spielfeld[x2,y2,2]:=spielfeld[x,y,2]; //Bei Haien: Zeit ohne Fressen übernehmen
if (spielfeld[x,y,1]>fischbrut-1) and (spielfeld[x,y,0]=3) then begin
spielfeld[x,y,1]:=0;
spielfeld[x2,y2,1]:=0;
spielfeld[x2,y2,2]:=0; //neu zugefügt
spielfeld[x,y,0]:=4;
end
else if (spielfeld[x,y,1]>haibrut-1) and (spielfeld[x,y,0]=1) then begin
spielfeld[x,y,1]:=0;
spielfeld[x2,y2,1]:=0;
spielfeld[x,y,0]:=2;
end
else begin
spielfeld[x2,y2,1]:=spielfeld[x,y,1]+1;
spielfeld[x,y,0]:=0; //Altes Tier löschen
spielfeld[x,y,1]:=0; //Altes Alter löschen
spielfeld[x,y,2]:=0; //Alte Zeit ohne Fressen bei Haien löschen
end;
spielfeld[x2,y2,0]:=art+1;
end
else spielfeld[x,y,0]:=art+1;
spielfeld[x,y,1]:=spielfeld[x,y,1]+1;
end
else if (spielfeld[x,y,0]=1) and (spielfeld[x,y,2]=0) then
spielfeld[x,y,0]:=2;
end; //Ende Bewegungsabschnitt
haianzahl:=0; //Beginn Zählung
fischanzahl:=0;
for x:=0 to feldgr-1 do
for y:=0 to feldgr-1 do //begin
case spielfeld[x,y,0] of
-1: spielfeld[x,y,0]:=0;
2: begin
spielfeld[x,y,0]:=1;
haianzahl:=haianzahl+1;
end;
4: begin
spielfeld[x,y,0]:=3;
fischanzahl:=fischanzahl+1;
end;
end;
//Ende Zählung
PaintBox1Paint(form1);
PaintBox2Paint(form1);
end;
procedure TForm1.PaintBox2Paint(Sender: TObject);
begin
with PaintBox2.canvas do begin
brush.color:=clwhite;
fillrect(rect(pos,PaintBox2.height,pos+1,0));
brush.color:=clblack;
fillrect(rect(pos+1,PaintBox2.height,pos+2,0));
Pixels[pos,PaintBox2.height-(haianzahl div ((feldgr*feldgr)div PaintBox2.height-1))-1]:=clred;
pixels[pos,PaintBox2.height-(fischanzahl div ((feldgr*feldgr)div PaintBox2.height-1))-1]:=clblack;
end;
pos:=pos+1;
if pos > PaintBox2.width then pos:=0;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintBox2.canvas.FillRect(rect(0,0,PaintBox2.Width,PaintBox2.height));
end;
Start Stop :
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
case timer1.enabled of
true: begin
timer1.enabled:=false;
bitbtn1.kind:=bkok;
bitbtn1.caption:='Start';
end;
false: begin
timer1.enabled:=true;
bitbtn1.kind:=bkabort;
bitbtn1.caption:='Stopp';
end;
end;
end;
Farben Mischen :
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
setzen;
PaintBox1Paint(Form1);
end;
Keine Kommentare:
Kommentar veröffentlichen