Ovládate pajáca šípkami po prírode

Kategórie: KMP (Programy mladých programátorů)
Autor: Gabriel Staroň
Program: Pohyb.pas
Soubor exe: Pohyb.exe
Potřebné: Egavga.bgi

{ POHYB.PAS                                                         }
{                                                                   }
{ Author: Gabriel Staron                                            }
{ Date  : 15.02.1997                           http://www.trsek.com }
 
program Pohyb_pajaca;
uses crt,graph;
var gr,gd : integer;
    p : pointer;
    size :word;
    i : integer;
    ch : char;
begin
 gd:=detect;              {zisti graficku kartu}
 initgraph(gd,gr,'');
 line(0,300,100,220);
 line(100,220,160,295);   {1.kopec}
 line(160,295,270,230);
 line(270,230,330,280);   {2.kopec}
 line(330,280,470,140);
 line(470,140,620,280);   {3.kopec}
 line(620,280,640,260);   {zac.4.kopca}
 line(117,240,230,160);
 line(230,160,390,220);   {zadny 1.kopec}
 line(320,193,500,100);
 line(500,100,640,170);
 setcolor(white);
 circle(600,400,10);      {hlava}
 line(600,410,600,450);   {trup}
 line(600,450,580,470);   {noha1}
 line(600,450,620,470);   {noha2}
 line(580,420,620,420);   {ruky}
 setfillstyle(1,brown);   {vyfarbenie prvych kopcov na hnedo}
 floodfill(10,470,white);
 setfillstyle(1,cyan);    {---II----- oblohy na svetlo modro}
 floodfill(200,10,white);
 setfillstyle(1,darkgray);   {--II--- 1.zadneho kopca na tmavo sivo}
 floodfill(200,200,white);
 setfillstyle(1,white);      {---II-- 2.zadneho kopca na bielo}
 floodfill(400,200,white);
 setfillstyle(1,yellow);     {---II-- slnka na zlto}
 floodfill(50,50,cyan);
 setfillstyle(1,brown);      {vyfarbenie hlavy pajaca na hnedo}
 floodfill(600,400,white);
 size:=imagesize(570,390,620,470);      {velkost obrazka pajaca}
 getmem(p,size);                        {vyhradi miesto v pamati pre obrazok pajaca}
 getimage(570,390,620,470,p^);          {odlozi do pamate obrazok pajaca}
 outtextxy(10,50,'Ovladanie pajaca sipkami');
 
 repeat
 ch:=readkey;                           {nacita klaves z klavasnice}
 if (ch=#0) then begin
    ch:=readkey;
    if (ch='H') then begin
                   putimage(570,340,p^,normalput);      {ked klaves sipka dole, tak vykresli obrazok hore}
                   setcolor(brown);
                   circle(600,400,10);      {hlava}
                   line(600,410,600,450);   {trup}
                   line(600,450,580,470);   {noha1}
                   line(600,450,620,470);   {noha2}
                   line(580,420,620,420);   {ruky}
                  end;
    if (ch='K') then begin
                   putimage(520,390,p^,normalput);      {ked sipka vlavo, tak vykresli obrazok vlavo}
                   setcolor(brown);
                   circle(600,400,10);      {hlava}
                   line(600,410,600,450);   {trup}
                   line(600,450,580,470);   {noha1}
                   line(600,450,620,470);   {noha2}
                   line(580,420,620,420);   {ruky}
                  end;
    if (ch='P') then begin
                   putimage(570,440,p^,normalput);      {ked sipka dole, tak vykresli obrazok dole}
                   setcolor(brown);
                   circle(600,400,10);      {hlava}
                   line(600,410,600,450);   {trup}
                   line(600,450,580,470);   {noha1}
                   line(600,450,620,470);   {noha2}
                   line(580,420,620,420);   {ruky}
                  end;
    if (ch='M') then begin
                   putimage(600,390,p^,normalput);      {ked sipka vpravo, tak vykresli obrazok vpravo}
                   setcolor(brown);
                   circle(600,400,10);      {hlava}
                   line(600,410,600,450);   {trup}
                   line(600,450,580,470);   {noha1}
                   line(600,450,620,470);   {noha2}
                   line(580,420,620,420);   {ruky}
                  end;
   end;
 until (ch=#27);                                       {opakuj pokial nestisne klaves}
 
 closegraph;        				       {uzatvor pracu s grafikou}
end.						       {koniec programu}