HAD – Pascal – Fórum – Programujte.com
 x   TIP: Přetáhni ikonu na hlavní panel pro připnutí webu
Reklama
Reklama

HAD – Pascal – Fórum – Programujte.comHAD – Pascal – Fórum – Programujte.com

 

Hledá se programátor! Plat 1 800 € + bonusy (firma Boxmol.com)
Petr
~ Anonymní uživatel
696 příspěvků
18. 6. 2015   #1
-
0
-

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.
Nahlásit jako SPAM
IP: 80.243.105.–
Reklama
Reklama
Mircosoft+1
Věrný člen
18. 6. 2015   #2
-
0
-

Jestli to dobře chápu, tak jediná věc, kterou při vyjetí z obrazovky nebo kousnutí do hada děláš, je timer1.enabled:=false, což je jenom zapnutí nekonečné pauzy a ne game over.

Nahlásit jako SPAM
IP: 94.113.255.–
Chceš-li lepší odpověď, polož lepší otázku.
Moje stránka.
peter
~ Anonymní uživatel
2533 příspěvků
18. 6. 2015   #3
-
0
-

Vidim to na dve moznosti:
- mas podminky spatne, sprav si je
- mrkni, jestli treba neulozis polohu mimo herni desku a podle te nove polohy se nepokousis najit objekty mimo herni desku, cili mimo rozsah pole. Mas treba pole 60x30, a kdyz ti nova poloha vyjde 61,30, tak jsi mimo rozsah, error a kdo vi, co packal/delphi udela.

Pripada mi teda dost zvlastni, ze tam nemas definovanou sirku, vysku hada, top, left polohu herni desky a tyhle udaje vubec nepouzivas pro podminky.
Ja bych si teda udelal spesl funkci, ktera by mi vracela pole se seznam true/false pro zadanou polohu x,y.
* mimo desku, kde a.x a.y b.x b.y, kamen (a je horni levy roh obdelniku, ten je 0+left,0+top; b je spodni pravy roh maxx+left, maxy+top)
* true, false, true, true, false, false - ses mimo desku, prekrocil jsi na a.y a b.x (y je tedy < 0, x je > nez maxx), a nesnedl jsi pritom zadny kamen

Kdyz to budes mit pekne v jedne funkci (v delphi se to mozna oznacuje take procedura), tak to nemusis resit pak na deseti 10 mistech programu.

Mimochodem, nemas tam pouzite if/else, jen if. coz by mohl byt dalsi problem.

Nahlásit jako SPAM
IP: 2001:718:2601:1f7:658e:8b...–
Petr
~ Anonymní uživatel
696 příspěvků
22. 6. 2015   #4
-
0
-

#2 Mircosoft
Takže jak by jsi to opravil ty? Nejsem moc dobrej programátor, půlka zdrojáku je stažená a druhou jsem nějak vymyslel já :D 

Nahlásit jako SPAM
IP: 80.243.105.–
Mircosoft+1
Věrný člen
25. 6. 2015   #5
-
0
-

#4 Petr

Ze všeho nejdřív bych přidal příkaz hra:=false, aby začala fungovat TForm1.Image1MouseDown. Potom bych vypsal nějakou hlášku, aby bylo jasné, že hra skončila. Ale nevím, jestli by se tím vyřešilo všechno - až tak dobře tomu programu nerozumím.

Nahlásit jako SPAM
IP: 94.113.255.–
Chceš-li lepší odpověď, polož lepší otázku.
Moje stránka.
Zjistit počet nových příspěvků

Přidej příspěvek

Toto téma je starší jak čtvrt roku – přidej svůj příspěvek jen tehdy, máš-li k tématu opravdu co říct!

Ano, opravdu chci reagovat → zobrazí formulář pro přidání příspěvku

×Vložení zdrojáku

×Vložení obrázku

Vložit URL obrázku Vybrat obrázek na disku
Vlož URL adresu obrázku:
Klikni a vyber obrázek z počítače:

×Vložení videa

Aktuálně jsou podporována videa ze serverů YouTube, Vimeo a Dailymotion.
×
 
Podporujeme Gravatara.
Zadej URL adresu Avatara (40 x 40 px) nebo emailovou adresu pro použití Gravatara.
Email nikam neukládáme, po získání Gravatara je zahozen.
-
Pravidla pro psaní příspěvků, používej diakritiku. ENTER pro nový odstavec, SHIFT + ENTER pro nový řádek.
Sledovat nové příspěvky (pouze pro přihlášené)
Sleduj vlákno a v případě přidání nového příspěvku o tom budeš vědět mezi prvními.
Reaguješ na příspěvek:

Uživatelé prohlížející si toto vlákno

Uživatelé on-line: 0 registrovaných, 12 hostů

Podobná vlákna

Hackerská hádanka — založil yaqwsx

Hadici — založil vestax

Program na "hádání" — založil jumbo

Moderátoři diskuze

 

Hostujeme u Českého hostingu       ISSN 1801-1586       ⇡ Nahoru Webtea.cz logo © 20032016 Programujte.com
Zasadilo a pěstuje Webtea.cz, šéfredaktor Lukáš Churý