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 Xep_hinh.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 Xep_hinh.pas   16/1/2015, 05:51

program GameXepHinh;
uses graph,crt;
var
c,c1:char;
x,y:shortint;dem,rd,z:word;
lp,lp2:byte; {lp2:dong,lp:cot}
mau,maux:array[1..4,1..4]of shortint;
Gd,Gm: Integer;
{____}
function mu(c,e:integer):integer;
var l1:integer;n:integer;
begin
n:=1;
if e>0 then
for l1:=1 to e do
n:=n*c;
mu:=n;
end;
{____}
procedure writedem(x,y:word);
var a,b:word;d:integer;
begin
b:=dem;
for d:=4 downto 0 do
begin
a:=b div (mu(10,d));
case a of
0: outtextxy(x+(4-d)*10,y,'0');
1: outtextxy(x+(4-d)*10,y,'1');
2: outtextxy(x+(4-d)*10,y,'2');
3: outtextxy(x+(4-d)*10,y,'3');
4: outtextxy(x+(4-d)*10,y,'4');
5: outtextxy(x+(4-d)*10,y,'5');
6: outtextxy(x+(4-d)*10,y,'6');
7: outtextxy(x+(4-d)*10,y,'7');
8: outtextxy(x+(4-d)*10,y,'8');
9: outtextxy(x+(4-d)*10,y,'9');
10: outtextxy(x+(4-d)*10,y,'10');
end;
b:=b mod mu(10,d);
end;
end;
procedure hcn(x1,y1,x2,y2,mausac:word);
var loop:word;
begin
setcolor(mausac);
rectangle(x1,y1,x2,y2);
for loop:=1 to y2-y1 do
line(x1,y1+loop,x2,y1+loop);
end;
{_____}
procedure draw;
begin
for lp:=1to 4do
for lp2:=1 to 4 do
hcn(50*(lp+7),50*(lp2),50*(lp+Cool,50*(lp2+1),maux[lp,lp2]);
setcolor(15);
rectangle(400,50,600,250);
hcn(40+240,270,120+240,330,lightgray);
setcolor(white);
writedem(55+240,295);
rectangle(45+240,275,115+240,325);
end;
{____}
procedure duoi;
var tmp:shortint;
begin
if y>1 then
begin
tmp:=maux[x,y];
maux[x,y]:=maux[x,y-1];
maux[x,y-1]:=tmp;
dem:=dem+1;
y:=y-1;
end;
end;
{____}
procedure tren;
var tmp:shortint;
begin
if y<4 then
begin
tmp:=maux[x,y];
maux[x,y]:=maux[x,y+1];
maux[x,y+1]:=tmp;
dem:=dem+1;
y:=y+1;
end;
end;
procedure phai;
var tmp:shortint;
begin
if x>1 then
begin
tmp:=maux[x,y];
maux[x,y]:=maux[x-1,y];
maux[x-1,y]:=tmp;
dem:=dem+1;
x:=x-1;
end;
end;
{____}
procedure trai;
var tmp:shortint;
begin
if x<4 then
begin
tmp:=maux[x,y];
maux[x,y]:=maux[x+1,y];
maux[x+1,y]:=tmp;
dem:=dem+1;
x:=x+1;
end;
end;
{ct chinh}
begin
Gd := Detect; InitGraph(Gd, Gm,' ');
if GraphResult <> grOk then Halt(1);
repeat
cleardevice;
dem:=0;
{random}
randomize;
hcn(95,75,500,125,lightgray);
setcolor(white);
rectangle(100,80,495,120);
Outtextxy(100,100,' Nhan phim Enter de tiep tuc');
repeat
rd:=random(1000)+1;
until keypressed;
readln;
cleardevice;
{ve ket qua}
for lp:=1to 4do
for lp2:=1 to 4 do
begin
mau[lp,lp2]:=(lp-1)*4+(lp2); mau[4,4]:=0;
hcn(50*(lp),50*(lp2),50*(lp+1),50*(lp2+1),mau[lp,lp2]);
end; x:=4;y:=4; {x:cot,y:dong}
setcolor(15);
rectangle(50,50,250,250); {to vien}
{gan maux = mau}
for lp:=1 to 4 do
for lp2:= 1 to 4 do
maux[lp,lp2]:=mau[lp,lp2];
{luat choi}
OutTextXY(100,400,'Luat choi:');
OutTextXY(100,420,'Ban hay an cac phim mui ten de xep hinh.');
OutTextXY(105,430,'- : Len tren');
OutTextXY(105,440,'- : Xuong duoi');
OutTextXY(105,450,'- : Sang trai');
OutTextXY(105,460,'- : Sang phai');
OutTextXY(105,470,'- Esc : Thoat');
outtextxy(120,430,#24);
outtextxy(120,440,#25);
outtextxy(120,450,#26);
outtextxy(120,460,#27);
{trao doi}
repeat
rd:=random(1000);
if(rd mod 4 = 0) then tren;
if(rd mod 4 = 1) then duoi;
if(rd mod 4 = 2) then trai;
if(rd mod 4 = 3) then phai;
z:=z+1;
until (z>200)and(x=4)and(y=4);
dem:=0;draw;
{bd choi}
repeat
c:=readkey;
if c=#0 then
begin
c1:=readkey;
if c1=#80 then duoi;
if c1=#72 then tren;
if c1=#75 then trai;
if c1=#77 then phai;
end;
draw;
z:=0;
for lp:= 1 to 4 do
for lp2:= 1 to 4 do
if maux[lp,lp2]=mau[lp,lp2] then
z:=z+1;
if z=16 then c:=chr(27);
until c=chr(27);
{thang thua}
if z=16 then
begin
cleardevice;
hcn(30,40,600,110,lightgray);
setcolor(white);
rectangle(35,45,595,105);
outtextxy(100,60,'Ban da thang voi ');
writedem(235,60);
outtextxy(245,60,' lan di chuyen');
outtextxy(100,80,'Nhan Esc de thoat hoac nhan Enter de tiep tuc');
c:=readkey;
end;
until c=chr(27);
CloseGraph;
end.
Về Đầu Trang Go down
Xem lý lịch thành viên http://forumpascalvanlang.forumvi.com
 
Game Xep_hinh.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