- 14 Tháng năm 2017
- 3,974
- 7,619
- 744
- 21
- 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.
Không biết là cái game này mình từng đăng chưa nữa. Giờ đăng lại để hôm nào thực hành tin Cop về khoe mấy đứa bạn 
Mình chỉ dùng toàn code cơ bản thôi nên chạy không mượt như người ta được.
Mình chỉ dùng toàn code cơ bản thôi nên chạy không mượt như người ta được.
Mã:
Program Tetris;
uses crt,dos;
const
_Rows = 16;
_Cols = 25;
_Sizes = 20;
_Left = #75;
_Right = #77;
_SuperDown = #80;
_Down = #80;
_Up = #72;
_EsCape = #27;
type TCubes = record
x,y,h,w: integer;
end;
var TimeDown,Score,Speed,i: integer;
Table: array[-3.._Rows,-4.._Cols] of Boolean;
Cubes,NextCubes: array[1..4] of TCubes;
key: Char;
gameover,gamestart: Boolean;
Procedure SetCusor(bot,top: byte);
var regs: Registers;
Begin
regs.ah := 1;
regs.ch := bot;
regs.cl := top;
intr($10,regs);
End;
Procedure ReDraw;
var i,j: integer;
Begin
for i := 1 to _Rows do
for j := 1 to _Cols do
begin
Gotoxy(i,j);
if Table[i,j] then Write(#219)
else Write(#250);
end;
End;
Procedure RotateCubes;
var x,y,h,w,i,j,k: integer;
Cube,Cube1: array[1..4,1..4] of Boolean;
Begin
{ Get Cube}
x := Cubes[1].X;
y := Cubes[1].Y;
for i:= 2 to 4 do
begin
if Cubes[i].X < x then x := Cubes[i].X;
if Cubes[i].Y < y then y := Cubes[i].Y;
end;
h := Cubes[1].h;
w := Cubes[1].w;
if (x + h - 1 <= _Rows) and not Table[x+h,y] and (y - w >= 0) then
begin
for i := 1 to 4 do
for j := 1 to 4 do
Cube[i,j] := False;
for i := 1 to w do
for j := 1 to h do
begin
for k := 1 to 4 do
if (Cubes[k].X = x+i-1) and (Cubes[k].Y = y+j-1) then
begin
Cube[i,j] := True;
break;
end;
end;
{ Rotate}
for i := 1 to 4 do
begin
Cube1[1,i] := Cube[5-i,1];
Cube1[4,i] := Cube[5-i,4];
Cube1[i,1] := Cube[4,i];
Cube1[i,4] := Cube[1,i];
end;
Cube1[2,2] := Cube[3,2];
Cube1[2,3] := Cube[2,2];
Cube1[3,3] := Cube[2,3];
Cube1[3,2] := Cube[3,3];
{Set Cube Rotated}
k := 1;
for i := 1 to 4 do
for j := 1 to 4 do
begin
if Cube1[i,j] then
begin
Cubes[k].X := x + i-1;
Cubes[k].Y := y + j-1-w;
inc(k);
end;
end;
Cubes[1].h := w;
Cubes[1].w := h;
end;
End;
Procedure RotateNextCubes;
var x,y,h,w,i,j,k,m: integer;
Cube,Cube1: array[1..4,1..4] of Boolean;
Begin
{ Get Cube}
x := NextCubes[1].X;
y := NextCubes[1].Y;
for i:= 2 to 4 do
begin
if NextCubes[i].X < x then x := NextCubes[i].X;
if NextCubes[i].Y < y then y := NextCubes[i].Y;
end;
h := NextCubes[1].h;
w := NextCubes[1].w;
if x <= _Rows - h then
begin
for i := 1 to 4 do
for j := 1 to 4 do
Cube[i,j] := False;
for i := 1 to w do
for j := 1 to h do
begin
for k := 1 to 4 do
if (NextCubes[k].X = x+i-1) and (NextCubes[k].Y = y+j-1) then
begin
Cube[i,j] := True;
break;
end;
end;
{ Rotate}
for m := 0 to 1 do
for i := m+1 to 4-m do
begin
Cube1[m+1,i] := Cube[5-i,m+1];
Cube1[4-m,i] := Cube[5-i,4-m];
Cube1[i,m+1] := Cube[4-m,i];
Cube1[i,4-m] := Cube[m+1,i];
end;
{Set Cube Rotated}
k := 1;
for i := 1 to 4 do
for j := 1 to 4 do
begin
if Cube1[i,j] then
begin
NextCubes[k].X := x + i-1;
NextCubes[k].Y := y + j-1-w;
inc(k);
end;
end;
NextCubes[1].h := w;
NextCubes[1].w := h;
end;
End;
Procedure CreateNextSquares;
var img,i,Rot: integer;
Cube: TCubes;
Begin
Cube.X := _Rows div 2;
Cube.Y := 1;
for i := 1 to 4 do
begin
Gotoxy(_Rows-Cube.X+NextCubes[i].X+6,NextCubes[i].Y+11);
Write(#32);
end;
img := 1 + random(6);
case img of
1: { Square }
begin
NextCubes[1].X := Cube.X;
NextCubes[1].Y := Cube.Y-1;
NextCubes[2].X := Cube.X;
NextCubes[2].Y := Cube.Y;
NextCubes[3].X := Cube.X + 1;
NextCubes[3].Y := Cube.Y-1;
NextCubes[4].X := Cube.X + 1;
NextCubes[4].Y := Cube.Y;
NextCubes[1].h := 2;
NextCubes[1].w := 2;
end;
2: { L }
begin
NextCubes[1].X := Cube.X;
NextCubes[1].Y := Cube.Y-2;
NextCubes[2].X := Cube.X;
NextCubes[2].Y := Cube.Y-1;
NextCubes[3].X := Cube.X;
NextCubes[3].Y := Cube.Y;
NextCubes[4].X := Cube.X + 1;
NextCubes[4].Y := Cube.Y;
NextCubes[1].h := 3;
NextCubes[1].w := 2;
end;
3: { T }
begin
NextCubes[1].X := Cube.X;
NextCubes[1].Y := Cube.Y-1;
NextCubes[2].X := Cube.X + 1;
NextCubes[2].Y := Cube.Y-1;
NextCubes[3].X := Cube.X+2;
NextCubes[3].Y := Cube.Y-1;
NextCubes[4].X := Cube.X + 1;
NextCubes[4].Y := Cube.Y;
NextCubes[1].h := 2;
NextCubes[1].w := 3;
end;
4: { I }
begin
NextCubes[1].X := Cube.X;
NextCubes[1].Y := Cube.Y-3;
NextCubes[2].X := Cube.X;
NextCubes[2].Y := Cube.Y-2;
NextCubes[3].X := Cube.X;
NextCubes[3].Y := Cube.Y-1;
NextCubes[4].X := Cube.X;
NextCubes[4].Y := Cube.Y;
NextCubes[1].h := 4;
NextCubes[1].w := 1;
end;
5: { Z }
begin
NextCubes[1].X := Cube.X;
NextCubes[1].Y := Cube.Y-1;
NextCubes[2].X := Cube.X;
NextCubes[2].Y := Cube.Y;
NextCubes[3].X := Cube.X+1;
NextCubes[3].Y := Cube.Y-2;
NextCubes[4].X := Cube.X + 1;
NextCubes[4].Y := Cube.Y-1;
NextCubes[1].h := 3;
NextCubes[1].w := 2;
end;
6: {Z Reverse}
begin
NextCubes[1].X := Cube.X;
NextCubes[1].Y := Cube.Y-2;
NextCubes[2].X := Cube.X;
NextCubes[2].Y := Cube.Y-1;
NextCubes[3].X := Cube.X+1;
NextCubes[3].Y := Cube.Y-1;
NextCubes[4].X := Cube.X + 1;
NextCubes[4].Y := Cube.Y;
NextCubes[1].h := 3;
NextCubes[1].w := 2;
end;
7: { L Reverse}
begin
NextCubes[1].X := Cube.X+1;
NextCubes[1].Y := Cube.Y-2;
NextCubes[2].X := Cube.X+1;
NextCubes[2].Y := Cube.Y-1;
NextCubes[3].X := Cube.X+1;
NextCubes[3].Y := Cube.Y;
NextCubes[4].X := Cube.X;
NextCubes[4].Y := Cube.Y;
NextCubes[1].h := 3;
NextCubes[1].w := 2;
end;
end;
rot := random(3);
for i := 1 to rot do RotateNextCubes;
for i := 1 to 4 do
begin
Gotoxy(_Rows-Cube.X+NextCubes[i].X+6,NextCubes[i].Y+11);
Write(#219);
Gotoxy(_Rows + 3,6);
Write('N E X T: ');
end;
End;
Procedure CreateSquares;
var i: integer;
Begin
for i := 1 to 4 do
begin
Cubes[i] := NextCubes[i];
Table[Cubes[i].X,Cubes[i].Y] := True;
end;
CreateNextSquares;
End;
Function IsLine: Integer;
var i,j,count: integer;
Begin
IsLine := 0;
for j := _Cols downto 1 do
begin
count := 0;
for i := 1 to _Rows do
if Table[i,j] then inc(count);
if count = _Rows then
begin
IsLine := j;
break;
end;
end;
End;
Procedure Clear;
var i,j,count: integer;
Begin
for j := IsLine downto 2 do
begin
count := 0;
for i := 1 to _Rows do
begin
if not Table[i,j] then inc(count);
Table[i,j] := Table[i,j-1];
end;
if count = _Rows then break;
end;
End;
Procedure ShowScore;
Begin
Gotoxy(_Rows+3,15);
Write('S C O R E: ',Score);
End;
Procedure DrawSquares(Dir: char);
var i,j,m: integer;
Block : Boolean;
Begin
Block := False;
case Dir of
_Up:
begin
for i := 1 to 4 do
Table[Cubes[i].X,Cubes[i].Y] := False;
RotateCubes;
for i := 1 to 4 do
Table[Cubes[i].X,Cubes[i].Y] := True;
end;
_Down:
begin
for i := 1 to 4 do
begin
m := 0;
for j := 1 to 4 do
if (Cubes[i].Y + 1 = Cubes[j].Y)
and (Cubes[i].X = Cubes[j].X) then begin m := 1;break;end;
if m = 0 then
if (Table[Cubes[i].X,Cubes[i].Y+1])
or (Cubes[i].Y = _Cols) then begin Block := True;break;end;
end;
if not Block then
for i := 4 downto 1 do
begin
Table[Cubes[i].X,Cubes[i].Y] := False;
inc(Cubes[i].Y);
Table[Cubes[i].X,Cubes[i].Y] := True;
end
else
begin
if Cubes[4].Y > 0 then
begin
while IsLine <> 0 do
begin
Clear;
inc(Score,_Rows);
if (Score >= 5*_Rows) and (Score < 10*_Rows) then
Speed := 20000
else if Score >= 10*_Rows then Speed := 10000;
ShowScore;
end;
CreateSquares;
end
else GameOver := True;
end;
end;
_Left:
begin
m := 0;
for i := 1 to 4 do
begin
m := 0;
for j := 1 to 4 do
if (Cubes[i].X-1 = Cubes[j].X)
and (cubes[i].Y = Cubes[j].Y) then begin m := 1;break;end;
if m = 0 then
if Table[Cubes[i].X-1,Cubes[i].Y] or (Cubes[i].X = 1) then Block := True;
end;
if not Block then
for i := 1 to 4 do
begin
Table[Cubes[i].X,Cubes[i].Y] := False;
inc(Cubes[i].X,-1);
Table[Cubes[i].X,Cubes[i].Y] := True;
end;
end;
_Right:
begin
m := 0;
for i := 1 to 4 do
begin
m := 0;
for j := 1 to 4 do
if (Cubes[i].X+1 = Cubes[j].X)
and (cubes[i].Y = Cubes[j].Y) then begin m := 1;break;end;
if m = 0 then
if Table[Cubes[i].X+1,Cubes[i].Y] or (Cubes[i].X = _Rows) then Block := True;
end;
if not Block then
for i := 4 downto 1 do
begin
Table[Cubes[i].X,Cubes[i].Y] := False;
inc(Cubes[i].X);
Table[Cubes[i].X,Cubes[i].Y] := True;
end;
end;
end;
ReDraw;
End;
Procedure InTroduce;
Begin
clrscr;
TextColor(Blue);
Gotoxy(10,2);Write('I N T R O D U C E:');
TextColor(LightGray);
Gotoxy(2,5);Write('-Key Up: Rotate');
Gotoxy(2,7);Write('-Key Down: Move Down');
Gotoxy(2,9);Write('-Key Left: Move Left');
Gotoxy(2,11);Write('-Key Right: Move Right');
Gotoxy(2,13);Write('-Key P: Pause');
Gotoxy(2,15);Write('-Key ESC: Back Menu');
TextColor(LightRed+Blink);
Gotoxy(10,17);Write('Press Enter to back...');
readln;
TextColor(LightGray);
clrscr;
End;
Procedure NewGame;
var i,j: integer;
Begin
for i := 1 to _Rows do
for j := 1 to _Cols do
Table[i,j] := False;
TextMode(Co40);
SetCusor(32,0);
Score := 0;
GameOver := False;
GameStart := True;
CreateNextSquares;
CreateSquares;
ShowScore;
Speed := 30000;
TimeDown := 0;
End;
Procedure PlayGame;
Begin
TextColor(LightGray);
repeat
if key <> 'p' then
key := #0;
if Keypressed then begin key := readkey;DrawSquares(key);end;
if key <> 'p' then
inc(TimeDown);
if TimeDown >= Speed then
begin
DrawSquares(_Down);
TimeDown := 0;
end;
until (key = _EsCape) or GameOver;
if Gameover then
begin
Gotoxy(1,_Cols div 2);
TextColor(Red+Blink);
Write('G A M E O V E R');
readln;
NewGame;
end
else GameStart := False;
clrscr;
SetCusor(32,0);
End;
Procedure Menu;
var Local,Choose,space,i: integer;
k: char;
Items: array[1..4] of string[20];
Begin
TextColor(White);
Choose := 1;
Local := 1;
Items[1] := '1.New Game';
Items[2] := '2.Continue';
Items[3] := '3.Introduce';
Items[4] := '4.Escape';
repeat
TextColor(Cyan);
Gotoxy(10,8);Write('Menu:');
k := #0;
if keypressed then k := readkey;
if k = #80 then inc(Local)
else if k = #72 then inc(Local,-1)
else if k = #13 then
begin
Choose := Local;
case Choose of
1: begin
NewGame;
PlayGame;
end;
2:
if not GameStart then
begin
TextMode(Co40);
SetCusor(32,0);
ShowScore;
for i := 1 to 4 do
begin
Gotoxy(_Rows div 2 + NextCubes[i].X + 6,NextCubes[i].Y+11);
Write(#219);
Gotoxy(_Rows + 3,6);
Write('N E X T: ');
end;
PlayGame;
end;
3: InTroDuce;
end;
end;
if Local < 1 then Local := 4
else if Local > 4 then Local := 1;
for i := 1 to 4 do
begin
space := 0;
if Local <> i then TextColor(White)
else begin TextColor(Green);Space := 1;
if GameStart and (i = 2) then TextColor(8);
end;
Gotoxy(Space+i*2,9+i);Write(' ' + Items[i]+' ');
end;
until Choose = 4;
End;
BEGIN
clrscr;
Randomize;
TextMode(Co40);
SetCusor(32,0);
GameStart := True;
Menu;
END.
