Grafická strieľačka

Kategorija: KMP (Programy mladňakoch

Zrobil: Ivan Dimov
Program: T-stynet.pas
Subor exe: T-stynet.exe
Mušiš mac: Egavga.bgi

{ T-STYNET.PAS                                                      }
{                                                                   }
{ Author: Ivan Dimov                                                }
{ Date  : 15.02.1997                           http://www.trsek.com }
 
program skynet_terminator;
uses crt,dos,graph;
var
   gr,gd,m,n,xm,ym,but,xp,yp,xb,yb,q,xa,ya:integer;
   ch:char;
   size:word;
   p,r:pointer;
   label 1;
procedure sorry;
begin
 settextstyle(3,0,3);
 setcolor(5);
outtextxy(300,400,'SORRY JE TO IBA DEMO');
delay(1000);
setfillstyle(1,0);
bar(295,395,640,480);
end;
procedure menu;
 
begin
cleardevice;
setcolor(blue);
line(1,1,640,1);
line(1,1,1,50);
line(1,50,640,50);
line(640,50,640,1);
line(640,1,640,50);
line(3,3,637,3);
line(3,3,3,47);
line(3,47,637,47);
line(637,47,637,3);
line(637,3,3,3);
line(639,1,639,50);
line(1,1,3,3);
line(639,1,637,3);
line(1,50,3,47);
line(639,50,637,47);
line(150,3,150,47);
line(300,3,300,47);
line(450,3,450,47);
line(600,3,600,47);
setfillstyle(1,6);
{floodfill(4,5,blue);}
setfillstyle(1,5);
lowvideo;
{floodfill(2,4,blue);
floodfill(5,2,blue);
floodfill(5,49,blue);
floodfill(638,3,blue);}
setfillstyle(1,6);
floodfill(200,10,blue);
floodfill(350,10,blue);
floodfill(500,10,blue);
floodfill(630,10,blue);
setcolor(2);
settextstyle(1,0,2);
outtextxy(10,9,'START GAME');
outtextxy(160,9,'LOAD GAME');
outtextxy(310,9,'SAVE GAME');
outtextxy(480,9,'QUIT GAME');
randomize;
 
{ setcolor(random(15));
  settextstyle(random(6),0,random(7));
  outtextxy(random(344),random(200),'SkyNET');}
end;
 
function gminit:boolean;    {zisti ovladac mysi}
var reg:registers;
begin
 reg.ax:=$0000;
 intr($33,reg);
 if reg.ax=$0000 then gminit:=false
                 else gminit:=true;
 but:=reg.bx;
end;
procedure zobraz_mys;          {Zobrazi mys}
var reg:registers;
begin
 reg.ax:=$0001;
 intr($33,reg);
end;
 
procedure skryj_mys;          {Zobrazi mys}
var reg:registers;
begin
 reg.ax:=$0002;
 intr($33,reg);
end;
procedure test_mys(var x,y,but:integer);  {Otestuje mys}
var reg:registers;
begin
 reg.ax:=$0003;
 intr($33,reg);
 x:=reg.cx;
 y:=reg.dx;
 but:=reg.bx;
end;
 
procedure demo1;
 begin
   cleardevice;
   settextstyle(3,0,7);
  m:=1;
  n:=1;
  repeat
   setcolor(red);
   outtextxy(m,n,'Dimov soft.');
   delay(50);
   cleardevice;
   m:=m+20;
   n:=n+15;
  until (m>450);
 end;
 procedure vybuch;
 var a,b:integer;
 begin
  setcolor(red);
  for a:=1 to 15 do
   circle(xa,ya,a);
 
 end;
 procedure demo2;
  var m,n:integer;
   begin
  cleardevice;
  setcolor(7);
  outtextxy(220,200,'Programing Ivan Dimov');
  delay(1200);
  cleardevice;
  end;
  procedure demo3;
var p,r:pointer;
    size:word;
    a,b:integer;
begin
   cleardevice;
   nosound;
   setcolor(13);
   settextstyle(3,0,8);
 
   outtextxy(100,100,'BETHESDA');
size:=imagesize(90,100,470,200);
getmem(p,size);
getimage(90,100,470,200,p^);
{bar(90,100,470,200);}
cleardevice;
   settextstyle(3,0,8);
      setcolor(13);
  outtextxy(100,300,'SOFTWORKS  ');
size:=imagesize(90,290,470,440);
getmem(r,size);
getimage(90,290,560,430,r^);
cleardevice;
{bar(90,290,560,430);}
setcolor(5);
for a:=1 to 150 do begin putimage(a,100,p^,normalput);
 end;
   for b:=700 downto 120 do begin putimage(b,250,r^,normalput);
    end;
delay(1000);
cleardevice;
 settextstyle(6,0,9);outtextxy(55,100,'The');sound(45);delay(476);nosound;  delay(1000);outtextxy(200,100,'Terminator');
 sound(56);delay(465);nosound;
 delay(1000);setcolor(red); outtextxy(200,300,'SkyNET');sound(76); delay(754);nosound;
delay(1500);
cleardevice;
end;
procedure time;
var a:integer;
begin
cleardevice;
 
 for a:=1 to 320 do begin
 setcolor(red);
 circle(320,240,a);
  end;
 
end;
procedure game;
begin
skryj_mys;
line(100,100,100,160);
 
line(100,160,120,160);
line(120,160,120,100);
arc(110,100,0,180,10);
arc(110,105,0,180,5);
line(105,105,105,130);
line(115,105,115,130);
arc(108,130,180,270,4);
line(108,134,125,134);
line(115,128,125,128);
line(125,128,125,134);
circle(110,75,15);
line(100,160,102,225);
line(102,225,118,225);
line(118,225,120,160);
{zbran}
line(125,128,127,125);
line(127,125,145,125);
line(145,125,145,128);
line(145,128,132,129);
line(132,129,129,135);
line(129,135,125,134);
{topanky}
line(102,225,102,230);
line(102,230,130,230);
line(130,230,130,228);
line(130,228,118,225);
{tvar}
{x=110,y=75,r=15}
circle(118,72,2);
line(123,79,115,77);
line(115,77,122,82);
setfillstyle(1,6);
floodfill(110,75,2);
setfillstyle(1,4);
floodfill(118,72,2);
setfillstyle(1,8);
floodfill(105,100,2);
floodfill(107,108,2);
floodfill(124,129,2);
setfillstyle(1,9);
floodfill(126,129,2);
setfillstyle(1,3);
floodfill(108,220,2);
{bar(95,60,145,240);}
size:=imagesize(90,55,150,240);
getmem(p,size);
getimage(90,55,150,240,p^);
setcolor(2);
circle(500,100,30);
circle(490,90,2);
circle(510,90,2);
setfillstyle(1,yellow);
floodfill(500,100,2);
setfillstyle(1,red);
floodfill(490,90,2);
floodfill(510,90,2);
arc(500,120,0,180,8);
size:=imagesize(460,60,540,140);
{bar(465,65,535,135);}
getmem(r,size);
getimage(460,60,540,140,r^);
cleardevice;
xp:=1;
yp:=1;
xb:=500;
yb:=100;
repeat
setcolor(0);
bar(xb+460,yb+60,xb+540,yb+140);
bar(500,1,640,480);
q:=random(6);
if (q=6) then yb:=yb+5;                          {pohyb lode a podmienky}
if (yb>=420) then yb:=420;
if (q=2) then yb:=yb-5;
if (yb<=1) then yb:=1;
if (q=3) then yb:=yb;
if (q=4) then yb:=yb+5;
if (yb>=420) then yb:=420;
if (q=5) then yb:=yb;
if (q=0) then yb:=yb-5;
if (yb<=1) then yb:=1;
putimage(xb+10,yb+50,r^,normalput);
 if (q=1) then begin
  setcolor(14);
  line(xb,yb+90,xb-500,yb+90);
  line(xb,yb+91,xb-500,yb+91);
  line(xb,yb+92,xb-500,yb+92);
sound(500);
delay(50);
nosound;
setcolor(0);                                 {zmaz strelu}
line(xb,yb+90,xb-500,yb+90);
line(xb,yb+91,xb-500,yb+91);
line(xb,yb+92,xb-500,yb+92);
end;
 
 
    if (ch=#13) then begin                               {strela}
      sound(150);
      delay(500);
      nosound;
      setcolor(white);                                  {vykresli strelu}
      line(xp+80,yp+123,xp+180,yp+123);
      delay(100);
 
      xa:=xp+180;ya:=yp+123;
      if  (getpixel(xp+80,yp+122)<>0)then vybuch;
      if  (getpixel(xp+180,yp+122)<>0)then vybuch;
      if  (getpixel(xp+130,yp+122)<>0)then vybuch;
      setcolor(black);                                  {zmaz strelu}
      line(xp+80,yp+123,xp+180,yp+123);
      delay(100);
      setcolor(white);
      line(xp+180,yp+123,xp+280,yp+123);
      delay(100);
      xa:=xp+280;ya:=yp+123;
      if  (getpixel(xp+180,yp+122)<>0)then vybuch;
      if  (getpixel(xp+280,yp+122)<>0)then vybuch;
      if  (getpixel(xp+230,yp+122)<>0)then vybuch;
      setcolor(black);
      line(xp+180,yp+123,xp+280,yp+123);
      delay(100);
      setcolor(white);
      line(xp+280,yp+123,xp+380,yp+123);
      delay(100);
      xa:=xp+380;ya:=yp+123;
      if  (getpixel(xp+280,yp+122)<>0)then vybuch;
      if  (getpixel(xp+380,yp+122)<>0)then vybuch;
      if  (getpixel(xp+330,yp+122)<>0)then vybuch;
      setcolor(black);
      line(xp+280,yp+123,xp+380,yp+123);
      delay(100);
      setcolor(white);
      line(xp+380,yp+123,xp+480,yp+123);
      delay(100);
      xa:=xp+480;ya:=yp+123;
      if  (getpixel(xp+380,yp+122)<>0)then vybuch;
      if  (getpixel(xp+480,yp+122)<>0)then vybuch;
      if  (getpixel(xp+430,yp+122)<>0)then vybuch;
      setcolor(black);
      line(xp+380,yp+123,xp+480,yp+123);
      delay(100);
      setcolor(white);
      line(xp+480,yp+123,xp+580,yp+123);
      delay(100);
      xa:=xp+580;ya:=yp+123;
      if  (getpixel(xp+480,yp+122)<>0)then vybuch;
      if  (getpixel(xp+580,yp+122)<>0)then vybuch;
      if  (getpixel(xp+530,yp+122)<>0)then vybuch;
      setcolor(black);
      line(xp+480,yp+123,xp+580,yp+123);
      delay(100);
      setcolor(white);
      line(xp+580,yp+123,xp+680,yp+123);
      delay(100);
      xa:=xp+680;ya:=yp+123;
      if  (getpixel(xp+580,yp+122)<>0)then vybuch;
      if  (getpixel(xp+680,yp+122)<>0)then vybuch;
      if  (getpixel(xp+630,yp+122)<>0)then vybuch;
      setcolor(black);
      line(xp+580,yp+123,xp+680,yp+123);
      delay(100);
     end;
 
 setfillstyle(1,0);
 setcolor(0);
 putimage(xp+10,yp+50,p^,normalput);
 {bar(x+95,y+60,x+145,y+240);}
 ch:=readkey;
  if (ch=#0) then begin
  bar(xp+90,yp+55,xp+150,yp+240);
  ch:=readkey;
  if (ch='K') then xp:=xp-5;
  if (ch='M') then xp:=xp+5;
  if (ch='H') then yp:=yp-5;
  if (ch='P') then yp:=yp+5;
  end;
 until (ch=#27);
 menu;
 zobraz_mys;
 end;
 
 procedure pause;
  begin
   settextstyle(1,0,2);
    setcolor(15);
    outtextxy(300,440,'Press any key...');
   repeat until keypressed;
   ch:=readkey;
 end;
BEGIN
 gr:=detect;
 initgraph(gr,gd,'');
 randomize;
  demo1;
  time;
  pause;
{  demo2;
  time;
  pause;}
  cleardevice;{
  demo3;
  time; }
  menu;
  if not(gminit) then outtextxy(100,400,'Nemas nainstalovany ovladac na mys.');
  zobraz_mys;
 repeat
    test_mys(xm,ym,but);                  {testuje mys}
  if ((xm>1) and (xm<150) and (ym>1) and (ym<50) and (but=1)) then game;
 
 { if ((xm>1) and (xm<15) and (ym>1) and (ym<30) and (but=2)) then FileMenu(0);}
 
  if ((xm>151) and (xm<300) and (ym>1) and (ym<50) and (but=1)) then sorry;
 
{  if ((xm>90) and (xm<180) and (ym>1) and (ym<30) and (but=2)) then GameMenu(0);}
 
  if ((xm>301) and (xm<450) and (ym>1) and (ym<50) and (but=1)) then sorry;
 
  if ((xm>451) and (xm<600) and (ym>1) and (ym<50) and (but=1)) then goto 1;
  until ((ch=#27) and (but=2));
 
 
1:
closegraph;
END.