经典俄罗斯方块代码（转javascript代码）

unit Block_Unit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.ExtCtrls;

type
  TBlockForm = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    procedure WMMyKey(var Msg: TWMKeyDown); message WM_KEYDOWN;
  public
  end;
type
  TIntArr=array of TArray<Integer>;
type TBlock=record
  x,y,s:Integer;
  fk:array [0..3] of Integer;//fk记录方块，4X4二进制矩阵
end;
var
  BlockForm: TBlockForm;
  Map:array  of Integer;
  Tetris: TIntArr= [[$6600],//方块，二进制数据显示方块
                    [$2222, $0f00],//I型
                    [$c600, $2640],//Z型
                    [$6c00, $4620],//反Z型
                    [$4460, $2e0, $6220, $740],//L型
                    [$2260, $0e20, $6440, $4700], //反L型
                    [$2620, $720, $2320, $2700]]; //T型;
  pos,bak:TBlock;//pos当前方块数据，bak备份当前方块数据
  dia:TArray<Integer>;
  rs:TResourceStream;
procedure Rotate(r:Integer);
procedure GameStart;
procedure UpdateMap(b:Boolean);
function HaveBlock:Boolean;
procedure BlockMove(r:Integer);
implementation
  uses Vcl.Imaging.jpeg;
var
  Green,Red:TJPEGImage;
{$R *.dfm}
{此游戏的核心思路是用二进制来记录整个界面的变化，
每个方块设定为4X4的二进制矩阵，整个游戏界面设定为10列、22行。}
{初始化方块}
procedure GameStart;
begin
  dia:=Tetris[Random(7)];//随机方块类别
  pos.x:=4;//初始位置
  pos.y:=0;
  pos.s:=Random(Length(dia));//随机方块形态
  bak:=pos;
  Rotate(0);
end;
{方块旋转}
procedure Rotate(r:Integer);
var
  f,i:Integer;
begin
  //根据方块的形态多少来依次旋转方块
  pos.s:=(pos.s+r) mod Length(dia);
  f:=dia[pos.s];
  for i:= 0 to 3 do
  //旋转变换
      pos.fk[i]:=(f shr (12-i*4) and $F) shl (8-pos.x);
  updateMap(HaveBlock);
end;
{更新界面}
procedure UpdateMap(b:Boolean);
begin
  if b=False then
  begin
    bak:=pos;
    BlockForm.Repaint;
  end;
end;
{判断障碍物}
function HaveBlock:Boolean;
var
  i:Integer;
begin
  Result:=False;
  for I := 0 to 3 do
    if pos.fk[i] and Map[pos.y+i]<>0 then
    begin
      pos:=bak;
      Result:=True;
      Break;
    end;
end;
{游戏结束}
procedure GameOver;
begin
  BlockForm.Timer1.Enabled:=False;
  ShowMessage('GameOver!');
end;
{游戏运行，关键代码}
procedure BlockDown;
begin
  Inc(pos.y);
  if HaveBlock then
  begin
     for var  i:Integer:= 0 to 3 do
     begin
       if  pos.y+i>=22 then Break;
       Map[pos.y+i]:=Map[pos.y+i] or pos.fk[i];//“或”操作来改变数据
       if Map[pos.y+i]=$FFF then//二进制表示满行
       begin
         Delete(Map,pos.y+i,1);//消除满行
         Insert([$801],Map,0);//插入空行
       end;
     end;
    if Map[1]<>$801 then//第一行不为空游戏结束
       GameOver;
     GameStart;
  end;
  UpdateMap(False);
end;
{方块左右移动，-1为左，1为右}
procedure BlockMove(r:Integer);
var
 i:Integer;
begin
  Inc(pos.x,r);
  for I := 0 to 3 do
  begin
    if r=1 then
       pos.fk[i]:=pos.fk[i] shr 1
    else
       pos.fk[i]:=pos.fk[i] shl 1;
  end;
  UpdateMap(HaveBlock);
end;
procedure TBlockForm.Button1Click(Sender: TObject);
begin
  //$801的二进制为100000000001
  for var I:Integer := 0 to 21 do Map[i]:=$801;
  Map[22]:=$FFF;
  //以上代码利用二进制初始化游戏界面，即为
  //100000000001
  //100000000001
  //............
  //111111111111
  GameStart;
  Button1.Enabled:=False;
end;

procedure TBlockForm.FormCreate(Sender: TObject);
var
 st:TMemoryStream;
begin
  DoubleBuffered:=True;
  SetLength(Map,23);//设定共23行，其中最后一行为判断是否触底用
  Randomize;
  rs := TResourceStream.Create(HInstance, 'Green', RT_RCDATA);
  Green:=TJPEGImage.Create;
  Red:=TJPEGImage.Create;
  Green.LoadFromStream(rs);
  rs.Free;
  rs:=TResourceStream.Create(HInstance, 'Red', RT_RCDATA);
  Red.LoadFromStream(rs);
  rs.Free;
end;
procedure TBlockForm.WMMyKey(var Msg: TWMKeyDown);
begin
  //输入法要切换成英文，只能发送给有焦点的Form来响应
  if (Msg.CharCode=VK_UP)or(Msg.CharCode=ord('W')) then Rotate(1);
  if (Msg.CharCode=VK_DOWN)or(Msg.CharCode =ord('S') ) then BlockDown;
  if (Msg.CharCode=VK_LEFT)or(Msg.CharCode = 65) then BlockMove(-1);
  if (Msg.CharCode=VK_RIGHT)or(Msg.CharCode =ord('D')) then BlockMove(1);
  if Msg.CharCode=VK_ESCAPE then //使Button起作用
  begin
    Button1.Enabled:=true;
    Button1.SetFocus;
  end;

end;

procedure TBlockForm.FormPaint(Sender: TObject);
var
  i,j,k:Integer;
begin
  Canvas.Brush.Style:=bsSolid;
  Canvas.Brush.Color:=RGB(255,255,255);
  Canvas.FillRect(Rect(0,0,150,330));
  for I := 0 to 21 do
  begin
    for j := 0 to 9 do
    begin
      k:=Map[i] shr (10-j) and 1;//判断是否触底，触底则变绿
      if k=1 then
        //Canvas.FillRect(Rect(j*15+1,i*15+1,j*15+14,i*15+14));
        Canvas.Draw(j*15+1,i*15+1,Green);
    end;
  end;
  Canvas.Brush.Color:=RGB(255,0,0);
  for I :=0 to 3 do
  begin
    for j := 0 to 9 do
    begin
      k:=bak.fk[i] shr (10-j) and 1;
      if k=1 then//不触底则以红色来画方块
        Canvas.Draw(j*15+1,(i+bak.y)*15+1,Red);
        //Canvas.FillRect(Rect(j*15+1,(i+bak.y)*15+1,j*15+14,(i+bak.y)*15+14));
    end;
  end;
end;

procedure TBlockForm.Timer1Timer(Sender: TObject);
begin
  BlockDown;
end;

end.
//其中Red、Green两个图片大小为15X15像素的资源，如不用资源文件，可以去掉Draw，改用FillRect。