在Lazarus下的Free Pascal编程教程——以数据需求拉动程序运行的模块化程序设计方法

0.前言

我想通过编写一个完整的游戏程序方式引导读者体验程序设计的全过程。我将采用多种方式编写具有相同效果的应用程序，并通过不同方式形成的代码和实现方法的对比来理解程序开发更深层的知识。

了解我编写教程的思路，请参阅体现我最初想法的那篇文章中的“1.编程计划”和“2.已经编写完成的文章（目录）”：

学习编程从游戏开始——编程计划（目录） - lexyao - 博客园

我已经在下面这篇文章中介绍了使用LCL和FCL组件构建一个项目（pTetris）的过程，后续的使用Lazarus的文章中使用的例子都是以向这个项目添加新功能的方式表述的：

在Lazarus下的Free Pascal编程教程——用向导创建一个使用LCL和FCL组件的项目（pTetris） - lexyao - 博客园

这是一篇专题文章，我们将通过一个编写pTetris项目方块移动相关过程的前半部分的代码编写体验以数据需求拉动程序运行的模块化程序设计方法。

俄罗斯方块游戏中核心活动是移动方块，在移动方块之前要有一个获得要移动的方块的过程，在这篇文章中要介绍的就是获得要移动的方块的过程。

在这篇文章里，我主要讲述以下几个方面的内容：

1. pTetris模块化程序设计概述
2. 以数据需求拉动的方法实现取得当前移动的盒子的代码设计构想
3. 取得当前移动的盒子的代码设计实现
4. 在方块移动区显示盒子——测试获取方块盒子的代码
5. 结束语

1.pTetris模块化程序设计概述

在下面网址链接的文章中我们已经将pTetris与方块移动相关的过程进行了模块划分和模块功能规划，并为每一个模块确定了类的名字。

在Lazarus下的Free Pascal编程教程——按数据流程规划程序结构 - lexyao - 博客园

在pTetrisUnit单元中添加以下定义类的代码：

  //为每一个模块定义一个类
  cxBox=class;            //单个方块
  cxBoxs=class;           //一组方块，也就是将方块打包的盒子
  cxBoxQueue=class;       //方块队列，也就是在提示区显示的下一个进入移动去的盒子
  cxBoxMove=class;        //正在移动的盒子
  cxBoxHeap=class;        //堆积的方块
  cxBoxDestroy=class;     //销毁方块 

我们下一步的任务就是为这些类编写代码。

在大型的软件开发时通常是团队合作，将应用程序划分为若干模块，每个小组开发一个模块，每个小组的成员开发模块的某一部分功能。这样的工作需要在分工之前划分模块，并规划模块的成员。试想一下，在结果还没有出来之前，预想的结果一定是正确的吗？假定的需求一定是用得到或者适用的吗？答案是否定的：很可能有一部分策划需要进行修改，这也包括模块间接口的修改。这种修改带来的后果就是否定在此之前做的一部分工作。所以，在一个程序员独立开发一个程序的时候，往往会采取另一个方法：可以叫做需求拉动法。
所谓的需求拉动法就是先划分模块，明确每一个模块的功能，但不做细节上的策划。找到核心模块，从核心模块开始编写代码。给核心模块添加功能需要用到相关模块提供的数据或者传递数据给相关模块，那么就根据这种需求设置与相关模块的接口，并给相关模块添加相应的功能。每完成一项功能可以进行调试，这样可以将调试范围限制在较小的范围内，便于查找问题。当核心模块的功能全部完成之后，应用程序的雏形就形成了。在这个雏形的基础上再进行加强，逐步完善。由于有了雏形为基础，增强部分的调试也变得容易了许多。当感觉到没有可以加强或者优化的地方的时候，所编写的应用程序就完美呈现了。
在大型软件开发中，作为一个程序员，只需要按着分工编写自己分内的代码就行了，不用关心策划的事情，这是因为有“肉食者谋之又何间焉”。在个人独立开发程序的时候，从策划到编写代码都是需要自己考虑的。也许就是这些差别导致了软件开发的的思路有所不同吧。
下面我们就按着个人独立编写一个软件的思路来编写pTetris的核心代码。

2.以数据需求拉动的方法实现取得当前移动的盒子的代码设计构想

游戏的核心是移动盛满了方块的盒子，所以核心模块是cxBoxMove。
要想移动盒子，首先要取得一个盒子，取得盒子后要有一个放置盒子的地方。按着这个需求，我们考虑当前要编写的代码：

• 先准备放置盒子的地方，这就是为cxBoxMove添加一个cxBoxs类型的成员变量
• 取得盒子的动作需要为cxBoxMove添加一个返回cxBoxs类实例的函数
• cxBoxMove只能有唯一的盒子来源，那就是cxBoxQueue，所以在cxBoxQueue应该有一个函数提供下一个盒子的实例
• cxBoxQueue中的下一个盒子应该是在提示队列中最先进入队列的那一个，提取队列中的第一个盒子可能涉及到以下操作：
  • 队列中没有盒子，先创建一个盒子放到队列中
  • 从队列中取出一个盒子作为函数返回值
  • 从队列中取出盒子后队列中的出现空缺，创建新的盒子补充队列到满员
  • 将队列的盒子的方块显示在提示区
    • 在提示区显示方块需要方块有Parent属性，这需要cxBox类必须是TWinControl的后代
    • 要将方块显示在提示区，要有一个成员变量或函数提供提示区的类实例
      • 可以在cxBoxQueue的构造函数中用提示区作为参数，在构造函数中保存提示区实例到一个变量中
• 创建一个新的盒子需要有以下代码：
  • cxBoxQueue有一个函数创建cxBoxs类实例
  • cxBoxs有一个构造函数形成一个盒子的实例
• 要形成一个盒子cxBoxs类的实例，需要有以下代码：
  • cxBoxs有存放方块的场所
  • cxBoxs有一个函数创建cxBox类的实例，并设置cxBox类实例的属性（盒子的外观）
  • cxBoxs有一个计算放置方块位置的函数（形成方块组合的排列方式）
• 要构建一个cxBox类的实例，需要以下代码：
  • cxBox类是TWinControl的后代有以下要求：
    • cxBox只能在cxBoxs中创建，创建cxBox类时cxBoxs能够提供作为其Owner的组件
    • cxBox类是可显示组件，要从一个可显示组件继承
  • cxBox类有描述方块外观的属性
  • cxBox类有一个构造函数，构建类的实例，并设置属性的初始值（或默认值）
• cxBoxs为cxBox提供作为其Owner的组件，需要考虑以下问题：
  • cxBoxs只能在cxBoxQueue中创建，需要的组件只能由cxBoxQueue提供
  • cxBoxs把Owner传递给cxBox，最简单的方式是cxBoxs本身也是组件，这需要cxBoxs是组件类的后代

上面的构思可以从上而下，当下面需要上面提供数据时也可以逆向反推。如此反复推敲之后，就确定了所有的需求，从而可以编写代码了。 

3.取得当前移动的盒子的代码设计实现

3.1 方块生产——cxBox类的定义与实现

计划中方块有多种功能，是丰富多彩的，不过现在只想着先完成简单的方块，那种丰富多彩放在以后去实现。
方块的实现有多种方法：

• 点亮法：在方块移动区布满方块对象，没有方块的就用灰色，只留下一个印记，有方块的就点亮，呈现出色彩
• 移动法：每个方块是一个组件，显示方块只需要将方块的Parent属性指向cxGrid组件就行了，方块的移动就是组件的移动
• 画图法：方块移动到哪里就在哪里画一个方块

我第一次使用C++Builder做的俄罗斯方块就是用的画图法，我们这一次准备使用移动法。
既然只想简单实现，那就定义一个组件作为方块，将大小调整到16x16就行了。TPanel组件就满足这样的要求，那就暂时让cxBox从TPanel继承。
在pTetrisUnit单元中定义一个类cxBox：

  { cxBox }

  cxBox = class(TPanel)
  public
    constructor Create(AOwner: TComponent); override;
    //destructor Destroy; override;
  end;

  cxBoxClass=class of cxBox;  

在实现区添加代码：

{ cxBox }

constructor cxBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Height := 16;
  Width := 16;
end;  

3.2 打包装入盒子

按着计划，每组方块可以是4块、5块、1-5块三种方案，现在先实现每组4块的常规模式。
在pTetrisUnit单元中定义一个类cxBoxs，可以实现以下功能：

• 构建一个5x5的矩阵，数据类型是cxBox
• 使用cxBox创建4个方块实例，按着一定的算法放入矩阵中形成一组方块的随机组合
• cxBoxs需要给cxBox传递一个Owner，有两种可选的方案：
  • 让cxBoxs从组件继承
    • 由于堆积方块时要释放cxBoxs而cxBox要继续保留，所以cxBoxs不能把自己作为cxBox的Owner
  • 给cxBoxs添加一个指向或者获得可以作为cxBox的Owner的成员

cxBoxs类定义的代码如下： 

  { cxBoxs }

  cxBoxs = class(TLCLComponent)  
  const
    LowX = -2;
    HighX = 2;
    LowY = -2;
    HighY = 2;
  private
    FBoxCount: integer;
    mBoxs: array[LowX..HighX, LowY..HighY] of cxBox;
    function GetBoxs(x, y: integer): cxBox;
    procedure SetBoxs(x, y: integer; AValue: cxBox);
  protected
    function NewBox: cxBox;
  public
    //constructor Create(AOwner: TComponent); override;
    //destructor Destroy; override;
    property Boxs[x, y: integer]: cxBox read GetBoxs write SetBoxs;
    property BoxCount: integer read FBoxCount;procedure BoxInit(ACount: integer = 4);
    function BoxIdle(out pt: TPoint): boolean;
  published
  end; 

cxBoxs类实现的代码如下：

{ cxBoxs }

function cxBoxs.GetBoxs(x, y: integer): cxBox;
begin
  Result := mBoxs[x, y];
end;

procedure cxBoxs.SetBoxs(x, y: integer; AValue: cxBox);
begin
  mBoxs[x, y] := AValue;
end;

function cxBoxs.NewBox: cxBox;
begin
  //关于cxBox.Create参数的选择：
  //由于cxBoxs释放时cxBox是要还要保留，所以不能使用self
  //由于cxBoxs.Owner是cxBoxQueue，而cxBoxQueue将用来作为保存cxBoxs的队列，也不能用
  //cxBoxs.Owner.Owner是其他组件，可以使用
  Result := cxBox.Create(Owner.Owner);
end;

procedure cxBoxs.BoxInit(ACount: integer);
var
  pt: TPoint;
  cnt:Integer;
begin
  FBoxCount:=ACount;
  mBoxs[0,0]:=NewBox;
  cnt:=1;
  while cnt<ACount do
  begin
    if BoxIdle(pt)Then
    begin
      mBoxs[pt.X,pt.Y]:=NewBox;
      Inc(cnt);
    end;
  end;
end;

function cxBoxs.BoxIdle(out pt: TPoint): boolean;
var
  angle: Int64;
  radius, radian: ValReal;
begin
  //通过随机计算查找下一个可以放置方块的空闲位置 
  radius := 0.4 / Sin(22.5 * Pi / 180);
  angle := Random(360);
  radian := angle * Pi / 180;
  pt.X := round(radius * Cos(radian));
  pt.Y := round(radius * Sin(radian));
  Result := mBoxs[pt.X, pt.Y] = nil;
  if not Result then
  begin
    radius := -radius;
    pt.X := round(radius * Cos(radian));
    pt.Y := round(radius * Sin(radian));
    Result := mBoxs[pt.X, pt.Y] = nil;
  end;
end;    

在cxBoxs.BoxIdle的代码中留了一个缺陷：按着这段代码计算出来的位置使得方块的组合缺少一字型的。 

3.3 放入盒子队列 

本来想使用TQueue作为cxBoxQueue的父类，但在功能分析的时候发现需要cxBoxQueue从组件继承更方便，而且TQueue没有Items成员，在显示提示盒子的时候没有直接获得队列中盒子类实例的成员，所以决定cxBoxQueue从组件继承。
在pTetrisUnit单元中定义一个类cxBoxQueue，可以实现以下功能：

• cxBoxQueue从TLCLComponent继承，将它的Owner传递给cxBoxs下的cxBox
  • 由于grdNext仅作为显示cxBoxQueue中的盒子使用，可以把grdNext作为cxBoxQueue构造函数的参数传递给cxBoxQueue
  • 使用Components保存cxBoxs队列，ComponentCount计数
• NextBox函数向cxBoxMove提供盒子，也引发cxBoxQueue的一系列操作
  • 向cxBoxMove提供盒子
    • 队列中没有盒子，先创建一个盒子作为函数返回值
    • 队列中有盒子，从队列中取出一个盒子作为函数返回值
  • 从队列中取出盒子后队列中的出现空缺，创建新的盒子补充队列到满员
  • 将队列的盒子的方块显示在提示区
    • 可在grdNext.MoveTo中设置方块的Parent属性为grdNext
    • 要将方块显示在提示区，要有一个成员变量或函数提供提示区的类实例

为了将盒子显示到方块提示区，给cxBoxs设置一个基准点，基准点设置在盒子的中心，用网格坐标表示：

  { cxBoxs }

  cxBoxs = class(TLCLComponent)  
  ......private
    FBase: TPoint;
    ......public
    ......property Base:TPoint read FBase write FBase;
    property BaseX:Integer read FBase.X write FBase.X;
    property BaseY:Integer read FBase.Y write FBase.Y;
    ......
  end; 

为了将盒子显示到方块提示区，给cxGrid添加两个成员函数：

{ 函数/过程操作说明： BoxsTo
  将盒子中的基点移动到网格（ACol, ARow）c处，bing在此显示盒子中的方块}
procedure cxGrid.BoxsTo(ABoxs: cxBoxs; ACol, ARow: integer);
var
  xy: TPoint;
  bx: cxBox;
  x, y: Integer;
begin
  xy.X := ACol;
  xy.Y := ARow;
  ABoxs.Base := xy;
  for x := ABoxs.LowX to ABoxs.HighX do
  begin
    for y := ABoxs.LowY to ABoxs.HighY do
    begin
      bx := ABoxs.Boxs[x, y];
      if bx <> nil then
        MoveTo(bx, xy.X + x, xy.Y + y);
    end;
  end;
end;

procedure cxGrid.BoxsTo(ABoxs: cxBoxs; AColRow: TPoint);
begin
  BoxsTo(ABoxs, AColRow.X, AColRow.Y);
end;   

cxBoxQueue类定义的代码如下：  

  { cxBoxQueue }

  cxBoxQueue = class(TLCLComponent)
  private

  protected
    function NewBoxs: cxBoxs;
  public
    //constructor Create; override;
    //destructor Destroy; override;
    function Grid: cxGrid;
    function BoxCount: integer;
    function Boxs(Index: integer): cxBoxs;
    function NextBoxs: cxBoxs;
  published
  end; 

cxBoxQueue类实现的代码如下：  

{ cxBoxQueue }

function cxBoxQueue.NewBoxs: cxBoxs;
begin
  Result := cxBoxs.Create(Self);
end;

function cxBoxQueue.Grid: cxGrid;
begin
  Result := Owner as cxGrid;
end;

function cxBoxQueue.BoxCount: integer;
begin
  Result := ComponentCount;
end;

function cxBoxQueue.Boxs(Index: integer): cxBoxs;
begin
  Result := Components[Index] as cxBoxs;
end;

function cxBoxQueue.NextBoxs: cxBoxs;
var
  bx, by, cc: integer;
begin
  //设置返回值
  if BoxCount > 0 then
    Result := Boxs(0)
  else
    Result := NewBoxs;
  //从列表中移除
  RemoveComponent(Result);
  //补足盒子队列
  { #todo : 暂时按4个盒子，将来按配置确定个数 }
  while BoxCount < 4 do
    NewBoxs;
  //显示盒子
  bx := 2;
  by := 2;
  for cc := 0 to BoxCount - 1 do
  begin
    Grid.BoxsTo(Boxs(cc), bx, by + 5);
  end;
end;    

3.4 为移动区取得将要移动的盒子 

cxBoxMove是游戏的核心模块，是左右动作的引发者和用户接口。
在pTetrisUnit单元中定义一个类cxBoxMove，可以实现以下功能：

• cxBoxMove需要以下成员
  • 用于保存当前正在移动的盒子的变量
  • 指向grdBox函数或变量
  • 将移动的盒子显示在grdBox中的函数
    • 以上需求与cxBoxQueue有共同之处，可以考虑代码共享
  • cxBoxMove需要从cxBoxQueue获得盒子，所以需要一个指向cxBoxQueue的成员
  • 需要一个获取当前移动的盒子的成员
    • 没有盒子，则从cxBoxQueue获取一个
    • 有盒子，返回盒子类实例

为了代码共享，将将cxBoxQueue的可与cxBoxMove共享的代码提取出来形成cxBoxBase类，cxBoxQueue和cxBoxMove类都继承自cxBoxBase。

cxBoxBase类的定义如下：

  { cxBoxBase }

  cxBoxBase = class(TLCLComponent)
  private

  protected

  public
    //constructor Create; override;
    //destructor Destroy; override;
    function Grid: cxGrid;
    function BoxCount: integer;
    function Boxs(Index: integer): cxBoxs;
  published
  end; 

 cxBoxBase类的实现如下：

{ cxBoxBase }

function cxBoxBase.Grid: cxGrid;
begin
  Result := Owner as cxGrid;
end;

function cxBoxBase.BoxCount: integer;
begin
  Result := ComponentCount;
end;

function cxBoxBase.Boxs(Index: integer): cxBoxs;
begin
  if BoxCount > Index then
    Result := Components[Index] as cxBoxs
  else
    Result := nil;
end; 

提取代码后cxBoxQueue类的定义如下：

  { cxBoxQueue }

  cxBoxQueue = class(cxBoxBase)
  private

  protected
    function NewBoxs: cxBoxs;
  public
    function NextBoxs: cxBoxs;
  published
  end; 

 提取代码后cxBoxQueue类的实现如下：

{ cxBoxQueue }

function cxBoxQueue.NewBoxs: cxBoxs;
begin
  Result := cxBoxs.Create(Self);
  Result.BoxInit;
end;

function cxBoxQueue.NextBoxs: cxBoxs;
var
  bx, by, cc: integer;
begin//设置返回值
  if BoxCount > 0 then
    Result := Boxs(0)
  else
    Result := NewBoxs;
  //从列表中移除盒子
  RemoveComponent(Result);
  //补足盒子队列
  { #todo : 暂时按4个盒子，将来按配置确定个数 }
  while BoxCount < 4 do
    NewBoxs;
  //显示盒子
  bx := 2;
  by := 2;
  for cc := 0 to BoxCount - 1 do
  begin
    Grid.BoxsTo(Boxs(cc), bx, by + 5 * cc);
  end;end;  

cxBoxMove类的定义如下：

  { cxBoxMove }

  cxBoxMove = class(cxBoxBase)
  private
    FQueue: cxBoxQueue;
    bBoxsGetting: boolean;
  protected  
    property Queue: cxBoxQueue read FQueue;
    function HasBoxs: boolean;
    function BoxsReady: boolean;
  public
    constructor Create(AOwner, AQueue: TComponent);
    //destructor Destroy; override;
    function CurrentBoxs: cxBoxs;
  published
  end;  

cxBoxMove类的实现如下： 

{ cxBoxMove }

function cxBoxMove.HasBoxs: boolean;
begin
  Result := BoxCount > 0;
end;

function cxBoxMove.BoxsReady:Boolean;
var
  bxs: cxBoxs;
begin
  //准备当前移动的方块，如果没有则创建从队列中获取一个，并放置在移动区之上
  Result := False;
  if bBoxsGetting then Exit;
  bBoxsGetting := True;
  if not HasBoxs then
  begin
    bxs := Queue.NextBoxs;
    if assigned(bxs) then
    begin
    bxs.BaseX := 8;
    bxs.BaseY := -2;
    InsertComponent(bxs);
    end;
  end;
  Result := True;
  bBoxsGetting := False;
end;

constructor cxBoxMove.Create(AOwner, AQueue: TComponent);
begin
  //构造函数的参数获取cxGrid、cxBoxQueue
  inherited Create(AOwner);
  FQueue := AQueue as cxBoxQueue;
end;

function cxBoxMove.CurrentBoxs: cxBoxs;
begin
  //获取当前移动的方块，如果没有则创建从队列中获取一个
  //如果没有时不想创建，则使用Boxs(0)
  if BoxsReady then
    Result := Boxs(0)
  else
    Result := nil;
end;  

 

4. 在方块移动区显示盒子——测试获取方块盒子的代码

4.1 在方块移动区显示盒子——测试获取方块盒子的代码

经过前面的工作之后，我们编写的代码已经可以为方块移动区提供一个含有4个方块的盒子了。现在就测试一下我们的劳动成果。
为了测试，我们需要编写以下代码：
第一步、在pTetrisMain单元的TfrmMain类中定义cxBoxQueue、cxBoxMove类型的成员变量

    boxQueue: cxBoxMove;
    boxMove: cxBoxMove;  

第二步、在TfrmMain.FormCreate创建对象的实例

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  grdBox := cxGrid.Create(pnBox);
  grdNext := cxGrid.Create(pnNext);
  boxQueue := cxBoxQueue.Create(grdNext);
  boxMove := cxBoxMove.Create(grdBox, boxQueue);
end;  

第三步、在Timer1Timer中调用boxMove.CurrentBoxs引发创建盒子实例的过程，并在移动移动盒子
在Timer1Timer在以前的测试中使用了一个Panel1的红色小方块，现在Panel1的使命终于完成了。在Timer1Timer使用boxMove.CurrentBoxs获取的盒子代替Panel1，从窗体设计器中删除Panel1。
在Timer1Timer中我们移动Panel1的代码是在DoTimerV2中的，我们就参照DoTimerV2编写一个DoTimerV3。由于删除了Panel1，DoTimerV1和DoTimerV2的代码不能使用了，需要注释掉。

 第四步、编译运行pTetris，查看运行结果
编写代码难免有疏漏或者错误。如果是代码错误，在每编写完成一段代码后编译运行，会发现输入错误或者变量未定义之类的错误，可以直接修改。而另一类错误需要运行时才能发现，这样的错误在编译时语法没有问题，也就发现不了错误，只有运行时根据错误提示查找问题的原因。
在修改了几个小错误后，程序运行出现了预期的画面，截图如下：

 从截图中可以看到有的盒子中的方块排列与常规的俄罗斯方块游戏中的不同。这个也不需要感到奇怪，有以下几个理由：

• 我们开始的时候说过，在cxBoxs.BoxIdle的代码中留了缺陷，这个问题与留的缺陷有关
• 我曾经在一个俄罗斯方块游戏中见过这样的图案，那个程序把这种图案作为一种难度级别考虑的

不管什么原因，我们还是有必要回归常规，让方块排列显示出正常的形态。

4.2 修订盒子中方块组合的代码

在一般的俄罗斯方块游戏设计中，方块的排列算法有两种情况：

• 将各种排列图案放入一个固定的数据结构中，随机选取一个图案作为下一个要移动的方块。这种算法比较简单，各种图案出现的概率相同，不会出现异常情况。多数的游戏使用了这种算法。
• 采用随机函数产生一个随机数，根据采用某种算法计算方块的位置，从而形成随机图案。这种算法比较复杂，由于算法的原因可能导致有些图案出现的比较频繁，需要处理出现的异常情况。我们要采用的就是这种算法。

现在我们考虑修改算法，排除异常，尽可能减少某种图案过于频繁的情况。
首先将原来的BoxIdle函数改名为BoxIdleV1，新编写的算法命名为BoxIdleV2、BoxIdleV3……最终选定代码如下：

function cxBoxs.BoxIdleV4(out pt: TPoint): boolean;
var
  angle: Int64;
  radius, radian: ValReal;
begin
  //通过随机计算查找下一个可以放置方块的空闲位置
  radius := 0.4 / Sin(22.5 * Pi / 180);
  angle := Random(360);
  radian := angle * Pi / 180;
  pt.X := round(radius * Cos(radian));
  pt.Y := round(radius * Sin(radian));
  if Abs(pt.X) + Abs(pt.Y) = 2 then
  begin
    Result := (mBoxs[pt.X, pt.Y] = nil) and ((mBoxs[pt.X, 0] <> nil) or
      (mBoxs[0, pt.Y] <> nil));
  end
  else
  begin
    Result := mBoxs[pt.X, pt.Y] = nil;
    if not Result then
    begin
      radius := -radius;
      pt.X := round(radius * Cos(radian));
      pt.Y := round(radius * Sin(radian));
      Result := mBoxs[pt.X, pt.Y] = nil;
      if not Result then
      begin
        radius := 2 * radius;
        pt.X := round(radius * Cos(radian));
        pt.Y := round(radius * Sin(radian));
        if Abs(pt.X)=2 then
          pt.Y:=0
        else
          pt.X:=0;
        Result := mBoxs[pt.X, pt.Y] = nil;
      end;
    end;
  end;
end;   

 

4.3 提取下一个盒子

 编译运行后，pTetris取出第一个盒子在方块移动区不停地移动，但提示区的队列是静止的。现在测试从队列中提取下一个盒子。

 在窗体设计器中双击“跌落”按钮，在编辑区的事件处理函数中添加以下代码：

procedure TfrmMain.btnDownedClick(Sender: TObject);
begin
  boxMove.CurrentBoxs.Free;
end; 

从代码看只是销毁了当前盒子对象的实例，结果会怎么样呢？
编译运行pTetris，看到方块在移动区跳动，点击“跌落”按钮，我们看到：

• 移动区原来的盒子停止了跳动，其实这已经不能算是盒子，而是没有盒子的方块了，
• 提示区的第一个盒子进入移动区，并在移动区跳动
• 提示区盒子队列依次上移，最下面的空位由新的盒子补上

这符合我们的期望，这就是我们想要的结果。经过测试，发现了一个缺陷：连续点击“跌落”按钮，连续两个盒子向上移动，而在提示区的上部出现了方块残留。

 经过一天多的测试，添加了多处防重入保护代码和防空指针异常保护代码，最终没有找到出现方块残留的原因。就在准备暂时放下这个问题，把这个问题的画面截图插入这篇文章中留作以后探讨的问题点时，突然灵光一现，想到了一种可能：按着原来的代码，BoxsReady把盒子从提示队列中删除了，但方块的Parent属性还是指向grdNext，直到Timer1Time中将盒子显示在移动区时，才将盒子中方块的Parent改为grdBox。会不是在BoxsReady和Timer1Time之间的时间间隔内插入了“跌落”的动作，销毁了盒子，而把还没来得及转入grdBox的方块遗留在了grdNext中呢？如果真是这样，那就在BoxsReady中把方块的Parent改为grdBox，问题就一个能解决了。
按着这一思路，修改了BoxsReady的代码：

function cxBoxMove.BoxsReady:Boolean;
var
  bxs: cxBoxs;
begin
  //准备当前移动的方块，如果没有则创建从队列中获取一个，并放置在移动区之上
  Result := False;
  if bBoxsGetting then Exit;
  bBoxsGetting := True;
  if not HasBoxs then
  begin
    bxs := Queue.NextBoxs;
    if assigned(bxs) then
    begin
      //bxs.BaseX := 8;
      //bxs.BaseY := -2;   
      Grid.BoxsTo(bxs, 8, -2);
      InsertComponent(bxs);
    end;
  end;
  Result := True;
  bBoxsGetting := False;
end;  

添加了上面的红色代码，Grid.BoxsTo(bxs, 8, -2)将盒子显示在移动区的上方，除了代替设置Base为下一步的移动设置一个起点外，真实的目的是设置盒子中方块的Parent为grdBox。
修改代码后编译运行pTetris项目，无论怎么点击“跌落”，提示区方块残留堆积的问题再也没有出现，困扰了一天多的问题就这样解决了。
从这一个意外的例子也可以看出调试的艰难。有些问题在代码中是看不出来的，但问题又确实存在。有可能无论怎么查找都找不到，而有时候在不经意间一个念头出现，问题就得到解决了。记得年轻的时候编写了一个工程预算程序，其中有一个问题百思不得其解，苦苦查询了一个多星期没有找到答案，最后在睡梦中出现了一个念头，从床上跳起来直接进入了工作状态，发现问题的解决方案正是梦中所想。
我们的手机和电脑中都有一个叫做“用户体验计划”的选项，是什么意思呢？我们使用电脑出现程序运行错误的时候，操作系统会弹出一个提示窗口，问是不是要提交错误报告，提交给谁呢？其实，这些都是操作系统的开发商在开发的时候有些缺陷找不到原因，添加了异常保护代码让程序带病运行，当用户使用程序出现错误的时候，将错误报告给开发商，开发商通过这些错误报告分析问题的原因，查找程序的缺陷。
说这么多就是想表达一个意思：编写程序遇到解决不了的问题的时候，不要气馁，可以采取暂时的保护措施，或者采用替代的方法，将来有时间了再考虑解决的办法。

4.4 cxBox.Create参数的测试

在前面编写的代码中，cxBoxs.NewBox中使用cxBox.Create创建盒子中方块的实例的时候cxBox.Create的参数用的不是cxBoxs的Self，而是Owner.Owner，代码的提示中也给出了理由：

function cxBoxs.NewBox: cxBox;
begin
  //关于cxBox.Create参数的选择：
  //由于cxBoxs释放时cxBox是要还要保留，所以不能使用self
  //由于cxBoxs.Owner是cxBoxQueue，而cxBoxQueue将用来作为保存cxBoxs的队列，也不能用
  //cxBoxs.Owner.Owner是其他组件，可以使用
  Result := cxBox.Create(Owner.Owner);
end;     

是不是这样呢？现在已经具备了测试条件，我们可以进行这个问题的测试了。
修改上述代码，用Self代替Owner.Owner，也就是把cxBox实例的Owner设置成创建这个方块的cxBoxs，代码如下：

function cxBoxs.NewBox: cxBox;
begin
  Result := cxBox.Create(Self);
end;   

编译运行pTetris项目，运行后查看点击“跌落”按钮后在方块移动移动的方块怎么样了？正如我们预测的那样，点击“跌落”后，包装方块的盒子被销毁了，方块也跟着消失了。这是Lazarus/Delphi的组件的一个特性：销毁组件的时候，这个组件把它所包含的组件一同销毁。我们想销毁盒子后让方块保留下来，cxBox.Create的参数就不能使用cxBoxs的Self，要选用盒子之外的其他组件。 

5.结束语

在这篇文章里，我们以需求拉动的方法策划并编写的pTetris项目中从方块的生产到进入移动区的过程需要的代码，并进行了测试。
整个过程是以一个人完成全部程序设计的思路来考虑问题的，没有考虑团队合作，在编程的过程中只编写提供一组包装到盒子里的方块需要的代码，最大限度地避免了代码的冗余。当然，这些代码还有需要完善的地方，这将是下一步的工作。先完成基本的功能，使得代码能够合成一体，可以进行获取方块的过程的全流程的程序测试，这也是程序设计中分阶段进行测试的方法。