Simulátor F15 v peknej grafickej podobe ovládaný my¹ou
Delphi & Pascal (èeská wiki)
Kategorija: KMP (Programy mladòakoch
Zrobil: Róbert Bobák
Program: F-15.pas
Subor exe: F-15.exe
Mu¹i¹ mac: Egavga.bgi
Zrobil: Róbert BobákProgram: F-15.pas
Subor exe: F-15.exe
Mu¹i¹ mac: Egavga.bgi
Simulátor F15 v peknej grafickej podobe ovládaný my¹ou.
{ F-15.PAS } { } { Author: Robert Bobak } { Date : 15.02.1997 http://www.trsek.com } program LeteckySimulatorF15; uses crt,graph,DOS; var gd,gm,x,y:integer; ch:char; P,M: pointer; Size: Word; xm,ym,but,XM1,YM1,BUT1:integer; STRXM,STRYM,STRBUT:STRING; konci:boolean; PROCEDURE IKONA(X1,Y1,X2,Y2:INTEGER;TEXT:STRING); BEGIN SETLINESTYLE(0,0,3);SETFILLSTYLE(1,7); BAR(X1,Y1,X2,Y2);SETCOLOR(15); LINE(X1,Y1,X2,Y1); LINE(X1,Y1,X1,Y2); SETCOLOR(8); LINE(X1,Y2,X2,Y2);LINE(X2,Y2,X2,Y1); OUTTEXTXY(X1+8,(Y1+Y2) DIV 2 -4,TEXT); SETLINESTYLE(0,0,1); END; function gminit:boolean; 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; var reg:registers; begin reg.ax:=$0001; intr($33,reg); end; procedure NEzobraz_mys; var reg:registers; begin reg.ax:=$0002; intr($33,reg); end; procedure test_mys(var x,y,but:integer); var reg:registers; begin reg.ax:=$0003; intr($33,reg); x:=reg.cx; y:=reg.dx; but:=reg.bx; end; PROCEDURE IKONY; BEGIN ikona(10,10,100,30,'PLAY');IKONA(10,60,100,80,'HI-SCORE'); IKONA(10,110,100,130,'END'); END; procedure f15(x,y,f:integer); var a:integer; begin setcolor(f); {-------------------zadna chvostova plocha---------------------------} line(x+0,y+5,x+25,y+5); line(x+10,y+5,x+52,y+32); line(x+52,y+32,x+45,y+35); moveto(x+45,y+35);lineto(x+5,y+35); lineto(x+0,y+5); line(x-2,y+6,x+2,y+6); line(x-2,y+8,x+2,y+8); {-----------------------stabilizatory--------------------------------} for a:=40 to 41 do line(x+-5,y+a,x+30,y+a); {-------------------------motor--------------------------------------} moveto(x+7,y+40);lineto(x+7,y+47); line(x+5,y+35,x+5,y+40); lineto(x+17,y+50);lineto(x+17,y+40); {--------------------------nasavaci otvor----------------------------} line(x+17,y+50,x+150,y+45); moveto(x+150,y+45); lineto(x+172,y+27); lineto(x+157,y+22);lineto(x+50,y+30); {---------------------------predna cast+kabina-----------------------} moveto(x+205,y+17);lineto(x+175,y+20); line(x+152,y+42,x+204,y+40); lineto(x+165,y+15);lineto(x+160,y+10); lineto(x+150,y+15);line(x+160,y+10,x+182,y+5); line(x+182,y+5,x+182,y+19);line(x+182,y+5,x+205,y+17); line(x+197,y+13,x+197,y+18); {-------------------kridlo+pripojka na kridlo-----------------------} line(x+140,y+23,x+157,y+32); moveto(x+157,y+32); lineto(x+145,y+37); lineto(x+80,y+40); lineto(x+60,y+35); lineto(x+80,y+28); for a:=1 to 3 do line(x+56,y+33+a,x+125,y+29+a); {--------------------------obluky-----------------------------------} arc(x+200,y+155,69,90,138); arc(x+190,y-98,270,296,138); arc(x+109,y-61,270,300,87); {-------------------------vyplnovanie-------------------------------} setfillstyle(1,7); floodfill(x+100,y+35,8); floodfill(x+10,y+20,8); floodfill(x+100,y+40,8); floodfill(x+160,y+35,8); setfillstyle(1,8); floodfill(x+10,y+45,8); setfillstyle(1,7); floodfill(x+200,y+30,8); setfillstyle(1,9); floodfill(x+170,y+15,8); floodfill(x+190,y+15,8); floodfill(x+200,y+15,8); {-------------------------znak--------------------------------} setcolor(8); line(x+180,y+30,x+195,y+30); moveto(x+195,y+30); lineto(x+195,y+35); lineto(x+180,y+35); lineto(x+180,y+30); setcolor(lightred); line(x+181,y+32,x+194,y+32); setcolor(1); for a:=1 to 4 do circle(x+187,y+32,a); end; procedure mrak(x,y:integer); var a:integer; begin setcolor(15); for a:=1 to 12 do circle(x+40,y+50,a); for a:=1 to 12 do circle(x+34,y+54,a); for a:=1 to 20 do circle(x+80,y+20,a); for a:=1 to 20 do circle(x+100,y+20,a); for a:=1 to 30 do circle(x+60,y+50,a); for a:=1 to 30 do circle(x+50,y+54,a); for a:=1 to 30 do circle(x+144,y+50,a); for a:=1 to 32 do circle(x+110,y+50,a); end; procedure demo(x,y:integer); begin SETBKCOLOR(0); CLEARDEVICE; f15(x+5,y,8); setcolor(10); outtextxy(x,y+60,'ÛÛÛÛÛÛÛÛ ÛÛ ÛÛÛÛÛÛÛÛ'); outtextxy(x,y+68,'ÛÛÛÛÛÛÛÛ ÛÛ ÛÛÛÛÛÛÛÛ'); outtextxy(x,y+76,'ÛÛ ÛÛ ÛÛÛÛ ÛÛ ÛÛ'); outtextxy(x,y+84,'ÛÛ ÛÛ ÛÛÛÛ ÛÛ ÛÛ'); outtextxy(x,y+92,'ÛÛ ÛÛ ÛÛ'); outtextxy(x,y+100,'ÛÛ ÛÛ ÛÛ'); outtextxy(x,y+108,'ÛÛ ÛÛ ÛÛ ÛÛ'); outtextxy(x,y+116,'ÛÛÛÛÛÛ ÛÛÛÛÛ ÛÛ ÛÛÛÛÛÛÛÛ'); outtextxy(x,y+124,'ÛÛÛÛÛÛ ÛÛÛÛÛ ÛÛ ÛÛÛÛÛÛÛÛ'); outtextxy(x,y+132,'ÛÛ ÛÛ ÛÛ ÛÛ'); outtextxy(x,y+140,'ÛÛ ÛÛ ÛÛ'); outtextxy(x,y+148,'ÛÛ ÛÛ ÛÛ'); outtextxy(x,y+156,'ÛÛ ÛÛ ÛÛ'); outtextxy(x,y+164,'ÛÛ ÛÛ ÛÛ ÛÛ'); outtextxy(x,y+172,'ÛÛ ÛÛ ÛÛÛÛÛÛÛÛ'); outtextxy(x,y+180,'ÛÛ ÛÛ ÛÛÛÛÛÛÛÛ'); outtextxy(x,y+200,'ÛÛÛÛÛ ÞÛÝ ÛÛÛÛÛ Û ÛÛÛÛÛ'); outtextxy(x,y+208,'Û Û Û Û Û Û Û'); outtextxy(x,y+216,'Û Û Û Û'); outtextxy(x,y+224,'Û Û Û Û'); outtextxy(x,y+232,'ÛÜÛ Û ÜÜ Û ÛÜÛ'); outtextxy(x,y+240,'ÛßÛ Û ßÛ Û ÛßÛ'); outtextxy(x,y+248,'Û Û Û Û Û'); outtextxy(x,y+256,'Û Û Û Û Û'); outtextxy(x,y+264,'Û Û Û Û Û Û Û'); outtextxy(x,y+272,'ÛÛÛÛÛ ÛÛ ÛÛ ÛÛÛÛÛ ÛÛÛÛÛ ÛÛÛÛÛ'); line(x+60,y+273,x+72,y+208); line(x+80,y+208,x+92,y+273); line(x+72,y+257,x+68,y+273); line(x+72,y+257,x+80,y+257); line(x+80,y+257,x+84,y+224+49); line(x+72,y+249,x+80,y+249); moveto(x+80,y+249); lineto(x+76,180+49+y); lineto(x+72,y+249); setfillstyle(1,10); floodfill(x+76,y+175+49,10); end; PROCEDURE MYS; BEGIN if not(gminit) then writeln('Nemas nainstalovany ovladac na mys.'); zobraz_mys; konci:=false; repeat test_mys(xm,ym,but); IF ((XM>9) AND (XM<101) AND (YM>10) AND (YM<30) AND (BUT=1)) THEN BEGIN NEZOBRAZ_MYS; DEMO(200,100); IKONY; ZOBRAZ_MYS; konci:=true; END; IF ((XM>10) AND (XM<101) AND (YM>60) AND (YM<80) AND (BUT=1)) THEN BEGIN CLEARDEVICE; IKONY; SETCOLOR(13); OUTTEXTXY(500,100,'Hi-score:'); end; IF ((XM>10) AND (XM<101) AND (YM>110) AND (YM<130) AND (BUT=1)) THEN konci:=true; until (konci); end; procedure kresli(x,y:integer); begin GetImage(x,y,265+x,50+y,M^); PutImage(x,y,P^,2); delay(300); PutImage(x,y,M^,NormalPut); end; procedure uvod_demo; var i,a:integer; begin Size := ImageSize(0,0,270,50); GetMem(P, Size); f15(10,10,8); GetImage(0,0,270,50,P^); cleardevice; for i:=1 to 50 do begin putimage(i*5,100,P^,NormalPut); sound(200); delay(10); end; a:=500; for i:=1 to 60 do begin putimage(250+i*2,100+i*5,P^,NormalPut); a:=a-5; sound(a); delay(10); end; nosound; end; { zaciatok programu } begin gd:=detect; initgraph(gd,gm,''); if graphresult<>grok then halt(1); setbkcolor(0); cleardevice; uvod_demo; demo(200,100); ikona(10,10,100,30,'PLAY'); IKONA(10,60,100,80,'HI-SCORE'); IKONA(10,110,100,130,'END'); MYS; setbkcolor(0); cleardevice; mrak(100,100);mrak(240,300);mrak(500,140); Size := ImageSize(0,0,265,50); GetMem(P, Size); GetMem(M, Size); GetImage(0,0,265,50,M^); f15(10,0,8); GetImage(0,0,265,50,P^); PutImage(0,0,M^,NormalPut); outtextxy(10,470,'Pohyb sipkami. Esc koniec.'); konci:=false; repeat ch:=readkey; if ch='H' then y:=y-10; if ch='P' then y:=y+10; if ch='K' then x:=x-10; if ch='M' then x:=x+10; kresli(x,y); until ch=#27; REPEAT UNTIL KEYPRESSED; closegraph; end.