- 14 Tháng năm 2017
- 3,974
- 7,623
- 744
- 22
- Phú Yên
- Trường THPT Lương Văn Chánh
[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
Chắc suất Đại học top - Giữ chỗ ngay!!
ĐĂNG BÀI NGAY để cùng trao đổi với các thành viên siêu nhiệt tình & dễ thương trên diễn đàn.
Game này viết lâu rồi mà chưa đăng nên giờ đăng 
ai phát hiện trùng nội dung thì báo cho BQT xóa nha
ai phát hiện trùng nội dung thì báo cho BQT xóa nha
Mã:
Program Ghep_Hinh;
uses crt,graph;
const
KThuoc = 4;
KThuocO = 65;
KTOMau = 25;
MangMau: array[1..KThuoc,1..KThuoc] of Word =
((1,2,3,4),(5,6,7,8),(9,10,11,12),(13,14,16,15));
var
gd,gm: integer;
Mau: array[1..KThuoc,1..KThuoc] of Word;
Cx,Cy,Diem: integer;
Procedure VeO(X,Y: integer);
Begin
SetFillStyle(1,Mau[X,Y]);
Bar(X*KThuocO,Y*KThuocO,(X+1)*KThuocO,(Y+1)*KThuocO);
End;
Procedure VeOMau;
var x,y: integer;
Begin
for x := 1 to KThuoc do
for y := 1 to KThuoc do
begin
SetFillStyle(1,MangMau[X,Y]);
Bar((KThuoc+1)*KThuocO + 20 + X*KTOMau,KThuocO+(Y-1)*KTOMau,
(KThuoc+1)*KThuocO + 20 +(X+1)*KTOMau,KThuocO+Y*KTOMau);
end;
SetColor(White);
RecTangle((KThuoc+1)*KThuocO + 20 + KTOMau,KThuocO,
(KThuoc+1)*KThuocO + 20 +(KThuoc+1)*KTOMau,KThuocO+KThuoc*KTOMau);
End;
Procedure InDiem;
var sd: string;
Begin
SetFillStyle(1,Black);
Bar((KThuoc+1)*KThuocO + 20 + KTOMau,
KThuocO+KThuoc*KTOMau+20,(KThuoc+1)*KThuocO + 20 + KTOMau+200,
KThuocO+KThuoc*KTOMau+20+50);
Str(diem,sd);
SetTextStyle(0,0,1);
OutTextXy((KThuoc+1)*KThuocO + 20 + KTOMau,
KThuocO+KThuoc*KTOMau+20,'Diem: '+sd);
End;
Procedure KhoiTao;
var x,y: integer;
m: Word;
Begin
m := 1;
Cx := KThuoc;
Cy := KThuoc;
Diem := 0;
for x := 1 to KThuoc do
for y := 1 to KThuoc do
begin
Mau[X,Y] := m;
VeO(x,y);
inc(m);
end;
SetColor(White);
RecTangle(KThuocO-1,KThuocO-1,(KThuoc+1)*KThuocO+1,(KThuoc+1)*KThuocO+1);
SetColor(Brown);
SetTextStyle(0,0,3);
OutTextXy(100,10,'GAME GHEP HINH');
End;
Procedure HoanDoi(x1,y1,x2,y2: integer);
var tam: Word;
Begin
tam := Mau[x1,y1];
Mau[x1,y1] := Mau[x2,y2];
Mau[x2,y2] := tam;
VeO(x1,y1);
VeO(x2,y2);
inc(Diem);
InDiem;
End;
Procedure XuLy(p: char);
Begin
case p of
#72: {Len} if Cy < KThuoc then begin HoanDoi(Cx,Cy,Cx,Cy+1);inc(Cy);end;
#80: {Xuong} if Cy > 1 then begin HoanDoi(Cx,Cy,Cx,Cy-1);inc(Cy,-1);end;
#75: {Trai} if Cx < KThuoc then begin HoanDoi(Cx,Cy,Cx+1,Cy);inc(Cx);end;
#77: {Phai} if Cx > 1 then begin HoanDoi(Cx,Cy,Cx-1,Cy);inc(Cx,-1);end;
end;
End;
Function ChienThang: Boolean;
var x,y: integer;
br: boolean;
Begin
ChienThang := False;
br := False;
for x := 1 to KThuoc do
begin
for y := 1 to KThuoc do
if Mau[X,Y] <> MangMau[X,Y] then
begin br:=True;break;end;
if br then break;
end;
if (X = KThuoc) and (Y = KThuoc) then ChienThang := True;
End;
Procedure DiChuyen;
var p: char;
Begin
repeat
p := #0;
if Keypressed then begin p := readkey;XuLy(p);end;
until (p = #27 {ESC}) or ChienThang;
if ChienThang then
begin
SetTextStyle(0,0,3);
SetColor(Blue);
OutTextXy(100,170,'Ban Thang Rui!');
readln;
end;
End;
BEGIN
gd := EGA;
gm := EGAHi;
InitGraph(gd,gm,'');
KhoiTao;
VeOMau;
InDiem;
DiChuyen;
CloseGraph;
END.
