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 Xep_hinh.pas

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


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

Game Xep_hinh.pas Empty
Bài gửiTiêu đề: Game Xep_hinh.pas   Game Xep_hinh.pas Icon_minitime16/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
https://forumpascalvanlang.forumvi.com
 
Game Xep_hinh.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 Egg.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