//Tetris został pobrany ze strony www.algorytm.org
//(c)2001 Michał Knasiecki
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, ComCtrls, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Gra1: TMenuItem;
    Nowa1: TMenuItem; 
    Halloffame1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Help1: TMenuItem;
    Index1: TMenuItem;
    N2: TMenuItem;
    About1: TMenuItem;
    Pause1: TMenuItem;
    Shape1: TShape;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    PaintBox1: TPaintBox;
    Bevel1: TBevel;
    Label1: TLabel;
    Label2: TLabel;
    Panel1: TPanel;
    Label3: TLabel;
    Bevel2: TBevel;
    Label4: TLabel;
    procedure Exit1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Nowa1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Pause1Click(Sender: TObject);
    procedure Index1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Halloffame1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure start;
    procedure add_to_best;

  end;

var
  Form1: TForm1;
  stat:record
        name:string;
        level:integer;
        points:integer;
        time:longint;
        end;
  data:array[1..11]of record
        name:string;
        score:integer;
        level:byte;
        time:longint;
        end;
        counter:byte;
  block:array[1..4,1..4]of boolean;
  desk:array[0..18,1..26]of shortint;
  block_ID:byte;
  block_state:byte;
  xpos,ypos:byte;
  speed:byte;
  velocity:byte;
  bl:boolean;
  bonus:integer;
implementation

uses Unit2, player, endgame, hall;

{$R *.DFM}
procedure quicksortR_middle(l,r: Integer);
var i,j,v,q1,q2,q3 : Integer;
q:string;
begin
i:=l; j:=r; v:=data[(l+r) div 2].score;
 repeat
  while (data[i].score<v)  do i:=i+1;
  while (v<data[j].score)  do j:=j-1;
   if i<=j then
    begin
     q1:=data[i].score; data[i].score:=data[j].score; data[j].score:=q1;
     q2:=data[i].level; data[i].level:=data[j].level; data[j].level:=q2;
     q3:=data[i].time; data[i].time:=data[j].time; data[j].time:=q3;
     q:=data[i].name; data[i].name:=data[j].name; data[j].name:=q;
     i:=i+1; j:=j-1;
     end;
  until i>j;
if l<j then quicksortR_middle(l,j);
if i<r then quicksortR_middle(i,r);
end;
procedure Tform1.add_to_best;
var tmp:textfile;
i:byte;
begin
data[11].name:=stat.name;
data[11].score:=stat.points+bonus;
data[11].level:=stat.level;
data[11].time:=stat.time;
quicksortR_middle(1,11);
assignfile(tmp,'Hall.dat');
rewrite(tmp);
for i:=11 downto 2 do
if data[i].name<>'Nobody' then
begin
writeln(tmp,data[i].name);
writeln(tmp,inttostr(data[i].score));
writeln(tmp,inttostr(data[i].level));
writeln(tmp,inttostr(data[i].time));
end;
closefile(tmp);
end;
procedure results;
var tmp:textfile;
i,j:byte;
s:string;
begin
if fileexists('Hall.dat') then
begin
assignfile(tmp,'Hall.dat');
reset(tmp);
i:=0;
while not eof(tmp) do
begin
inc(i);
readln(tmp,s);
data[i].name:=s;
readln(tmp,s);
data[i].score:=strtoint(s);
readln(tmp,s);
data[i].level:=strtoint(s);
readln(tmp,s);
data[i].time:=strtoint(s);
end;
closefile(tmp);
quicksortR_middle(1,i);
for j:=1 to i do
begin
form5.stringgrid1.cells[1,i-j+1]:=data[j].name;
form5.stringgrid1.cells[2,i-j+1]:=inttostr(data[j].score);
form5.stringgrid1.cells[3,i-j+1]:=inttostr(data[j].level);
form5.stringgrid1.cells[4,i-j+1]:=inttostr(data[j].time);
end;
end;
end;
procedure end_of_game;
var i,j:integer;
begin
for j:=25 downto 1 do
begin
sleep(50);
for i:=1 to 17 do
begin
form1.paintbox1.Canvas.Brush.Color:=$800ff;
form1.paintbox1.Canvas.Pen.Color:=clwhite;
form1.paintbox1.canvas.Rectangle(i*15-15,j*15-15,i*15,j*15);
end;
end;
sleep(100);
for j:=1 to 25 do
begin
sleep(50);
for i:=1 to 17 do
begin
form1.paintbox1.Canvas.Brush.Color:=$00FF8000;
form1.paintbox1.Canvas.Pen.Color:=$00FF8000;
form1.paintbox1.canvas.Rectangle(i*15-15,j*15-15,i*15,j*15);
end;
end;
form4.Label8.caption:=stat.name;
form4.Label9.caption:=inttostr(stat.level);
form4.Label10.caption:=inttostr(stat.points);
form4.Label11.caption:=inttostr(stat.time);
form4.Label12.caption:=inttostr(bonus);
form4.Label13.caption:=inttostr(stat.points+bonus);
form4.show;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
if MessageDlg('Do You want to exit this program ?', 
      mtConfirmation,[mbYes, mbNo],0) = mrYes 
 then
application.terminate
 else 
end;
procedure get_block(id,state:byte);
var i,j:integer;
begin
for i:=1 to 4 do for j:=1 to 4 do block[i,j]:=false;
case id of
1:
        begin
        if state=1 then
                begin
                block[2,1]:=true;
                block[2,2]:=true;
                block[2,3]:=true;
                block[2,4]:=true;
                end;
        if state=2 then
                begin
                block[1,2]:=true;
                block[2,2]:=true;
                block[3,2]:=true;
                block[4,2]:=true;
                end;
        end;
2:      begin
                block[2,2]:=true;
                block[3,3]:=true;
                block[2,3]:=true;
                block[3,2]:=true;
        end;
3:
        begin
        if state=1 then
                begin
                block[2,2]:=true;
                block[1,3]:=true;
                block[2,3]:=true;
                block[3,3]:=true;
                end;
        if state=2 then
                begin
                block[1,2]:=true;
                block[1,3]:=true;
                block[2,3]:=true;
                block[1,4]:=true;
                end;
        if state=3 then
                begin
                block[1,2]:=true;
                block[3,2]:=true;
                block[2,2]:=true;
                block[2,3]:=true;
                end;
        if state=4 then
                begin
                block[2,1]:=true;
                block[1,2]:=true;
                block[2,2]:=true;
                block[2,3]:=true;
                end;

        end;
4:
        begin
        if state=1 then
                begin
                block[2,1]:=true;
                block[2,2]:=true;
                block[2,3]:=true;
                block[3,3]:=true;
                end;
        if state=2 then
                begin
                block[1,3]:=true;
                block[2,3]:=true;
                block[3,3]:=true;
                block[3,2]:=true;
                end;
        if state=3 then
                begin
                block[2,1]:=true;
                block[3,1]:=true;
                block[3,2]:=true;
                block[3,3]:=true;
                end;
        if state=4 then
                begin
                block[1,2]:=true;
                block[1,3]:=true;
                block[2,2]:=true;
                block[3,2]:=true;
                end;

        end;
5:
        begin
        if state=1 then
                begin
                block[3,1]:=true;
                block[3,2]:=true;
                block[3,3]:=true;
                block[2,3]:=true;
                end;
        if state=2 then
                begin
                block[2,2]:=true;
                block[2,3]:=true;
                block[3,3]:=true;
                block[4,3]:=true;
                end;
        if state=3 then
                begin
                block[2,1]:=true;
                block[3,1]:=true;
                block[2,2]:=true;
                block[2,3]:=true;
                end;
        if state=4 then
                begin
                block[2,2]:=true;
                block[3,2]:=true;
                block[4,2]:=true;
                block[4,3]:=true;
                end;

        end;
6:
        begin
        if state=1 then
                begin
                block[3,2]:=true;
                block[4,2]:=true;
                block[3,3]:=true;
                block[2,3]:=true;
                end;
        if state=2 then
                begin
                block[2,2]:=true;
                block[2,3]:=true;
                block[3,3]:=true;
                block[3,4]:=true;
                end;
        end;
7:
        begin
        if state=1 then
                begin
                block[2,2]:=true;
                block[3,2]:=true;
                block[3,3]:=true;
                block[4,3]:=true;
                end;
        if state=2 then
                begin
                block[3,2]:=true;
                block[2,3]:=true;
                block[3,3]:=true;
                block[2,4]:=true;
                end;
        end;
end;
end;
procedure refresh_desk;forward;
procedure erase(i:byte);
var x,j:byte;
begin
for j:=1 to 17 do desk[j,i]:=0;
for j:=i-1 downto 1 do
begin
sleep(5);
for x:=1 to 17 do
begin
desk[x,j+1]:=desk[x,j];
desk[x,j]:=0;
end;
end;
form1.PaintBox1.refresh;
end;
function line(x:byte):boolean;
var i:byte;
begin
result:=true;
for i:=1 to 17 do if desk[i,x]=0 then result:=false;
end;
procedure stop; forward;
procedure new_block;
var j:byte;
points:byte;
begin
repeat
block_ID:=random(7);
until (block_ID>=1)and(block_ID<=7);
block_state:=1;
get_block(block_ID,block_state);
xpos:=8;
ypos:=0;
bl:=true;
points:=0;
for j:=1 to 25 do
if line(j) then
begin
erase(j);
inc(points);
end;
case points of
1:inc(stat.points,5);
2:inc(stat.points,15);
3:inc(stat.points,40);
4:inc(stat.points,75);
end;
form1.statusbar1.Panels[2].text:='Points:'+inttostr(stat.points);
if (stat.points>=250)and(stat.level=1) then
begin
stat.level:=2;
velocity:=4;
form1.label3.Caption:='Next level: 500';
if 500-stat.time>0 then inc(bonus,500-stat.time);
end;
if (stat.points>=500)and(stat.level=2) then
begin
stat.level:=3;
velocity:=3;
form1.label3.Caption:='Next level: 800';
if 1000-stat.time>0 then inc(bonus,1000-stat.time);
end;
if (stat.points>=800)and(stat.level=3) then
begin
form1.label3.Caption:='Next level: 1500';
stat.level:=4;
velocity:=1;
if 1600-stat.time>0 then inc(bonus,1600-stat.time);
end;
if (stat.points>=1500)and(stat.level=4) then
begin
stat.level:=5;
velocity:=0;
form1.label3.Caption:='Next level:infinity';
if 2200-stat.time>0 then inc(bonus,2200-stat.time);
end;
form1.statusbar1.Panels[1].text:='Level:'+inttostr(stat.level);
for j:=1 to 17 do if desk[j,1]<>0 then
begin
end_of_game;
stop;
break;
end;
end;
procedure Dell_from_desk(x,y:byte);
var i,j:byte;
begin
form1.paintbox1.Canvas.Brush.Color:=$ff8000;
form1.paintbox1.Canvas.Pen.Color:=$ff8000;
for i:=1 to 4 do
for j:=1 to 4 do
if block[i,j]=true then
form1.paintbox1.canvas.Rectangle(i*15+x*15-30,j*15+y*15-30,i*15+x*15-15,j*15+y*15-15);
form1.paintbox1.Canvas.Brush.Color:=clred;
form1.paintbox1.Canvas.Pen.Color:=clwhite;
end;
procedure print_on_desk(x,y:byte);
var i,j:byte;
begin
form1.paintbox1.canvas.Pen.Color:=clwhite;
form1.paintbox1.canvas.Brush.Color:=clred;
for i:=1 to 4 do
for j:=1 to 4 do
if block[i,j]=true then
form1.paintbox1.canvas.Rectangle(i*15+x*15-30,j*15+y*15-30,i*15+x*15-15,j*15+y*15-15);
end;
procedure refresh_desk;
var i,j:byte;
begin
for i:=1 to 17 do for j:=1 to 25 do
if desk[i,j]<>0 then
begin
case desk[i,j]of
1:form1.paintbox1.canvas.brush.color:=clnavy;
2:form1.paintbox1.canvas.brush.color:=clblue;
3:form1.paintbox1.canvas.brush.color:=clpurple;
4:form1.paintbox1.canvas.brush.color:=clgreen;
5:form1.paintbox1.canvas.brush.color:=clteal;
6:form1.paintbox1.canvas.brush.color:=clmaroon;
7:form1.paintbox1.canvas.brush.color:=clfuchsia;
end;
form1.paintbox1.canvas.Rectangle(i*15-15,j*15-15,i*15,j*15);
end;
print_on_desk(xpos,ypos);
end;
function check(x,y,dir:byte):boolean;
var i,j:byte;
begin
result:=true;
//Down
if dir=1 then
begin
for i:=1 to 4 do
for j:=1 to 4 do
if block[i,j]=true then
        if  desk[i+x-1,j+y-1+1]<>0 then result:=false;
        end;
//Left
if dir=2 then
begin
for i:=1 to 4 do
for j:=1 to 4 do
if block[i,j]=true then
        if  desk[i+x-1-1,j+y-1]<>0 then result:=false;
        end;
//Left
if dir=3 then
begin
for i:=1 to 4 do
for j:=1 to 4 do
if block[i,j]=true then
        if  desk[i+x-1+1,j+y-1]<>0 then result:=false;
        end;
end;
procedure dock_block(x,y:byte);
var i,j:integer;
begin
case block_ID of
1:form1.paintbox1.canvas.brush.color:=clnavy;
2:form1.paintbox1.canvas.brush.color:=clblue;
3:form1.paintbox1.canvas.brush.color:=clpurple;
4:form1.paintbox1.canvas.brush.color:=clgreen;
5:form1.paintbox1.canvas.brush.color:=clteal;
6:form1.paintbox1.canvas.brush.color:=clmaroon;
7:form1.paintbox1.canvas.brush.color:=clfuchsia;
end;
for i:=1 to 4 do
for j:=1 to 4 do
if block[i,j]=true then
begin
form1.paintbox1.canvas.Rectangle(i*15+x*15-30,j*15+y*15-30,i*15+x*15-15,j*15+y*15-15);
desk[i+x-1,j+y-1]:=block_ID;
end;
new_block;
end;
procedure TForm1.About1Click(Sender: TObject);
begin
aboutbox.show;
end;
procedure reset;
var i,j:byte;
begin
for i:=1 to 4 do for j:=1 to 4 do block[i,j]:=false;
for i:=1 to 17 do for j:=1 to 25 do desk[i,j]:=0;
for i:=1 to 24 do
begin
desk[0,i]:=-1;
desk[18,i]:=-1;
end;
for i:=1 to 17 do desk[i,26]:=-1;
end;
procedure stop;
begin
form1.timer1.enabled:=false;
form1.statusbar1.panels[0].text:='Game Over';
form1.statusbar1.panels[1].text:='';
form1.statusbar1.panels[2].text:='';
form1.statusbar1.panels[3].text:='';
form1.label3.visible:=false;
form1.label4.visible:=false;
reset;
form1.paintbox1.Refresh;
form1.pause1.caption:='Pause/Resume';
form1.pause1.Enabled:=false;
block_ID:=0;
end;

procedure TForm1.Nowa1Click(Sender: TObject);
begin
if timer1.enabled then
begin
timer1.enabled:=false;
if messagedlg('You are playing now '+stat.name+'. Do You want to quit this game and start New Game?',mtconfirmation,
[mbYes,mbNo],0)=mrYes then
begin
stop;
form3.show;
end
else
timer1.enabled:=true;
end
else form3.show;
end;
procedure Tform1.start;
begin
bonus:=0;
label3.visible:=true;
label3.Caption:='Next level: 250';
label4.visible:=true;
if form5.stringgrid1.cells[1,1]<>'' then label4.Caption:='Best: '+form5.stringgrid1.cells[1,1]+
' ('+form5.stringgrid1.cells[2,1]+')' else
label4.caption:='Best: nobody';
reset;
velocity:=10;
stat.name:=statusbar1.Panels[0].text;
stat.level:=1;
stat.points:=0;
stat.time:=0;
counter:=0;
pause1.enabled:=true;
pause1.caption:='Pause';
new_block;
timer1.enabled:=true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if counter<20 then inc(counter) else
begin
counter:=0;
inc(stat.time);
statusbar1.panels[3].text:=inttostr(stat.time);
end;
if bl=true then
begin
if speed<velocity then inc(speed) else
begin
if check(xpos,ypos,1)=true
then
begin
dell_from_desk(xpos,ypos);
inc(ypos);
print_on_desk(xpos,ypos);
end else
begin
bl:=false;
dock_block(xpos,ypos);
end;
speed:=0;
end;
end;
end;

procedure TForm1.Pause1Click(Sender: TObject);
begin
timer1.enabled:=not(timer1.enabled);
if timer1.Enabled=false then
begin
statusbar1.panels[3].text:='Pause';
paintbox1.Repaint;
pause1.caption:='Resume';
label1.visible:=true;
label2.visible:=true;
end
else
begin
pause1.caption:='Pause';
label1.visible:=false;
label2.visible:=false;
paintbox1.Repaint;
end;
end;

procedure TForm1.Index1Click(Sender: TObject);
begin
Application.HelpCommand(HELP_FINDER, 0);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
  var t:boolean;s:byte;
begin
if key=40 then begin
if check(xpos,ypos,1)=true
then
begin
dell_from_desk(xpos,ypos);
inc(ypos);
print_on_desk(xpos,ypos);
end else dock_block(xpos,ypos);
end;
if key=37 then begin
if check(xpos,ypos,2)=true
then
begin
dell_from_desk(xpos,ypos);
dec(xpos);
print_on_desk(xpos,ypos);
end;
end;
if key=39 then begin
if check(xpos,ypos,3)=true
then
begin
dell_from_desk(xpos,ypos);
inc(xpos);
print_on_desk(xpos,ypos);
end;
end;
if key=32 then
begin
dell_from_desk(xpos,ypos);
t:=false;
case block_ID of
1:
        begin
        if (block_state=1)and(t=false) then
        begin
        t:=true;
        s:=block_state;
        block_state:=2;
        get_block(block_ID,block_state);
        if check(xpos,ypos,1)=false then block_state:=s;
        end;
        if (block_state=2)and(t=false) then
        begin
        s:=block_state;
        block_state:=1;
        get_block(block_ID,block_state);
        if check(xpos,ypos,1)=false then block_state:=s;
        end;
        end;
3,4,5:
        begin
        if (block_state<4)and(t=false) then
        begin
        t:=true;
        s:=block_state;
        inc(block_state);
        get_block(block_ID,block_state);
        if check(xpos,ypos,1)=false then block_state:=s;
        end;
        if (block_state=4)and(t=false) then
        begin
        s:=block_state;
        block_state:=1;
        get_block(block_ID,block_state);
        if check(xpos,ypos,1)=false then block_state:=s;
        end;
end;
6,7:
        begin
        if (block_state=1)and(t=false) then
        begin
        t:=true;
        s:=block_state;
        block_state:=2;
        get_block(block_ID,block_state);
        if check(xpos,ypos,1)=false then block_state:=s;
        end;
        if (block_state=2)and(t=false) then
        begin
        s:=block_state;
        block_state:=1;
        get_block(block_ID,block_state);
        if check(xpos,ypos,1)=false then block_state:=s;
        end;
        end;

end;
get_block(block_id,block_state);
print_on_desk(xpos,ypos);
end;
end;
procedure TForm1.FormActivate(Sender: TObject);
var i:integer;
begin
randomize;
for i:=1 to 11 do
begin
data[i].name:='Nobody';
data[i].score:=0;
data[i].level:=0;
data[i].time:=0;
end;
results;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
refresh_desk;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
end_of_game;
end;

procedure TForm1.Halloffame1Click(Sender: TObject);
begin
form5.show;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if MessageDlg('Do You want to exit this program ?', 
      mtConfirmation,[mbYes, mbNo],0) = mrYes 
 then
  Action := caFree
 else
  Action := caNone;
end;

end.