Tin học Game Xếp hình (Tetris) viết bằng Pascal
- Thread starter trà nguyễn hữu nghĩa
- Ngày gửi
- Replies 61
- Views 7,428
-
- Tags
- @ka1412 @vuiotechnologies
Bạn copy vào sai thư mục r. Với cả cái kia là text chứ không phải là .pas
- 10 Tháng mười một 2013
- 1,559
- 2,715
- 386
- 25
- Cần Thơ
- Đại học Cần Thơ
Code ổn đó e hihi :
Hồi xưa a cũng viết 1 con flappy bird nhưng hơi thuần Dos e ạ:
Hồi xưa a cũng viết 1 con flappy bird nhưng hơi thuần Dos e ạ:
- 14 Tháng năm 2017
- 3,974
- 7,623
- 744
- 22
- Phú Yên
- Trường THPT Lương Văn Chánh
- 10 Tháng mười một 2013
- 1,559
- 2,715
- 386
- 25
- Cần Thơ
- Đại học Cần Thơ
Ừm e, có nạp asset từ file, sử dụng hệ đồ họa VGA 320x200, driver tự viết bằng assembly
- 14 Tháng năm 2017
- 3,974
- 7,623
- 744
- 22
- Phú Yên
- Trường THPT Lương Văn Chánh
- 10 Tháng mười một 2013
- 1,559
- 2,715
- 386
- 25
- Cần Thơ
- Đại học Cần Thơ
- 14 Tháng năm 2017
- 3,974
- 7,623
- 744
- 22
- Phú Yên
- Trường THPT Lương Văn Chánh
Dạ không a. Lúc đầu e định học Pascal cho vui, nhưng không biết từ khi nào mê lập trình game. Em cũng chỉ biết mỗi làm game thôi, mấy cái khác e không biết gì cả
- 10 Tháng mười một 2013
- 1,559
- 2,715
- 386
- 25
- Cần Thơ
- Đại học Cần Thơ
- 14 Tháng năm 2017
- 3,974
- 7,623
- 744
- 22
- Phú Yên
- Trường THPT Lương Văn Chánh
e biết dùng C#, định học unity rồi mà máy e yếu down về không được (E dùng tạm Gamemaker)
- 10 Tháng mười một 2013
- 1,559
- 2,715
- 386
- 25
- Cần Thơ
- Đại học Cần Thơ
- 14 Tháng năm 2017
- 3,974
- 7,623
- 744
- 22
- Phú Yên
- Trường THPT Lương Văn Chánh
E chủ yếu viết Code a, do e vẽ max xấu nên chỉ vẽ sơ xài thôi
Spam quá rồi a ơi, vào wall a nha
- 14 Tháng năm 2017
- 3,974
- 7,623
- 744
- 22
- Phú Yên
- Trường THPT Lương Văn Chánh
bạn Paste vào file gốc của nó chứ Paste vào Pascal là không được đâu, nó không hỗ trợ
- 14 Tháng năm 2017
- 3,974
- 7,623
- 744
- 22
- Phú Yên
- Trường THPT Lương Văn Chánh
Và đây cũng là một Code Tetris nha, giống hệt phiên bản của người ta luôn.
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: 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 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
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;
TextMode(Co40);
SetCusor(32,0);
GameStart := True;
Menu;
END.- 10 Tháng mười 2018
- 5
- 0
- 1
- 22
- TP Hồ Chí Minh
- THPT Nguyễn Công Trứ
- 14 Tháng năm 2017
- 3,974
- 7,623
- 744
- 22
- Phú Yên
- Trường THPT Lương Văn Chánh
