Nơi trao đổi thông tin Văn Lang
Chào mừng bạn đến với nơi trao đổi thông tin 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 !
Nơi trao đổi thông tin Văn Lang
Chào mừng bạn đến với nơi trao đổi thông tin 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 !
Nơi trao đổi thông tin Văn Lang
Bạn có muốn phản ứng với tin nhắn này? Vui lòng đăng ký diễn đàn trong một vài cú nhấp chuột hoặc đăng nhập để tiếp tục.
Nơi trao đổi thông tin Văn Lang

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ínhTìm kiếmLatest imagesĐăng kýĐăng Nhập

 

 Game Egg.pas

Go down 
Tác giảThông điệp
Admin
Admin
Admin


Posts : 121
Danh tiếng : 6
Join date : 10/11/2014
Age : 22

Game Egg.pas Empty
Bài gửiTiêu đề: Game Egg.pas   Game Egg.pas Icon_minitime16/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
https://forumpascalvanlang.forumvi.com
 
Game Egg.pas
Về Đầu Trang 
Trang 1 trong tổng số 1 trang
 Similar topics
-
» Game rút cờ
» Game oẳn tù tì
» Game Can Chi
» Game Xep_hinh.pas
» Game chess.pas (cờ vua)

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