Victory Family Zone Forum
Xin chào mừng các bạn đã đến với thế giới dành cho cộng Teen - Victory Zone Forum !
Xin mời các bạn đăng kí để làm thành viên của diễn đàn , chúng tôi đảm bảo : Thời gian đăng kí chưa đầy 1 phút !
Nếu đã có tài khoản , xin vui lòng đăng nhập !
Lưu Ý *: Những tài khoản trong vòng 1 tháng mà không hoạt động sẽ bị xóa ngày lập tức !Chúng tôi khuyến cáo nên dùng 2 trình duyệt là Google Chrome hoặc Mozila FireFox , khi dùng các trình duyệt khác , có thể các lỗi nhỏ sẽ xảy ra !
Xin chân thành cảm ơn !
Victory Family Zone Forum
Xin chào mừng các bạn đã đến với thế giới dành cho cộng Teen - Victory Zone Forum !
Xin mời các bạn đăng kí để làm thành viên của diễn đàn , chúng tôi đảm bảo : Thời gian đăng kí chưa đầy 1 phút !
Nếu đã có tài khoản , xin vui lòng đăng nhập !
Lưu Ý *: Những tài khoản trong vòng 1 tháng mà không hoạt động sẽ bị xóa ngày lập tức !Chúng tôi khuyến cáo nên dùng 2 trình duyệt là Google Chrome hoặc Mozila FireFox , khi dùng các trình duyệt khác , có thể các lỗi nhỏ sẽ xảy ra !
Xin chân thành cảm ơn !
Victory Family Zone Forum
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.



 
Trang ChínhTrang Chính  Tìm kiếmTìm kiếm  Latest imagesLatest images  Đăng kýĐăng ký  Đăng NhậpĐăng Nhập  Tiện ích  

Share | 

 

 [ Pascal ] Game Hứng trứng               

Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down 
[ Pascal ] Game Hứng trứng I_icon18Sun Oct 10, 2010 10:14 am

Vipboypr0
Vipboypr0

Administrator

http://vngo.co.cc

Thông tin Vipboypr0
Câu nói tâm đắc : Sống để cống hiến !
Posts : 81
Points : 50232
Thanked : 6
Đến Từ : Đà Nẵng

Thông tin Vipboypr0
Bấm !
Câu nói tâm đắc : Sống để cống hiến !
Posts : 81
Points : 50232
Thanked : 6
Đến Từ : Đà Nẵng

Bài gửiTiêu đề: [ Pascal ] Game Hứng trứng

 
Chương trình Game : Hứng Trứng
hãy nhớ Khong Compile duoc bang Free Pascal
Code:

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.

các bước làm giống như Kim cương , từ nay , các bạn muốn làm dc thỳ đọc bài Kim cương !
http://vngo.co.cc/forum-f33/topic-t50.htm#74

Hành trang Vipboypr0
Vật phẩm Vipboypr0
Tài sản
.::
Chữ Ký Vipboypr0
Hãy cùng Vipboypr0 xây dụng 1 Diễn Đàn Tốt hơn nhé !



[ Pascal ] Game Hứng trứng I_icon18Sun Oct 31, 2010 4:47 pm

shuchang
shuchang

Thành viên Mới

Thông tin shuchang
Posts : 6
Points : 49300
Thanked : 0
Đến Từ : 2344

Thông tin shuchang
Bấm !
Posts : 6
Points : 49300
Thanked : 0
Đến Từ : 2344

Bài gửiTiêu đề: Re: [ Pascal ] Game Hứng trứng

 
khó quá :(

Hành trang shuchang
Vật phẩm shuchang
Chữ Ký shuchang
Hãy cùng shuchang xây dụng 1 Diễn Đàn Tốt hơn nhé !



 

[ Pascal ] Game Hứng trứng

Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang 
Trang 1 trong tổng số 1 trang