ubox.pas

很好的俄罗斯方块

{  俄罗斯方块核心控制单元  }
unit UBox;

interface

uses
  Windows,SysUtils, Graphics;

//---------------------------------------------------------------------
const
  BWid   = 15;            //显示在屏幕上的象素点数
  MLen   = 4 ;            //方块数组的宽度
  BNum   = 7 ;            //方块的个数
  MapWid = 20;            //背景地图的宽度（按格子数）
  MapHei = 30;            //背景地图的高度
  BkLeft = -30;           //左边距离
  BkTop  = 10 ;           //顶点距离
  EmptyBlock    = false;  //空的格子
  NotEmptyBlock = true;   //非空的格子

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

//---------------------------------------------------------------------
type
  TBoxArray  = Array [1..MLen,1..MLen] of TBlockCell;      //单个方块对应的数组
  TEmptyLine = Array [1..MLen] of Integer;                 //已经完成的行的记录
  TMapData   = Array [1..MapWid,1..MapHei] of TBlockCell;  //当前记录



//---------------------------------------------------------------------
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;                                 //背景数组
  CurX,CurY: Integer;                            //当前方块的位置
  LasX,LasY: Integer;                            //上一次方块的位置
  BkColor: TColor;                               //背景的颜色
  BColor: TColor;                                //画方块的颜色
  Block: TBoxArray;                              //每一次出现的方块
  EmptyLine: TEmptyLine;                         //已经完成的行
  BlockId: Integer;                              //方块的属类
  NextId: Integer;                               //方块的属类
  Score: Integer;                                //玩家的得分
  Level: Integer;                                //游戏玩家的级别

  ChangeKey: Integer;                            //用来换方向的键
  LeftKey: Integer;                              //左方向
  RightKey: Integer;                             //右方向
  DownKey: Integer;                              //下降键
  DirectDownKey: Integer;                        //直接下降键

  CurLevelScore: Integer;                        //本关得分


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

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

//---------------------------------------------------------------------
{ 用字符串对方块数组进行设置 }
{ 如："1111" 表示一个长条    }
{ I 表示数组的第 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;

//---------------------------------------------------------------------
{ 对方块数组进行初始化，}
{ 使其获得基本的形状。  }
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;


  {终于修正了这个核心bug 原来这里应该使用 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;

//---------------------------------------------------------------------
{ 获取一个方块的宽度 }
function GetWidth(B: TBoxArray): Integer;
var
  i,j,MaxLen,Long: Integer;
begin
  { 对于5 和 6 号 进行特殊扫描 }
  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;

//---------------------------------------------------------------------
{ 获取一个方块的高度 }
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;

//---------------------------------------------------------------------
{ 用来画一个立体的方块 }
{允许使用图片方块 }
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) 位置画出方块背景 }
{ 方块用数组 B 表示         }
procedure DrawBoxBK(Canvas: TCanvas;
                    X,Y: Integer;
                    B: TBoxArray;
                    Color: TColor);
var