Ahoj, mám problém s hadem :D ....Když mi had vyjede mimo herní plochu, tak se mi hra zasekne a nic nedělá. Nespadne.. prostě nic nedělá. Jak to opravit?
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, LCLIntf, LCLType;
type
{ TForm1 }
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure Image1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
hodnoty:array[1..100] of integer;
meno:array [1..100] of string;
highscore:Textfile;
hrap,pozadi,apple,hvezda,pozadi2:Tbitmap;
score,i,x,y,delka,smer,apx,apy,cas,korist,uroven,body,a,pocet,pom,j:integer;
hadX:array[1..1000] of integer ;
hadY:array[1..1000] of integer ;
jidlo,hvizda,space,hra,sc:boolean;
s,m:string;
implementation
{$R *.lfm}
function kontrola:boolean;
var a:integer;
begin result:=false;a:=0;
case smer of
1: begin
for i:=2 to delka do
if (hadx[1]-20=hadx[i]) and (hady[1]=hady[i]) then inc(a);
end;
2:begin
for i:=2 to delka do
if (hadx[1]=hadx[i]) and (hady[1]-20=hady[i]) then inc(a);
end;
3:begin
for i:=2 to delka do
if (hadx[1]+20=hadx[i]) and (hady[1]=hady[i]) then inc(a);
end;
4:begin
for i:=2 to delka do
if (hadx[1]=hadx[i])and (hady[1]+20=hady[i]) then inc(a);
end;
end;
if a>0 then result:=true;
end;
procedure start;
begin
i:=0;form1.Image1.Canvas.Font.name:='arial';
form1.Image1.Canvas.Font.Height:=230;form1.Image1.Canvas.Font.color:=clblack;
form1.image1.Canvas.Brush.Color:=RGB(29,142,235);
//odstartovanie hry 3 2 1 go
if i=0 then begin
form1.Image1.Canvas.textout(300,60,'3');
inc(i);application.ProcessMessages;sleep(1000);
form1.image1.Canvas.Draw(-1,-1,hrap);
form1.image1.Canvas.Rectangle(50,50,750,450);
end;
if i=1 then begin
form1.Image1.Canvas.textout(300,60,'2');
inc(i);application.ProcessMessages;sleep(1000);
form1.image1.Canvas.Draw(-1,-1,hrap);
form1.image1.Canvas.Rectangle(50,50,750,450);
end;
if i=2 then begin
form1.Image1.Canvas.textout(300,60,'1');
inc(i);application.ProcessMessages;sleep(1000);
form1.image1.Canvas.Draw(-1,-1,hrap);
form1.image1.Canvas.Rectangle(50,50,750,450);
end;
if i=3 then begin
form1.Image1.Canvas.textout(100,60,'GO!');
inc(i);application.ProcessMessages;sleep(1000);
form1.image1.Canvas.Draw(-1,-1,hrap);
form1.image1.Canvas.Rectangle(50,50,750,450);
end;
end;
procedure telo;
//nastavovani souradnic hada
var x,y,a,b:integer;
begin
a:=hadx[1];b:=hady[1];
case smer of
1:dec(hadx[1],20);
2:dec(hady[1],20);
3:inc(hadx[1],20);
4:inc(hady[1],20);
end;
for i:= 2 to delka do
begin
x:=hadx[i];y:=hady[i];
hadx[i]:=a;hady[i]:=b;
a:=x;b:=y;
end;
end;
procedure had;
begin
//vykresleni hada
if hra then begin
form1.image1.Canvas.pen.Color:=rgb(29,142,235);
form1.Image1.Canvas.Brush.Color:=clblack;
form1.Image1.Canvas.pen.Width:=0;
for i:=1 to delka do
form1.Image1.canvas.Rectangle(hadx[i],hady[i],hadx[i]+20,hady[i]+20);
end;
end;
procedure novahra;
begin
//inicializace
hadx[1]:=620;hady[1]:=300; hadx[2]:=640;hady[2]:=300;hadx[3]:=660;hady[3]:=300;
form1.image1.Canvas.Draw(-1,-1,hrap);form1.Image1.Canvas.pen.Width:=4; form1.image1.Canvas.Pen.color:=clblack;
form1.image1.Canvas.Brush.Color:=rgb(29,142,235); form1.image1.Canvas.Rectangle(50,50,750,450);
start; score:=0;delka:=3; smer:=1; space:=false; cas:=10000; korist:=0; hvizda:=false;jidlo:=false;
form1.timer1.Enabled:=true; hra:=true;
end;
{ TForm1 }
procedure TForm1.Timer1Timer(Sender: TObject);
begin
image1.Canvas.Draw(-1,-1,hrap);//kresleni obrazku
form1.Image1.Canvas.pen.Width:=4;//sirka pera
image1.Canvas.Pen.color:=clblack;//barva
image1.Canvas.Brush.Color:=rgb(29,142,235);//vypln barva
image1.Canvas.Rectangle(50,50,750,450);
image1.Canvas.Brush.Color:=rgb(40,40,40);
while (jidlo=false) do
begin
//nahodne souradnice pro jablko
apx:=random(34);apy:=random(19);a:=0;
for i:=1 to delka do
if (apx*20+60=hadx[i]) and (apy*20+60=hady[i]) then inc(a);
if a=0 then begin inc(korist); jidlo:=true; end;
end;
//pokud had snedl uz 4. jablko dostane hvezdu za vic bodu
if ((korist) mod 5 =0) then begin
Image1.canvas.Draw(apx*20+60,apy*20+60,hvezda) ;
hvizda:=true;
end
//vykresleni jablka
else Image1.canvas.Draw(apx*20+60,apy*20+60,apple);
//velkost pisma
Image1.Canvas.Font.Height:=15; image1.canvas.Font.Color:=cllime;
//ak narazil na hviezdu dostane viac bodov podla jeho casu
if hvizda=true then begin
dec(cas,timer1.Interval);
image1.canvas.TextOut(570,481,'Rychlo uz len '+inttostr(cas div 1000)+ ' sekund' );
end;
//ak nestihol chytit hviezdu dostane zase jablko
if (cas<timer1.Interval) and (hvizda) then begin
jidlo:=false;
inc(korist);
hvizda:=false;cas:=10000;
end ;
//vypis score a delka hada
image1.canvas.TextOut(570,450,'Tvoje score je '+inttostr(score));
image1.canvas.TextOut(570,465,'delka '+inttostr(delka));
case uroven of
1:image1.canvas.TextOut(630,465,'Uroven UŽOVKA ');
2:image1.canvas.TextOut(630,465,'Uroven KOBRA');
3:image1.canvas.TextOut(630,465,'Uroven PYTON');end;
if (kontrola) then begin timer1.enabled:=false;
end;
case smer of
1:begin
telo;had;
end;
2:begin
telo;had;
end;
3:begin
telo;had;
end;
4:begin
telo;had;
end;
end;
//ak narazil gameover
if (hadx[1]<60) or (hadx[1]>720) or (hady[1]<60) or (hady[1]>420) then begin timer1.enabled:=false; end;
if ((hadx[1]=apx*20+60)and(hady[1]=apy*20+60)) then begin
if hvizda then begin
hvizda:=false;
inc(score,cas div 100);
cas:=10000;jidlo:=false;
inc(delka);
end
else begin
inc(delka);inc(score,body);
jidlo:=false;
end;
end;
end;
procedure TForm1.Image1Click(Sender: TObject);
begin
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (shift=[ssleft])then begin
if (x>65) and(x<240)and(y>409)and(y<440)and (hra=false)and (sc=false) then begin
uroven:=1;body:=5;//nastaveni urovne a bodu
timer1.interval:=200;//rychlost pohybu hada
novahra;
end;
if (x>340) and(x<490)and(y>409)and(y<440)and (hra=false)and (sc=false) then begin
uroven:=2;//nastaveni urovne a bodu
timer1.interval:=110; body:=8;//rychlost pohybu hada
novahra;
end;
if (x>570) and(x<725)and(y>409)and(y<440) and (hra=false)and (sc=false) then begin
uroven:=3;//nastavenie urvone a bodov
timer1.interval:=80; body:=10;//rychlost pohybu hada
novahra;
end;
//ukoncenie hry
if (x>590) and(x<640)and(y>460)and(y<480)and (hra=false)and (sc=false) then close;
//high score
if (x>60) and(x<215)and(y>460)and(y<480)and (hra=false)and (sc=false) then begin
i:=0;image1.Canvas.Draw(-1,-1,pozadi2);//nove pozadi
//otvorenie suboru
assignfile(highscore,'high score.txt');reset(highscore);
//nastaveni fontu a barev
image1.canvas.Font.Height:=45;image1.Canvas.Font.Color:=rgb(23,54,93);
image1.Canvas.Brush.Style:=bsClear; sc:=true;
image1.canvas.TextOut(350,20,'TOP 10');//vypis textu
for i:=1 to 10 do
begin
s:='';
readln(highscore,s);
image1.canvas.TextOut(20,40*i,copy(s,1,pos(' ',s)));//vypis riadka
image1.canvas.TextOut(600,40*i,copy(s,pos(' ',s)+1,maxint));
end;
closefile(highscore);
image1.Canvas.TextOut(20,440,'MENU');
image1.Canvas.TextOut(600,440,'QUIT');
end;
if (x>20) and(x<150)and(y>440)and(y<480)and (hra=false) and(sc) then
begin
image1.canvas.Draw(-1,-1,pozadi);sc:=false;
end;
if (x>600) and(x<680)and(y>440)and(y<480)and (hra=false) and(sc) then close;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
randomize; //inicializacia nahodnych cisel
hra:=false; //hra nebezi
sc:=false;
apple:=tbitmap.create;apple.loadfromfile('apple.bmp'); //inicializacia obrazkov
apple.TransparentColor:=clgreen;apple.Transparent:=true; //nastavenie priesvitnosti
hvezda:=tbitmap.create;hvezda.loadfromfile('hvezda.bmp');
hvezda.TransparentColor:=clred;hvezda.Transparent:=true;
hrap:=tbitmap.Create;hrap.LoadFromFile('hrapozadi.bmp');
pozadi:=tbitmap.Create;pozadi.LoadFromFile('pozadi.bmp');
image1.canvas.Draw(-1,-1,pozadi);
pozadi2:=tbitmap.Create;pozadi2.LoadFromFile('pozadi2.bmp');
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
case key of
//pauza hry
vk_space:begin
//uspime nebo spustime casovac
if (space) then begin timer1.enabled:=true; space:=false; end
else if (space=false) then begin space:=true; timer1.enabled:=false;end;
end;
//odboceni doleva had musi jit dolu nebo nahoru
vk_left:if (smer=2) or (smer=4) then smer:=1;
//otoceni doprava a nastaveni smeru
vk_right: if (smer=2) or (smer=4) then smer:=3;
vk_up:if (smer=1) or (smer=3) then smer:=2;
vk_down:if (smer=1) or (smer=3) then smer:=4;
end;
end;
end.