Diễn đàn tin học Văn Lang - Vạn Ninh
Chào mừng bạn đến với Diễn đàn Tin học Văn Lang - Vạn Ninh của chúng tôi !
Hãy đăng nhập hoặc đăng kí tài khoản để trải nghiệm nhiều điều thú vị tại đây !
Thân ái !

Diễn đàn tin học Văn Lang - Vạn Ninh

Nơi trao đổi thông tin, tăng cường hợp tác, giải đáp những vướng mắc khi học lập trình Pascal
 
Trang ChínhCalendarTrợ giúpTìm kiếmThành viênNhómĐăng kýĐăng Nhập

Share | 
 

 Game Egg.pas

Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down 
Tác giảThông điệp
Admin
Admin
avatar

Posts : 113
Danh tiếng : 5
Join date : 10/11/2014
Age : 16

Bài gửiTiêu đề: Game Egg.pas   16/1/2015, 05:49

program EggCrt;
{==============   Can doc   ================}
{!!! Khong Compile duoc bang Free Pascal !!!}
{===========================================}
uses crt,dos;
const x1=5;y1=4;x2=77;y2=18;
rShift=1; lShift=2; Ctrl=4; Alt=8;
ScrLock=16; NumLock=32; CapsLock=64; Insert=128;
var EggX,EggY:byte;
   BedX:1..x2-9;
   Mark:byte;
   Lost:Byte;
   c,d:byte;
procedure writexy(x,y:byte;c:string);
begin gotoxy(x,y); write(c); end;
function SpecialKey(c:byte):boolean;
var regs:registers;
begin
Regs.AH:=2; Intr($16,Regs);
if Regs.AL and c = c then
SpecialKey:=True
else SpecialKey:=False;
end;
procedure vekhung(x1,y1,x2,y2:word);
var z,a,b:word;
begin
if (x1<>x2) and (y1<>y2) then
begin
a:=wherex; b:=wherey;
if x1>x2 then
begin z:=x1; x1:=x2; x2:=z; end;
if y1>y2 then
begin z:=y1; y1:=y2; y2:=z; end;
gotoxy(x1,y1); write(#201);
if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205);
gotoxy(x2,y1); write(#187);
gotoxy(x1,y2); write(#200);
if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205);
gotoxy(x2,y2); write(#188);
if y2-y1>1 then for z:=1 to y2-y1-1 do begin
gotoxy(x1,z+y1); write(#186); end;
if y2-y1>1 then for z:=1 to y2-y1-1 do begin
gotoxy(x2,z+y1); write(#186); end;
end;
gotoxy(a,b);
end;
procedure Drawmark;
begin
gotoxy(x1-1,y2+4); write('Mark: ',mark,'/10');
gotoxy(x1-1,y2+5); write('Lost: ',Lost,'/',mark+Lost);
end;
Procedure Delay(ms:word);
var t: longint; n:real;
begin n:=ms/1000;
t := meml[0:$46C];
repeat until meml[0:$46C] - t > n*18.2;
end;
procedure DrawEgg;
begin textcolor(yellow);
writexy(Eggx+x1,Eggy div 3 + y1-1,#32);
writexy(Eggx+x1,Eggy div 3 + y1,#9);
textcolor(white); end;
procedure DrawBed;
begin textcolor(brown);
writexy(Bedx+x1-2,y2,#32#32#177#177#177#177#177#177#177#177#177#32#32);
textcolor(white); end;
procedure init;
begin randomize;
vekhung(x1-3,y1-2,x2+2,y2+2);
vekhung(x1-3,y2+3,x1+15,24);
vekhung(x1+18,y2+3,x2+2,24);
writexy(x1+20,y2+4,'Dieu khien de trung roi vao o  Alt: Tam dung');
writexy(x1+20,y2+5,'Left/Right Shift: di chuyen    Ctrl: Di nhanh');
writexy(20,10,'An Alt de tiep tuc...');
repeat eggX:=random(60)+3; until specialkey(alt);
repeat until not specialkey(alt);
writexy(20,10,'                             ');
end;
BEGIN
textmode(co80); textcolor(white); clrscr; c:=30;
writexy(c,11,#75#32#32#75#32#73#32#69#69#69#69#32#78#32#32#78);
writexy(c,12,#75#32#75#32#32#73#32#69#32#32#32#32#78#78#32#78);
writexy(c,13,#75#75#32#32#32#73#32#69#69#69#32#32#78#32#78#78);
writexy(c,14,#75#32#75#32#32#73#32#69#32#32#32#32#78#32#32#78);
writexy(c,15,#75#32#75#32#32#73#32#69#69#69#69#32#78#32#32#78);
writexy(c,16,#45#45#45#45#45#45#45#45#45#45#45#45#45#45#45#45);
writexy(c,17,#67#32#79#32#73#32#95#32#49#32#57#32#57#32#55#32);
writexy(c,5,#71#97#109#101#32#72#117#110#103#32#84#114#117#110#103);
writexy(25,9,#66#97#110#32#113#117#121#101#110#58);
writexy(37,9,#107#105#101#110#95#99#111#105#95#49#57#57#55);
writexy(12,19,'Phong to cua so < Alt+Enter > de chat luong anh tot nhat');
textcolor(lightgray);
writexy(c,22,#76#32#79#32#65#32#68#32#73#32#78#32#71);
textcolor(yellow); gotoxy(c,22);
write(#76#32);delay(1000);
write(#79#32);delay(1000);
write(#65#32);delay(1000);
write(#68#32);delay(1000);
write(#73#32);delay(1000);
write(#78#32);delay(1000);
write(#71);delay(1000);
textcolor(white);
repeat
clrscr; mark:=0; Lost:=0;
init;bedx:=20;
for c:=1 to 10 do begin
Eggx:=random(60)+3; gotoxy(5,14+3);
write('                                                                 ');
for Eggy:=1 to 14*3 do begin
drawbed;
drawegg;
drawmark;
if specialkey(lshift) and (bedx>=1) then dec(bedx);
if specialkey(rshift) and (bedx+14<x2) then inc(bedx);
if specialkey(ctrl or lshift) and (bedx>=1) then dec(bedx);
if specialkey(ctrl or rshift) and (bedx+14<x2) then inc(bedx);
if specialkey(Alt) then
begin
repeat until not specialkey(alt);
writexy(20,10,'An Alt de tiep tuc...');
repeat until specialkey(alt);
repeat until not specialkey(alt);
writexy(20,10,'                             ');
drawegg; end;
if (Eggy=14*3) then
begin
if abs(-BedX-4+Eggx)<4 then inc(Mark)
else inc(Lost);
writexy(Eggx+4,18,#32);
end;
delay(0);
end;
end;
gotoxy(20,7); write('So diem dat duoc: ',mark);
gotoxy(20,10); write('So trung bi rot: ',lost);
gotoxy(20,13); write('An Shift+Alt de tiep tuc, Ctrl+Alt de thoat');
repeat until specialKey(lshift+alt)
         or specialkey(ctrl+alt)
         or specialkey(rshift+alt);
until specialkey(Alt+Ctrl);
end.
Về Đầu Trang Go down
Xem lý lịch thành viên http://forumpascalvanlang.forumvi.com
 
Game Egg.pas
Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang 
Trang 1 trong tổng số 1 trang
 Similar topics
-
» Boom Online - Game đặt bom sặc nước online vui nhộn Ò.Ó~
» »[Game] Ý nghĩa tên nick
» CDOV - CongDongOtakuViet.Com - Thế giới tin tức Anime, Manga, Game, Vocaloid, Music, Cosplay,...
» [Game android] Trọn bộ 10 game android tổng hợp hay nhất
» [flash Game][Game collection] BAKUGAN : Mechtanium Surge

Permissions in this forum:Bạn không có quyền trả lời bài viết
Diễn đàn tin học Văn Lang - Vạn Ninh :: Các chương trình lớn viết bằng Pascal-
Chuyển đến