{  俄羅斯方塊核心控制單元  }
unit UBox;

interface

uses
  Windows,SysUtils, Graphics;

//---------------------------------------------------------------------
const
  BWid   = 15;            //顯示在屏幕上的象素點(diǎn)數(shù)
  MLen   = 4 ;            //方塊數(shù)組的寬度
  BNum   = 7 ;            //方塊的個(gè)數(shù)
  MapWid = 20;            //背景地圖的寬度（按格子數(shù)）
  MapHei = 30;            //背景地圖的高度
  BkLeft = -30;           //左邊距離
  BkTop  = 10 ;           //頂點(diǎn)距離
  EmptyBlock    = false;  //空的格子
  NotEmptyBlock = true;   //非空的格子

//---------------------------------------------------------------------
type
   TBlockCell=record
      Empty: Boolean;
      Color: TColor;
   end;

//---------------------------------------------------------------------
type
  TBoxArray  = Array [1..MLen,1..MLen] of TBlockCell;      //單個(gè)方塊對(duì)應(yīng)的數(shù)組
  TEmptyLine = Array [1..MLen] of Integer;                 //已經(jīng)完成的行的記錄
  TMapData   = Array [1..MapWid,1..MapHei] of TBlockCell;  //當(dāng)前記錄



//---------------------------------------------------------------------
procedure Line(Canvas: TCanvas;X1,Y1,X2,Y2:Integer);
procedure SetBoxArray(var B: TBoxArray;I: Integer;S: String);
procedure InitBoxes;
function  GetWidth(B: TBoxArray): Integer;
function  GetHeight(B: TBoxArray): Integer;
procedure DrawMap(Canvas: TCanvas);
procedure DrawRect(Canvas: TCanvas;X1,Y1,X2,Y2: Integer;Color: TColor);
procedure DrawBoxXY(Canvas: TCanvas;X,Y: Integer;B: TBoxArray);
procedure DrawBoxBK(Canvas: TCanvas;X,Y: Integer;B: TBoxArray;Color: TColor);
procedure BoxMoveTo(Canvas: TCanvas;X,Y: Integer;B: TBoxArray);
function  CanGo(X,Y: Integer;B: TBoxArray): Boolean;
procedure CopyBox(var ObjBox: TBoxArray;Source: TBoxArray);
procedure Change(Canvas: TCanvas;var B: TBoxArray;var CurX: Integer;var CurY:Integer);
procedure MoveToMap(X,Y: Integer;B: TBoxArray);
procedure ScanEmptyLine(Canvas: TCanvas;var Line: TEmptyLine);
procedure FreshMap(Canvas: TCanvas;Line: TEmptyLine);
procedure DelAMapLine(I: Integer);
function  Max(X1,X2:Integer):Integer;
procedure ShowNext(Canvas: TCanvas);
procedure ShowMess(Canvas: TCanvas;S: String);
procedure SetBlockColor(var B:TBoxArray;Color: TColor);
procedure CheckBlock(var B:TBoxArray);




//---------------------------------------------------------------------
var
  Box: Array [1..BNum] of TBoxArray;             //一組方塊
  Map: TMapData;                                 //背景數(shù)組
  CurX,CurY: Integer;                            //當(dāng)前方塊的位置
  LasX,LasY: Integer;                            //上一次方塊的位置
  BkColor: TColor;                               //背景的顏色
  BColor: TColor;                                //畫(huà)方塊的顏色
  Block: TBoxArray;                              //每一次出現(xiàn)的方塊
  EmptyLine: TEmptyLine;                         //已經(jīng)完成的行
  BlockId: Integer;                              //方塊的屬類(lèi)
  NextId: Integer;                               //方塊的屬類(lèi)
  Score: Integer;                                //玩家的得分
  Level: Integer;                                //游戲玩家的級(jí)別

  ChangeKey: Integer;                            //用來(lái)?yè)Q方向的鍵
  LeftKey: Integer;                              //左方向
  RightKey: Integer;                             //右方向
  DownKey: Integer;                              //下降鍵
  DirectDownKey: Integer;                        //直接下降鍵

  CurLevelScore: Integer;                        //本關(guān)得分


//---------------------------------------------------------------------
implementation
uses UMain;

//---------------------------------------------------------------------
procedure Line(Canvas: TCanvas;X1,Y1,X2,Y2:Integer);
begin
  Canvas.MoveTo(X1,Y1);
  Canvas.LineTo(X2,Y2);
end;

//---------------------------------------------------------------------
{ 用字符串對(duì)方塊數(shù)組進(jìn)行設(shè)置 }
{ 如："1111" 表示一個(gè)長(zhǎng)條    }
{ I 表示數(shù)組的第 I 行        }
procedure SetBoxArray(var B: TBoxArray;I: Integer;S: String);
var
  j: Integer;
begin
  for j := 1 to MLen do
    {B[I,j] := StrToInt(Copy(S,j,1));}
    if StrToInt(Copy(S,j,1)) <> 0 then
      B[I,j].Empty := NotEmptyBlock//true
    else
      B[I,j].Empty := EmptyBlock;//;false;
end;

//---------------------------------------------------------------------
{ 對(duì)方塊數(shù)組進(jìn)行初始化，}
{ 使其獲得基本的形狀。  }
procedure InitBoxes;
var
  i,j: Integer;
begin
  SetBoxArray(Box[1],1,'1100');
  SetBoxArray(Box[1],2,'1100');
  SetBoxArray(Box[1],3,'0000');
  SetBoxArray(Box[1],4,'0000');

  SetBoxArray(Box[2],1,'0000');
  SetBoxArray(Box[2],2,'1110');
  SetBoxArray(Box[2],3,'0010');
  SetBoxArray(Box[2],4,'0000');

  SetBoxArray(Box[3],1,'0000');
  SetBoxArray(Box[3],2,'1110');
  SetBoxArray(Box[3],3,'1000');
  SetBoxArray(Box[3],4,'0000');

  SetBoxArray(Box[4],1,'0100');
  SetBoxArray(Box[4],2,'1110');
  SetBoxArray(Box[4],3,'0000');
  SetBoxArray(Box[4],4,'0000');

  SetBoxArray(Box[5],1,'1000');
  SetBoxArray(Box[5],2,'1100');
  SetBoxArray(Box[5],3,'0100');
  SetBoxArray(Box[5],4,'0000');

  SetBoxArray(Box[6],1,'0100');
  SetBoxArray(Box[6],2,'1100');
  SetBoxArray(Box[6],3,'1000');
  SetBoxArray(Box[6],4,'0000');

  SetBoxArray(Box[7],1,'0000');
  SetBoxArray(Box[7],2,'1111');
  SetBoxArray(Box[7],3,'0000');
  SetBoxArray(Box[7],4,'0000');
  //Initialize the background
  for i := 1 to MapWid do
    for j := 1 to MapHei do
      Map[i,j].Empty := EmptyBlock;//false;


  {終于修正了這個(gè)核心bug 原來(lái)這里應(yīng)該使用 MapHei - 3}
  for j := 1 to MapHei - 3 do
    for i := 1 to 3 do
    begin
      Map[i,j].Empty := NotEmptyBlock;
      Map[i,j].Color := clGreen;
      Map[MapWid-3+i,j].Empty  := NotEmptyBlock;
      Map[MapWid-3+i,j].Color := clGreen;
    end;


  for j := MapHei-2 to MapHei do
    for i := 4 to MapWid - 3 do
    begin
      Map[i,j].Empty := NotEmptyBlock;
      Map[i,j].Color := clGreen;
    end;

end;

//---------------------------------------------------------------------
{ 獲取一個(gè)方塊的寬度 }
function GetWidth(B: TBoxArray): Integer;
var
  i,j,MaxLen,Long: Integer;
begin
  { 對(duì)于5 和 6 號(hào) 進(jìn)行特殊掃描 }
  if (BlockId=5) or (BlockId=6) then
  begin
    Long := 0;
    for i := 1 to MLen do
      if B[i,1].Empty <>EmptyBlock then Long := Long + 1;
    if Long = 1 then
    begin
      GetWidth := 2;
      Exit;
    end else
    begin
      GetWidth := 3;
      Exit;
    end;
  end;

  MaxLen := 0;
  for i := 1 to MLen do
  begin
    Long :=0;
    for j := 1 to MLen do
      if B[j,i].Empty <>EmptyBlock  then Long := Long + 1;
    if MaxLen<Long then MaxLen := Long;
  end;
  GetWidth := MaxLen;
end;

//---------------------------------------------------------------------
{ 獲取一個(gè)方塊的高度 }
function GetHeight(B: TBoxArray): Integer;
var
  i,j,MaxLen,Long: Integer;
begin
  if (BlockId=5) or (BlockId=6) then
  begin
    Long := 0;
    for i := 1 to MLen do
      if B[1,i].Empty <>EmptyBlock then Long := Long + 1;
    if Long = 1 then
    begin
      GetHeight := 2;
      Exit;
    end else
    begin
      GetHeight := 3;
      Exit;
    end;
  end;

  MaxLen := 0;
  for i := 1 to MLen do
  begin
    Long :=0;
    for j := 1 to MLen do
      if B[i,j].Empty <>EmptyBlock then Long := Long + 1;
    if MaxLen<Long then MaxLen := Long;
  end;
  GetHeight := MaxLen;
end;

//---------------------------------------------------------------------
{ 用來(lái)畫(huà)一個(gè)立體的方塊 }
{允許使用圖片方塊 }
procedure DrawRect(Canvas: TCanvas;X1,Y1,X2,Y2: Integer;Color: TColor);
var
   Rect: TRect;
begin
   if(UseImgBlock)then
   begin
      Rect.Left := X1;
      Rect.Top := Y1;
      Rect.Right := X1+14;//X2;
      Rect.Bottom := Y1+14;//Y2;
      Canvas.StretchDraw(Rect,frmGame.ImgBlock.Picture.Graphic);
   end
   else
   begin
      Canvas.Brush.Color := Color;
      Canvas.Pen.Color := Color;
      Canvas.Rectangle(X1,Y1,X2,Y2);

      Canvas.Pen.Color := clWhite;
      Line(Canvas,X1,Y1,X1,Y2);
      Line(Canvas,X1,Y1,X2,Y1);

      Canvas.Pen.Color := clBlack;
      Line(Canvas,X2,Y1,X2,Y2);
      Line(Canvas,X1,Y2,X2,Y2);

      Canvas.MoveTo(X1+1,Y2-1);
      Canvas.Pen.Color := clGray;
      Canvas.LineTo(X2-1,Y2-1);
      Canvas.LineTo(X2-1,Y1+1);
   end;
end;

//---------------------------------------------------------------------
{ 在 (X,Y) 位置畫(huà)出方塊背景 }
{ 方塊用數(shù)組 B 表示         }
procedure DrawBoxBK(Canvas: TCanvas;
                    X,Y: Integer;
                    B: TBoxArray;
                    Color: TColor);
var