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 !



 
IndexIndex  Trợ giúpTrợ giúp  Tìm kiếmTìm kiếm  Thành viênThành viên  NhómNhóm  Đă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 
Sun Oct 10, 2010 10:14 am

avatar
Vipboypr0

Administrator

Xem lý lịch thành viên http://vngo.co.cc

Thông tin Vipboypr0
Câu nói tâm đắc : Sống để cống hiến !
Posts : 81
Points : 24332
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 : 24332
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é !





Sun Oct 31, 2010 4:47 pm

avatar
shuchang

Thành viên Mới

Xem lý lịch thành viên

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

Thông tin shuchang
Bấm !
Posts : 6
Points : 23400
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