在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. 更加智能化的移动——可探测弃置方块的阻碍和重叠
  6. pTetris盒子移动的运行测试
  7. 结束语

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

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

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

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

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

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

在前面编写获取要移动的方块盒子的时候我们使用了需求拉动法，现在我们要编写移动方块盒子结束后的后续处理的有关代码，我们将采用另一种方法：可以叫做数据推动法。
所谓的数据推动法跟需求拉动法是一个道理的，只是方向相反而已。需求拉动法是从使用数据的地方开始，逆向寻找提供数据的源头，而数据推动法则是从使用数据的地方开始，沿着数据流动的方向寻找数据的出路和处置方法。
数据推动法就是先划分模块，明确每一个模块的功能，但不做细节上的策划。找到核心模块，从核心模块开始编写代码。从核心模块持有的数据入手，构建向相关模块传递数据的通道，在相关模块中构建数据的储存、传递、处置等功能，直到数据到达最终的目的地。数据到达最终目的地后可能被使用或者销毁。
下面我们就来给pTetris项目编写方块盒子移动到达目的地后的处置有关的代码。 

2.以数据处置推动的方法实现处置移动结束后的盒子的代码设计构想

游戏的核心是移动盛满了方块的盒子，所以核心模块是cxBoxMove。
移动盒子到达移动区底部后要把这些盒子放下。在上一篇文章中我们已经把盒子转送到了移动区底部，但由于没有收货人，放下的盒子只能胡乱堆积在那儿。这些堆放的盒子该怎么管理呢？现在我们就来考虑这个问题的解决方法。先来看一看我在前面的文章中所作的分析：

  • 放下所在的高度：如果放置高度与计分有关，那么就要考虑放置高度和放置方块的个数（计算基本得分及高度加成）
  • 消除行：放下方块后是否填充了所在行的所有空格，满足消除的条件，如果满足消除的条件，就要交给方块消除处理
  • 消除行后的移动：消除满行后，在其上的行要下移。

从这些要求来看，我们可以有这样的理解：

  • 放下所在的高度是指与移动区底部的距离，可以使用盒子的Base.Y计算
  • 消除行是以行为操作对象的，所以放下的盒子按行管理比较合适
  • 消除行后在其上的盒子要向下移动，一次移动一行要比一次移动一个盒子效率要高，从下面的两种方案的对比可以看出，把行作为容器对行里的盒子进行打包管理更方便：
    • 一次移动一各盒子需要判断在消除的行之上的每一个格子中是否有方块，有则向下移动一格
    • 一次移动一行，不需要判断有没有盒子，只需要把作为行中盒子的容器向下移动一格就行了，不用考虑有没有方块

基于这种思路，我们考虑采用以下数据管理架构：

  • 构建一个cxDustbin类作为行的容器或者管理者，用来管理丢弃到这一行中的方块，可以包含以下成员和操作：
    • 落在这一行中的方块对象的列表，
      • 可以用来销毁方块
      • 可以用作方块计数
    • 每个方块的位置（是指横向位置，方块的竖向位置就是cxDustbin所在的行在列表列表中的位置），以便判断行中空格的位置，或者说判断某一个格子中是否有方块
    • 销毁行中的所有方块
      • 显示销毁动画
  • 构建一个cxBoxHeap类，作为一个包含若干cxDustbin的列表，可以包含以下成员和操作：
    • 包含一个cxDustbin的列表，用来表示方块堆积的行
      • 获得堆积高度
    • 提供cxDustbin的格子与grdBox中格子的对应关系（坐标转换）
    • 接手一个盒子后把盒子中的方块按grdBox坐标放入对应的cxDustbin对象中
      • 按接手盒子基点计算放置高度计分
      • 检查是否存在cxDustbin满行情况
        • 计算满行加分
        • 销毁满行的方块
          • 消除满行后上部的方块下移

架构已经建立，现在我们就可以编写代码了。 

3.处置移动结束后的盒子的代码设计实现

3.1 构建cxDustbin类

在以前的策划中我们把销毁盒子的工作放在了cxBoxDestroy类中，现在又出了一个cxDustbin类，这两个类是不是同一个事情我现在还没有想清楚，感觉二者重叠了很多。之所以建立cxDustbin类，主要是觉得cxDustbin这个名字要比cxBoxDestroy好理解一些：

  • cxDustbin包含了回收和处置的意思，这个处置也包括了销毁
  • cxBoxDestroy重点在销毁，好像表达的意思不够完整

在这里先不考虑那么多了，先把cxDustbin建立起来，至于cxBoxDestroy有必要就留着，没有必要就丢弃，这就算是设计变更吧。

以下是cxDustbin类定义的代码：

复制代码
  { cxDustbin }

  cxDustbin = class(TLCLComponent)
  private
    function GetBoxs(x: integer): cxBox;
    procedure SetBoxs(x: integer; AValue: cxBox);
  protected
  public 
    //constructor Create; override;
    //destructor Destroy; override;  
    property Boxs[x: integer]: cxBox read GetBoxs write SetBoxs;
    function BoxCount: integer;
    function HasBox(x: integer): boolean;
  published
  end;
复制代码

以下是cxDustbin类实现的代码：

复制代码
{ cxDustbin }

function cxDustbin.GetBoxs(x: integer): cxBox;
var
  cmp: TComponent;
begin
  Result := nil;
  for cmp in Self do
  begin
    if {(cmp.ClassType = cxBox) and }(cmp.Tag = x) then
    begin
      Result := cmp as cxBox;
      Break;
    end;
  end;
end;

procedure cxDustbin.SetBoxs(x: integer; AValue: cxBox);
begin
  AValue.Tag := x;
  AValue.Owner.RemoveComponent(AValue);
  Self.InsertComponent(AValue);
end;

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

function cxDustbin.HasBox(x: integer): boolean;
begin
  Result := Boxs[x] <> nil;
end;
复制代码

从这些代码中可以看出，现在给cxDustbin添加的成员仅仅是作为容器的效果，妥妥地是一个垃圾箱。

3.2 构建cxBoxHeap类

 先定义cxBoxHeap类的基本框架：

复制代码
  { cxBoxHeap }

  cxBoxHeap = class(TLCLComponent)
  private
  protected
    function NewRow: cxDustbin;
  public
    //constructor Create; override;
    //destructor Destroy; override;
    function Grid: cxGrid;
    function RowCount: integer;
    function Rows(ARow: integer): cxDustbin;
    function RowOrNew(ARow: integer): cxDustbin;
    procedure RowsClear;published
  end;
复制代码

以上成员的实现代码如下：

复制代码
{ cxBoxHeap }

function cxBoxHeap.NewRow: cxDustbin;
begin
  Result := cxDustbin.Create(Self);
end;

{创建cxBoxHeap类实例的时候以移动区背景网格为参数，可通过Owner指向表格}
function cxBoxHeap.Grid: cxGrid;
begin
  Result := Owner as cxGrid;
end;

function cxBoxHeap.RowCount: integer;
begin
  Result := ComponentCount;
end;

{返回行的函数：
 Rows 有行则返回行，无行则返回空
 RowOrNew 有行则返回行，无行则t添加行，确保返回不为空
}
function cxBoxHeap.Rows(ARow: integer): cxDustbin;
begin
  if RowCount > ARow then
    Result := Components[ARow] as cxDustbin
  else
    Result := nil;
end;

function cxBoxHeap.RowOrNew(ARow: integer): cxDustbin;
begin
  while RowCount <= ARow do
    NewRow;
  Result := Rows(ARow);
end;

procedure cxBoxHeap.RowsClear;
var
  i: integer;
begin
  for i := RowCount - 1 downto 0 do
    Rows(i).Free;
end;
复制代码

方块移动区的cxGrid与cxBoxHeap中的格子位置是对应的，但是前者的行从上到下编号，而后者则是从下到上编号，虽然列号是相同的，但行号需要转换，以下就是行号转换函数的实现：

复制代码
{坐标转换函数：cxGrid与cxBoxHeap坐标转换，仅转换Y}
function cxBoxHeap.RowToGrid(ARow: integer): integer;
begin
  Result := Grid.Rows - ARow - 1;
end;

function cxBoxHeap.RowFromGrid(AGridY: integer): integer;
begin
  Result := Grid.Rows - AGridY - 1;
end;
复制代码

格子中是否有方块？这是查找空位时需要知道的，提供以下函数，可以按cxGrid坐标检查，也有可以使用cxBoxHeap坐标的函数：

复制代码
{检查单元格内是否存在cxBox，可以用来查找空位}
function cxBoxHeap.HasBoxByGrid(ACol, ARow: integer): boolean;
begin
  Result:=HasBoxByHeap(ACol,RowFromGrid(ARow));
end;

function cxBoxHeap.HasBoxByGrid(AColRow: TPoint): boolean;
begin
  Result:=HasBoxByHeap(AColRow.X,RowFromGrid(AColRow.Y));
end;

function cxBoxHeap.HasBoxByHeap(ACol, ARow: integer): boolean;
var
  rw: cxDustbin;
begin
  Result := False;
  rw := Rows(ARow);
  if rw <> nil then
    Result := rw.HasBox(ACol);
end;

function cxBoxHeap.HasBoxByHeap(AColRow: TPoint): boolean;
begin
   Result:=HasBoxByHeap(AColRow.X,AColRow.Y);
end;
复制代码

编写cxBoxHeap类的代码的最终目的是管理移动完成后丢弃的方块，以下函数就是要做的核心工作——打开盒子，将方块放入cxDustbin中：

复制代码
{移动结束后用BoxsOpen打开盒子，将盒子中的方块放入cxBoxHeap的行中}
procedure cxBoxHeap.BoxsOpen(ABoxs: cxBoxs);
var
  xyb, xyc: TPoint;
  bx: cxBox;
  x, y: integer;
begin
  xyb := ABoxs.Base;
  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
      begin
        xyc.X := xyb.X + x;
        xyc.Y := xyb.Y + y;
        Recycle(bx, xyc.X, RowFromGrid(xyc.Y));
      end;
    end;
  end;     ABoxs.Free; 
end;

procedure cxBoxHeap.Recycle(ABox: cxBox; ACol, ARow: integer);
var
  rw: cxDustbin;
begin
  rw := RowOrNew(ARow);
  rw.Boxs[ACol] := ABox;
end;
复制代码

回收方块后需要检查是否存在满行，以下函数就是做这项工作：

复制代码
{检查行中的盒子是否已经满了，由于cxDustbin不知道网格列数，只能在cxBoxHeap中检查}
function cxBoxHeap.RowFull(ARow: integer): boolean;
var
  rw: cxDustbin;
begin
  rw := Rows(ARow);
  if Assigned(rw) then
    Result := rw.BoxCount >= Grid.Cols
  else
    Result := False;
end;
复制代码

有了以上这一些代码，我们就可以创建cxBoxHeap类的实例进行测试了。 不过，以上代码只是有了接收盒子的动作，从代码中跟踪调试可以看得出来，但从操作界面上是看不到的。怎么办呢？我们现在添加一点临时代码，让操作界面上能够看出动作的变化。
我们要做的是一行达到满行的方块时删除满行，然后上边的盒子下落。为了达到这个目的，需要编写的代码包括：

  • 要删除满行先要判断是否满行，我们已经有了cxBoxHeap.RowFull
  • 要在删除满行后将上边的方块下落，只需要重新显示方块即可，可以使用cxGrid.MoveTo函数
  • 要显示方块，需要先得到方块的实例。现在还没有解决方块重叠的问题，使用cxDustbin.Boxs得不到全部的方块，需要编写一个能得到全部方块的函数，为此我们添加一个函数cxDustbin.BoxByIndex

cxDustbin.BoxByIndex代码如下：

function cxDustbin.BoxByIndex(Index: integer): cxBox;
begin
  Result := Components[Index] as cxBox;
end;

添加函数cxBoxHeap.ClearFullRows实现销毁满行，上部方块下落，代码如下：

复制代码
{销毁满行，上部方块下落}
procedure cxBoxHeap.ClearFullRows;
var
  i, j, cnt: integer;
  rw: cxDustbin;
  bx: cxBox;
  xy: TPoint;
begin
  //销毁满行
  cnt := 0;
  for i := RowCount - 1 downto 0 do
  begin

    if RowFull(i) then
    begin
      rw := Rows(i);
      rw.Free;
      Inc(cnt);
    end;
  end;
  //如果有销毁的行，则需要重新显示堆积的方块（向下移动）
  if cnt > 0 then
  begin
    for i := 0 to RowCount - 1 do
    begin
      rw := Rows(i);
      xy.Y := RowToGrid(i);
      for j := 0 to rw.BoxCount - 1 do
      begin
        bx := rw.BoxByIndex(j);
        xy.X := bx.Tag;
        Grid.MoveTo(bx, xy);
      end;
    end;
  end;
end;
复制代码

 

4.打开移动的盒子——测试管理堆积盒子的代码

4.1 盒子的交接的方法分析

现在我们来分析如何使用cxBoxHeap的问题：

  • 首先必须创建一个cxBoxHeap的实例，使用grdBox作为Create的参数
    • TfrmMain中定义cxBoxHeap变量
    • 在TfrmMain.FormCreate中创建cxBoxHeap的实例
  • 将盒子交给cxBoxHeap的操作由计时器完成，也就是在Timer1.Timer调用的DoTimer的适用版本中调用
    • 在TfrmMain.DoTimerV4中盒子不能移动时调用cxBoxHeap.BoxsOpen打开盒子
  • cxBoxHeap与cxBoxQueue、cxBoxMove暂时没有交集

4.2 创建cxBoxHeap的实例并在程序中使用的实现

按着以上分析，需要对TfrmMain的代码做以下改动。
在TfrmMain中添加代码定义变量：

  private
    boxHeap: cxBoxHeap;

在TfrmMain.FormCreate中添加以下代码创建cxBoxHeap的实例：

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  ......
  boxHeap:= cxBoxHeap.Create(grdBox);
end;

修改TfrmMain.DoTimerV4中的代码在盒子不能移动时调用cxBoxHeap.BoxsOpen打开盒子：

复制代码
procedure TfrmMain.DoTimerV4;
......
begin
  ......
  if cr.Y < my then
  begin
    //还没有到达底部，继续向下移动
    grdBox.BoxsTo(bxs, cr.X, cr.Y + 1);
  end
  else
  begin
    //已经到达底部，销毁盒子，放出方块
    boxHeap.BoxsOpen(bxs);//bxs.Free;
    boxHeap.ClearFullRows;             
  end;
end;
复制代码

编译运行pTetris项目，点击“开始游戏”，让方块“跌落”。由于还没有解决方块阻碍盒子下落的问题，到达底部的方块会有重叠，所以记住下落到底部每行的方块数量。你会看到，计数达到10的行会消失，然后上面的行下落。这说明我们回收方块的工作达到了预期的效果。
对回收的方块有了管理，我们下一步就可以考虑解决方块重叠的问题了。

5.更加智能化的移动——可探测弃置方块的阻碍和重叠

已经完成了所有的准备工作，具备了让方块正常移动和放置的条件，成为一个可以玩的游戏的时机已经成熟了。现在心情激动，有些急不可耐，就不说废话了，直接进入正题。
现在要做的就是在考虑弃置方块阻碍对移动的影响，防止重叠放置方块，让游戏中的盒子有更高的智能，能够正常移动和弃置。

5.1 移动中考虑弃置方块的阻碍的解决方案分析

要想在盒子向下移动时考虑方块的阻碍，就是要检查方块向下移动一格后是否会与已经弃置的方块重叠，实现的方法有三种：

  • 在cxGrid.MoveTo中检查要放置方块的地方是否有其他方块，返回是否重叠的标志
    • 这样检查的工作量最小，但发现重叠时可能已经将同一个盒子的其他方块部分移动到了新的位置，要想退回需要知道有哪些方块移动了，哪一些没有移动
    • 可以只检查是否重叠并返回标志，不考虑是否退回
      • 退回的操作在调用cxGrid.BoxsTo的代码中实现，可以先移动，发现重叠标志后退回
  • 在cxGrid.BoxsTo中检查要放置方块的地方是否有其他方块，返回是否重叠的标志
    • 工作量和发现重叠后的情况跟cxGrid.MoveTo中相同
    • 可以只检查是否重叠并返回标志，不考虑是否退回
      • 退回的操作在调用cxGrid.BoxsTo的代码中实现，可以先移动，发现重叠标志后退回
  • 移动前检查是否有阻碍，没有阻碍才移动，有阻碍则不动，检查的方法有三种：
    • 在移动的方向上检查下一个格子是否有方块或者超出了边界
      • 需要添加函数检查盒子在移动方向上最考前的方块位置
      • 检查移动方向上的下一个格子是否有弃置的方块
    • 在移动的方向上检查有方块阻碍或者到达边界的距离中的最小值得到可移动的距离，可移动距离大于0，则可以移动
      • 需要添加函数检查盒子在移动方向上最考前的方块位置
      • 检查移动方向上距离最近的弃置方块的位置
    • 检查盒子移动到目标位置后其中的方块对应的cxBoxHeap格子中是否有方块，如果有方块则说明移动后存在重叠，则不可移动
      • 检查移动后盒子中的方块对应的cxBoxHeap格子中是否有方块

从以上方法中可以看出：

  • 前两种方法都要修改底层代码，最终还是要在使用cxGrid.BoxsTo的地方纠正错误的移动
  • 后一种方法是在使用cxGrid.BoxsTo的地方添加可移动性检查，而在这样的地方已经存在检查边界的代码，只需要在增加方块阻碍的代码就行了

由此可见，后一种方法是可取的，而后一种方案中的最后一种检查方法是最简单的。

5.2 检查新位置是否可以放置盒子的代码——检查是否在边界内、是否与弃置的方块重叠

需要编写的代码分析：

  • 检查是否在移动区边界之内，需要grdBox的范围
  • 检查是否存在重叠的弃置方块，需要boxHeap的HasBoxByHeap或HasBoxByGrid

从以上需求来看，考虑到封装涉及到最小的范围，把操作放到cxBoxHeap中是最合适的。
基于以上分析，添加cxBoxHeap.TestBoxTo函数，包括了边界检查和重叠检查，代码如下：

复制代码
{检查将盒子ABoxs的基点移动到（ACol, ARow）处是否与弃置的方块重叠}
function cxBoxHeap.TestBoxTo(ABoxs: cxBoxs; ACol, ARow: integer): boolean;
var
  xyb, xyc: TPoint;
  bx: cxBox;
  x, y: integer;
  grc:TRect;
begin
  Result := True;
  grc.Left:=0;
  grc.Top:=-9; //设置为负数是为了确保计时器获得的新盒子能够移动
  grc.Right:=Grid.Cols;
  grc.Bottom:=Grid.Rows;
  xyb.X := ACol;
  xyb.Y := ARow;
  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
      begin
        xyc.X := xyb.X + x;
        xyc.Y := xyb.Y + y;
        Result := (not HasBoxByGrid(xyc)) and PtInRect(grc, xyc);
        if not Result then Break;
      end;
    end;
  end;
end;

function cxBoxHeap.TestBoxTo(ABoxs: cxBoxs; AColRow: TPoint): boolean;
begin
  Result := TestBoxTo(ABoxs, AColRow.X, AColRow.Y);
end;
复制代码

5.3 在移动中考虑弃置方块的阻碍的代码

需要编写的代码分析：

  • 移动盒子的操作是通过点击界面中的按钮实现的，代码应该在按钮的事件处理函数中，这些函数已经在TfrmMain类中存在了
  • 移动的盒子来源于boxMove.Boxs(0)，这是按钮事件处理函数中原有的代码
  • 移动的盒子在新的位置显示使用grdBox.BoxsTo，这也是按钮事件处理函数中原有的代码
  • 检查盒子移动的目标位置是否在移动区边界范围内、是否与弃置方块重叠
    • 检查盒子移动的目标位置是否在移动区边界范围内，这也是按钮事件处理函数中原有的代码
    • 检查盒子移动的目标位置是否与弃置方块重叠，这是需要增加的代码
      • 需要用到cxBoxHeap.TestBoxTo

从以上需求来看，考虑到封装涉及到最小的范围，把操作放到TfrmMain中是最合适的，而且只需要将原有的按钮事件处理函数中判断是否可移动的代码用cxBoxHeap.TestBoxTo替换就可以了。
基于以上分析，在TfrmMain添加以下函数为每一种移动定义一个尝试动作的函数，能够移动则完成移动，不能移动则保持现状：

    function TryBoxsToDown(bxs: cxBoxs):Boolean;
    procedure TryBoxsToDowned(bxs: cxBoxs);    
    procedure TryBoxsToLeft(bxs: cxBoxs);
    procedure TryBoxsToRight(bxs: cxBoxs);
    procedure TryBoxsRotate(bxs: cxBoxs);

实现这些函数的代码，并在对应的事件处理函数中使用就可以了。

5.3.1 向下移动中考虑弃置方块的阻碍的代码（适用于计时器推动、下落按钮操作）

TryBoxsToDown函数尝试让盒子向下移动一格，实现代码：

复制代码
function TfrmMain.TryBoxsToDown(bxs: cxBoxs): Boolean;
var
  pt: TPoint;
begin
  pt := bxs.Base;
  Inc(pt.Y);
  Result := boxHeap.TestBoxTo(bxs, pt);
  if Result then
    grdBox.BoxsTo(bxs, pt);
end;
复制代码

参照DoTimerV4改写为DoTimerV5，并在计时器事件处理函数中使用DoTimerV5代替DoTimerV4，DoTimerV5代码修改后的如下：

复制代码
procedure TfrmMain.DoTimerV5;
var
  bxs: cxBoxs;
begin
  bxs := boxMove.CurrentBoxs;
  if bxs = nil then Exit;

  if not TryBoxsToDown(bxs) then
  begin
    //已经到达底部，销毁盒子，放出方块
    boxHeap.BoxsOpen(bxs);//bxs.Free;
    boxHeap.ClearFullRows;
  end;
end;
复制代码

下落按钮事件处理函数修改后的代码如下：

复制代码
procedure TfrmMain.btnDownClick(Sender: TObject);
var
  bxs: cxBoxs;
begin
  bxs := boxMove.Boxs(0);
  if bxs = nil then Exit;

  TryBoxsToDown(bxs);
end;
复制代码

 

5.3.2 向下跌落时考虑弃置方块的阻碍的代码（适用于跌落按钮操作）

TryBoxsToDowned函数尝试让盒子向下移动，直到不能移动为止，实现代码：

复制代码
procedure TfrmMain.TryBoxsToDowned(bxs: cxBoxs);
var
  pt: TPoint;
begin
  pt := bxs.Base;
  Inc(pt.Y);
  while boxHeap.TestBoxTo(bxs, pt) do
  begin
    grdBox.BoxsTo(bxs, pt);
    Inc(pt.Y);
  end;
end;
复制代码

跌落按钮事件处理函数修改后的代码如下：

复制代码
procedure TfrmMain.btnDownedClick(Sender: TObject);
var
  bxs: cxBoxs;
begin
  bxs := boxMove.Boxs(0);
  if bxs = nil then Exit;

  TryBoxsToDowned(bxs);
end;
复制代码

 

5.3.3 向左移动时考虑弃置方块的阻碍的代码

TryBoxsToLeft函数尝试让盒子向左移动一格，实现代码：

复制代码
procedure TfrmMain.TryBoxsToLeft(bxs: cxBoxs);
var
  pt: TPoint;
begin
  pt := bxs.Base;
  Dec(pt.X);
  if boxHeap.TestBoxTo(bxs, pt) then
    grdBox.BoxsTo(bxs, pt);
end;
复制代码

左移按钮事件处理函数修改后的代码如下：

复制代码
procedure TfrmMain.btnLeftClick(Sender: TObject);
var
  bxs: cxBoxs;
begin
  bxs := boxMove.Boxs(0);
  if bxs = nil then Exit;

  TryBoxsToLeft(bxs);
end;
复制代码

 

5.3.4 向右移动时考虑弃置方块的阻碍的代码

TryBoxsToRight函数尝试让盒子向右移动一格，实现代码：

复制代码
procedure TfrmMain.TryBoxsToRight(bxs: cxBoxs);
var
  pt: TPoint;
begin
  pt := bxs.Base;
  Inc(pt.X);
  if boxHeap.TestBoxTo(bxs, pt) then
    grdBox.BoxsTo(bxs, pt);
end;
复制代码

右移按钮事件处理函数修改后的代码如下：

复制代码
procedure TfrmMain.btnRightClick(Sender: TObject);
var
  bxs: cxBoxs;
begin
  bxs := boxMove.Boxs(0);
  if bxs = nil then Exit;

  TryBoxsToRight(bxs);
end;
复制代码

 

5.3.5 旋转时考虑弃置方块的阻碍的代码

TryBoxsRotate函数尝试让盒子旋转90°，如果旋转后有阻碍则回旋恢复原状，实现代码：

复制代码
procedure TfrmMain.TryBoxsRotate(bxs: cxBoxs);
var
  pt: TPoint;
begin
  pt := bxs.Base;
  bxs.Rotate;
  if boxHeap.TestBoxTo(bxs, pt) then
    grdBox.BoxsTo(bxs, pt)
  else
    bxs.RotateBack;
end;
复制代码

旋转按钮事件处理函数修改后的代码如下：

var
  bxs: cxBoxs;
begin
  bxs := boxMove.Boxs(0);
  if bxs = nil then Exit;

  TryBoxsToRight(bxs);
end;

6.pTetris盒子移动的运行测试

6.1 正常条件和极限条件运行测试

在完成上面的这些代码之后，理论上可以说是一个可以使用的游戏了，只是还没有加入计分、加速等游戏规则，还没有加入键盘操作，只可以使用鼠标操作。
为什么说是理论上呢？这是因为按着编写代码的进度，应该达到这个程度了，但是还需要实践检验，也就是说的运行测试。在编写程序时，给程序溜了一各作弊的后门，那就是暂停后还可以移动、旋转方块。现在开始测试程序的功能，我们需要利用这个后门。
下面开始我们测试的步骤：

  • 编译运行pTetris项目，点击开始游戏按钮，一个盒子开始从上向下移动。
  • 点击“跌落”按钮，让移动区下部堆积几个盒子的方块，到达适宜的高度
  • 看到再有一个盒子进入移动区的时候，点击“暂停”按钮，让盒子悬停在空中
  • 操作这个悬停的盒子左右移动、旋转、下落，测试你能想到的各种可能的情况：
    • 达到边界后是否会溢出边界
    • 遇到堆积的盒子后是否会与堆积的盒子重叠
    • 旋转时边界、堆积的盒子是否会阻碍盒子旋转
    • 旋转后是否会出现盒子溢出边界或者与堆积的盒子重叠
    • 你能想到的其他任何情况

经过测试，盒子移动、方块堆积没有发现问题。这说明程序在移动盒子、回收盒子方面达到了我们的要求。

6.2 让游戏能够结束

在上面的测试中，让方块继续堆积，当高度达到移动区顶部的时候，再也看不到移动区中有盒子移动，而提示区的盒子加速更新。为什么会这样呢？这是因为我们没有告诉游戏什么时候结束，当堆积的方块达到了获得新的盒子放置的初始位置的时候，盒子就不再移动了，而游戏却没有结束。
这个时候点击“开始游戏”按钮，盒子又恢复刚开始时候的移动方式，但这不是我们需要的，我们要给游戏添加一个停止的状态。当堆积高度达到限定的最高高度的时候游戏结束，并有提示信息告诉用户游戏结束啦。

现在整理一下我们的思路：

  • 游戏结束的条件比较容易确定，那就是堆积的方块高度达到了移动区的高度
  • 计时器检查堆积的高度
    • 每次打开盒子后检查堆积高度
      • 堆积高度达到了最高限度
        • 结束游戏，可选的停止游戏的方式：
          • 停止计时器。这是可以的，但按着以前的代码，暂停按钮会显示成“恢复”，此时点击这个按钮是否会形成“误判”
          • 添加一个标志。比如Gaming，如果计时器处于活动状态，检查到Gaming=false则不会有动作
        • 向用户报告游戏结束
          • 提示游戏结束，可以是文字、动画、声音或者其他适宜的形式
          • 将游戏计分等统计结果存入档案（排行榜）

我们选择添加Gaming标志的办法。
在TfrmMain类中定义一个Gaming属性，定义的代码如下：

    FGaming: Boolean;
    procedure SetGaming(AValue: Boolean);
    property Gaming:Boolean read FGaming write SetGaming;

将TfrmMain.btnStartClick的代码转移到TfrmMain.SetGaming中，将TfrmMain.btnStartClick改为以下代码：

procedure TfrmMain.btnStartClick(Sender: TObject);
begin
  Randomize;
  Gaming := True;
end;

TfrmMain.SetGaming的代码如下：
为了代码的可读性和便于维护，我们添加两个函数在SetGaming中调用：

  • procedure GameBegin;包含游戏开始时需要初始化的所有代码。
  • procedure GameEnd;包含游戏结束后做善后工作的所有代码。
复制代码
procedure TfrmMain.SetGaming(AValue: Boolean);
begin
  FGaming := AValue;
  if AValue then
    GameBegin
  else
    GameEnd;
end; 

procedure TfrmMain.GameBegin;
begin
  btnStart.Caption := '重新开始';
  //暂停计时器的操作
  Timer1.Enabled := False;
  //销毁提示列表中的盒子
  boxQueue.BoxsClear;
  //销毁提示区的方块
  grdNext.BoxClear;
  //销毁当前移动的盒子
  boxMove.BoxsClear;
  //销毁移动区的方块
  grdBox.Clear;  
  //今后需要添加的操作
  { #todo : 销毁移动区的行容器 }
  { #todo : 设置移动区的初始方块 }
  { #todo : 计时计分归零 }{ #todo : 计时器恢复默认的开始速度 }
  //恢复计时器的操作
  Timer1.Enabled := True;
  PageControl1.Enabled:=False;
  //trcStart.Enabled:=False;
end;

procedure TfrmMain.GameEnd;
begin
  btnStart.Caption := '开始游戏';
  PageControl1.Enabled:=True;
  //trcStart.Enabled:=True;
  MessageDlg(Caption, '游戏结束啦！恭喜你获得第一名。哈哈哈'
    +'……',
    mtConfirmation, [mbOK], 0);
  { #todo : 添加游戏停止后需要做的事情 }
end;
复制代码

在TfrmMain.Timer1Timer函数的当前版本中添加Gaming的使用代码：

复制代码
procedure TfrmMain.DoTimerV5;
var
  bxs: cxBoxs;
begin
  if not Gaming then Exit;

  bxs := boxMove.CurrentBoxs;
  if bxs = nil then Exit;

  if not TryBoxsToDown(bxs) then
  begin
    //已经到达底部，销毁盒子，放出方块
    boxHeap.BoxsOpen(bxs);//bxs.Free;
    boxHeap.ClearFullRows;
    if boxHeap.RowCount >= grdBox.Rows then
      Gaming := False;
  end;
end;
复制代码

添加函数cxBoxHeap.ClearAllRows用来清理堆积方块的行和方块，代码如下：

复制代码
procedure cxBoxHeap.ClearAllRows;
var
  i: integer;
  rw: cxDustbin;
begin
  //销毁行对象
  for i := RowCount - 1 downto 0 do
  begin
    rw := Rows(i);
    rw.Free;
  end;
  //销毁堆积的方块
  Grid.BoxClear;
end;
复制代码

在TfrmMain.GameBegin中使用cxBoxHeap.ClearAllRows代替原来的grdBox.BoxClear：

procedure TfrmMain.GameBegin;
begin
  ......
  //销毁移动区的方块
  boxHeap.ClearAllRows;  //grdBox.BoxClear;
  ......
end;

现在再编译运行pTetris项目，我们的俄罗斯方块游戏已经可以玩了。今后将会添加更加丰富的内容。

 

7.结束语

在这篇文章里我们采用数据处置推动法构建了处置方块盒子移动结束后对弃置方块的管理的代码，并在此基础上给应用程序增加了更多的智能，能够正确识别移动区域边界和避免方块重叠，在移动盒子的过程中能够正确识别弃置盒子的阻挡，堆积的方块出现满行后能够销毁满行中的方块。也就是说，我们编写的游戏已经达到了能玩的程度，但是我们的核心思想不是玩游戏，而是在编写游戏程序的过程中学到编写程序的方法。
在编写程序的方法方面，觉得这几个方面是我们讲述的重点：

  • 按着数据流动的方向为数据提供通道和存储场所，从而确定编写哪一些代码来满足这样的要求
  • 我们把程序划分成很多个模块（类），把需要编写的代码放置到哪一个类中更合适是根据代码要实现的功能需要使用数据、存放数据等活动涉及到的范围来判断的，尽量不免“向上级、向兄弟伸手”的情况发生，把事情限制在“内部”解决
  • 同样类型的操作尽可能做到代码重用，把重复使用的代码编写为一格函数/过程，让其他的函数调用，这样做既可以减少代码量，也让程序变得简洁
  • 模块的划分不是一成不变的，可以有适当的变更；代码不是一次编写完成的，可以先留编写实现基础功能的代码，然后随着功能增加的需要修改代码，这样可以避免编写无用代码的事情发生
posted @   lexyao  阅读(34)  评论(0)  编辑  收藏  举报
相关博文：
· 在Lazarus下的Free Pascal编程教程——以数据需求拉动程序运行的模块化程序设计方法
· 在Lazarus下的Free Pascal编程教程——打造有智慧的人机交互界面
· FreeRTOS任务创建和删除(动态)内部实现过程
· 手把手带你从零开始完整开发经典游戏【俄罗斯方块】，全部逻辑只用不到200行代码。
· C++游戏代码合集
阅读排行：
· 阿里最新开源QwQ-32B，效果媲美deepseek-r1满血版，部署成本又又又降低了！
· 单线程的Redis速度为什么快？
· SQL Server 2025 AI相关能力初探
· AI编程工具终极对决：字节Trae VS Cursor，谁才是开发者新宠？
· 展开说说关于C#中ORM框架的用法！
点击右上角即可分享
微信分享提示