- 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.
Mã:
program tetris;
uses crt,dos;
var colr,Row_:integer;
const Rows=20;
cols=7;
var
n,Speed,Point,Lever:integer;
co :array [1..Rows,1..Cols] of Integer;
line: array[1..Rows] of Boolean;
Table : array [1..Rows,1..Cols] of Boolean;
Color: array[0..1000] of integer;
files:text;
Maxpoint:integer;
Type Twhere = (Behind,Down,Left,Right);
TTable = object
Coloor: array[1..Rows,1..Cols] of Boolean;
procedure ReDraw;
end;
TUnomino = object (TTable)
Row,Col : Byte;
function Hightline:Boolean;
function IsLine: Boolean;
procedure HightClear;
procedure Init;
procedure Show;
procedure Hide;
procedure Done;
procedure Move(Where : TWhere);
function Check(Where : TWhere) : Boolean;
procedure PaintColor;
end;
procedure setcusor(bot,top: byte);
var regs : registers;
begin
regs.ah :=1;
regs.ch:=bot;
regs.cl:=top;
intr($10,regs);
end;
procedure TTable.ReDraw;
var i,j : Byte;
begin
GoToXy(1,1);
for j:=1 to Rows do
begin
for i:=1 to Cols do
if Table[j,i] then begin
textcolor(co[j,i]);
Write(#219);end else
begin textcolor(8);
Write(#250);end;
Writeln;
end;
for i:=1 to Rows do begin
Textcolor(8);
gotoxy(cols+1,i);write(#179);end;
for i:=1 to cols do begin
gotoxy(i,Rows+1);write(#196);
gotoxy(Cols+1,Rows+1);write(#217);
end;
end;
function TUnomino.Isline: boolean;
var i,j:integer;
begin
If ((Co[Row,Col]=Co[Row,Col+1])
and (Co[Row,Col]=Co[Row,Col+2]))
then begin
Isline:=True;
for i:=Row downto 2 do begin
Table[i,Col]:=Table[i-1,Col];
Table[i,Col+1]:=Table[i-1,Col+1];
Table[i,Col+2]:=Table[i-1,Col+2];
Co[i,Col]:=Co[i-1,Col];
Co[i,Col+1]:=Co[i-1,Col+1];
Co[i,Col+2]:=Co[i-1,Col+2];
end;
end;
if ((Co[Row,Col]=Co[Row,Col+1])
and (Co[Row,Col]=Co[Row,Col-1]))
then begin
IsLine:=True;
for i:=Row downto 2 do begin
Table[i,Col]:=Table[i-1,Col];
Table[i,Col+1]:=Table[i-1,Col+1];
Table[i,Col-1]:=Table[i-1,Col-1];
Co[i,Col]:=Co[i-1,Col];
Co[i,Col+1]:=Co[i-1,Col+1];
Co[i,Col-1]:=Co[i-1,Col-1];
end;
end;
if ((Co[Row,Col]=Co[Row,Col-2])
and (Co[Row,Col]=Co[Row,Col-1]))
then begin
IsLine:=True;
for i:=Row downto 2 do begin
Table[i,Col]:=Table[i-1,Col];
Table[i,Col-2]:=Table[i-1,Col-2];
Table[i,Col-1]:=Table[i-1,Col-1];
Co[i,Col]:=Co[i-1,Col];
Co[i,Col-2]:=Co[i-1,Col-2];
Co[i,Col-1]:=Co[i-1,Col-1];
end;
end;
end;
procedure TUnomino.HightClear;
begin
Table[Row,Col]:=False;
Table[Row+1,Col]:=False;
Table[Row+2,Col]:=False;
Co[Row,Col]:=16;
Co[Row+1,Col]:=16;
Co[Row+2,Col]:=16;
end;
function TUnomino.Hightline: Boolean;
begin
if (Co[Row,Col]=Co[Row+1,Col])
and (Co[Row,Col]=Co[Row+2,Col]) then Hightline:=True;
end;
procedure TUnomino.Init;
begin
Row:=1;
Col:=4;
end;
procedure TUnomino.Show;
begin
if point<=20 then Speed:=150
else If point<=50 then Speed:=100
else Speed:=50;
Textcolor(colr);
GoToXy(Col,Row);
write(#219);
gotoxy(15,5);
textcolor(color[n+1]);
write(#219);
gotoxy(30,5);
textcolor(color[n-1]);
write(#219);
textcolor(8);
gotoxy(13,3);write('Next:');
gotoxy(28,3);write('Last:');
gotoxy(13,9);write('Point:');
gotoxy(15,11);write(point);
gotoxy(28,9);write('Max Point:');
gotoxy(30,11);write(maxpoint);
GoToXy(80,50);
Delay(Speed);
end;
procedure TUnomino.Hide;
begin
GoToXy(Col,Row);
textcolor(8);
Write(#250);
Gotoxy(80,50);
end;
procedure TUnomino.Move(Where : TWhere);
begin
case Where of
Down : Inc(Row);
Right : Inc(Col);
Left : Dec(Col);
end;
end;
function TUnomino.Check(Where : TWhere) : Boolean;
begin
case Where of
Down : if (Row+1<=Rows) then Check:=Table[Row+1,Col];
Right : if (Row+1<=Rows) and (col<=cols-1) then Check:=Table[Row,Col+1];
Left : if (Col-1>=1) then Check:=Table[Row,Col-1];
Behind : Check:=Table[Row,Col];
end;
end;
procedure TUnomino.Done;
begin
Table[Row,Col]:=True;
Co[Row,Col]:=Colr;
n:=n+1;
end;
procedure Tunomino.PaintColor;
begin
randomize;
repeat
color[n+1]:=Random(16);
until color[n+1]>0;
colr:=color[n];
end;
Const TheEnd : Boolean = False;
Var Unomino : TUnomino;
Ch : Char;
procedure ReWriteln;
begin
if point>=Maxpoint then begin
Rewrite(files);
write(files,point);
close(files);
end;
end;
Begin
assign(files,'C:\MaxPoint.txt');
Reset(files);
read(files,Maxpoint);
close(files);
clrscr;
TextMode(Co40);
with Unomino do
begin
n:=1;
Color[1]:=6;
ReDraw;
Init;
PaintColor;
repeat
Setcusor(32,3);
Show;
Ch:=#0;
while Keypressed do Ch:=ReadKey;
Hide;
case Ch of
#77 : If Check(Right)=False then Move(Right);
#75 : if Check(Left)=False then Move(Left);
'p' : repeat
Show;
until readkey='p';
#27 : TheEnd:=True
else
if Check(Down)=False then Move(Down)
else begin
Done;
Show;
if (Isline=True) then begin
point:=point+1;
ReDraw;end;
if Hightline=True then
begin
Point:=Point+1;
HightClear;
ReDraw;
end;
Init;
PaintColor;
if Check(Behind) then TheEnd:=True;
end;
end;
until TheEnd;
Rewriteln;
end;
End.
