在Lazarus下的Free Pascal编程教程——定制自己的组件

0.前言

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

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

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

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

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

这是一篇专题文章，我们将通过一个简单的例子，讲述如何构建自己的组件。

俄罗斯方块游戏中显示方块的区域有两个：一个是方块移动和堆积的区域，一个是提示下一组方块样式的区域。我们将要编写的组件就是用在这两个区域作为背景的网格组件。

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

Lazarus组件简介
在Lazarus中编写自己的组件的方法
给pTetris项目新建一个单元文件
确定要编写的组件的功能
编写我自己的组件cxGrid
结束语

1.Lazarus组件简介

Lazarus是一个基于Free Pascal的Delphi仿制品。为了保持与Delphi的兼容性，从诞生之日起Lazarus就没有摆脱Delphi的影子。Lazarus不管是界面还是组件，都在模仿Delphi。
在Lazarus和Delphi中，任何任何类都是从TObject继承下来的。Lazarus仿制了Delphi的类定义，而在继承时添加了自己特有的接口。比如：

TPersistent = class(TObject,IFPObserved) 中的IFPObserved
从TLCLComponent = class(TComponent) 到TControl = class(TLCLComponent) ，中间添加了TLCLComponent

除了上述变化外，有些还增加了一些属性、函数，当然也有因为不能支持而减少的。更多的是更改了实现的具体代码。
但这些变化都是在基础层的，而到了顶部的应用层，Lazarus与Delphi的组件很少有差别，这也是多数用Delphi编写的程序可以直接在Lazarus中使用的原因。
每一个类都算是一个对象，而从TComponent继承的类则称为组件，从TControl继承的称为控件，从TWinControl继承的则是可视控件。

从以上截图中的组件继承关系来看，在TControl之前是完全一样的。TImage也是可视控件，但它不是从TWinControl继承，而是从TGraphicControl继承。继承的父类不同只是侧重点不同而已，但作为组件的特性是一样的。当然，还有一些组件是从TLCLComponent继承，而不是从TControl。从TPersistent继承的由于不是TComponent的后代，所以通常就不叫组件了。

2.在Lazarus中编写自己的组件的方法

Lazarus提供了丰富的组件，网上也有很多编程爱好者发布了他们编写的组件。这些组件能够满足大多数编程的需要，但并不是满足所有的需要。很多情况下我们需要编写自己的组件。
编写自己的组件一般有以下几种情况：

以现有的组件为父类，添加一部分自己需要的功能
以现有组件的代码为基础，通过修改代码增加或完善某些功能
以现有组件的父类为父类，编写具有自己需要功能的组件
以现有组件继承关系的某一个层次开始，按自己的需要编写代码
从TObject开始编写自己专属的类或组件

也许还有更多的可能，但作为简单的使用，还是第一种情况比较多见。
从软件使用方式上来划分，可以分为两种情况：

设计时添加到应用程序界面中。这种情况需要把组件编译安装到Lazarus的组件面板中。编写这样的组件需要形成组件的软件包，代码中需要有处理设计时情况的代码。
运行时添加到应用程序界面中。这种情况可以在组件面板中，也可以不在组件面板中。编写这种组件只要有组件本身的代码就行了，不需要其他额外的东西。

作为简单的应用，还是后一种情况比较多。编写了满足需要的组件代码，运行时添加到界面中。在这里我们就采用这一种方法编写我们的cxGrid组件。
在编写我们自己的组件时将采用面向对象的程序设计方法。关于Lazarus中面向对象的程序设计的介绍请阅读以下文章：

Object Oriented Programming with Free Pascal and Lazarus/zh CN - Free Pascal wiki

3.给pTetris项目新建一个单元文件

在编写代码之前，需要先给pTetris项目添加一个文件，用来保存自己编写的组件的代码。
在Lazarus中有两种方式保存自己的代码文件：

扩展名是.pas的单元文件，文件第一行代码是单元名，在uses语句中添加单元名来引用这个单元文件中的代码
扩展名是.inc的包含文件，在单元文件的适当位置通过{$I <文件名>.inc} 的形式将其包含在单元文件中

在这里我们选择编写一个单元文件。给项目添加单元文件的方法有三种：

点击主菜单[文件->新建单元]
点击主菜单[文件->新建...]，打开新建窗口，在窗口中选择[模块->Pascal单元->确定]
点击工具栏的[新建Pascal单元]图标

选择以上三个方法之一的操作之后，一个名为unit1.pas的文件被添加在项目中，将这个文件保存为自己需要的文件名之后就可以在这个文件中编写自己的代码了。

unit Unit1;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils;

implementation

end.

以上是新建的unit1单元的代码，保存后其中的unit1将会编程你存盘使用的文件名。我们在这里保存这个单元文件为pTetrisUint.pas。

4.确定要编写的组件的功能

我们将要编写的组件是要添加到pTetris项目中作为背景网格组件的，需要具有的功能包括：

能够在放置方块的区域在方块之间画出网格线
网格线可以显示，也可以隐藏，还可以改变颜色
可以使用网格坐标定位每个网格，而不是使用像素坐标
可以使用网格坐标将一个方块显示在指定的网格内

5.编写我自己的组件cxGrid

5.1 创建类

第一步、利用模板创建类的框架

在Lazarus中打开pTetris项目，在编辑区打开pTetrisUint.pas文件。
在uses所在行之下的空行中输入“type”
在下一行中输入“class”，在提示的自动完成窗口中有classc、classc、classf，都是定义类的模板，我们先择classc，回车确认之后一个包含类的所有部分的框架形成了，代码如下：

type
  ClassName = class(InheritedClass)
  private
  
  protected
  
  public
    
    constructor Create; override;
    destructor Destroy; override;
  published
  end;

第二步、确定类的名称、父类、构造函数

将classname改为我们要定义的类的名字cxGrid
将InheritedClass改为我们的类要继承的类，在这里我们参照Lazarus其他的类选择容器类共同的祖先TCustomControl，在uses中添加TCustomControl所在的单元Controls
我们暂时不需要在Destroy中添加代码，先把这一行改为注释行
光标移动到Create行，给Create函数添加组件构造函数需要的参数，点击组合键“Ctrl+Shift+C”，代码补全功能在实现区添加了Create的实现代码：

{ cxGrid }

constructor cxGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

为了以后使用方便，我们可以在cxGrid.Create函数中添加以下代码。当然着不是必须的。若不添加这一行，在每次创建cxGrid类实例的时候都要添加这样的代码。

  Parent := AOwner as TWinControl;
  Align := alClient;

至此，我们已经完成的cxGrid类的框架，下面将会给cxGrid添加更多的的功能。

5.2 给cxGrid类添加属性

按着面向对象的思路，背景表格是对象，那么这个对象所具有的属性包括：网格线的间距、颜色、线型。
为了添加线型属性，我们先定义以下数据类型，三个元素依次表示：不画线、网格线交叉处画点、使用Pen的线型。

TcxLineStyle = (lsNone, lsDot, lsUsePen);

在cxGrid的public段输入以下属性的定义。其中LineColor和PenStyle不是必须的，它可以使用Canvas.Pen的属性来替代，但那样做有一定的缺陷。

    property BoxSize:Integer;
    property LineColor:TColor;
    property LineStyle:TcxLineStyle;
    property PenStyle:TFPPenStyle;

点击组合键“Ctrl+Shift+C”，代码补全功能在定义区和实现区添加定义属性需要的变量、成员函数、和实现代码。
以下是类定义中添加了属性以后的代码，红色的是代码补全功能添加的代码：

  { cxGrid }  
  TcxLineStyle = (lsNone, lsDot, lsUsePen);

  cxGrid = class(TCustomControl)
  private
    FBoxSize: Integer;
    FLineColor: TColor;
    FLineStyle: TcxLineStyle;
    FPenStyle: TFPPenStyle;
    procedure SetBoxSize(AValue: Integer);
    procedure SetLineColor(AValue: TColor);
    procedure SetLineStyle(AValue: TcxLineStyle);
    procedure SetPenStyle(AValue: TFPPenStyle);

  protected

  public

    constructor Create(AOwner: TComponent); override;
    //destructor Destroy; override;
    property BoxSize:Integer read FBoxSize write SetBoxSize;
    property LineColor:TColor read FLineColor write SetLineColor;
    property LineStyle:TcxLineStyle read FLineStyle write SetLineStyle;
    property PenStyle:TFPPenStyle read FPenStyle write SetPenStyle;
  published
  end;

以下是在实现区添加的设置属性的代码，这些代码都是代码补全功能自动添加的：

{ cxGrid }

procedure cxGrid.SetBoxSize(AValue: Integer);
begin
  if FBoxSize=AValue then Exit;
  FBoxSize:=AValue;
end;

procedure cxGrid.SetLineColor(AValue: TColor);
begin
  if FLineColor=AValue then Exit;
  FLineColor:=AValue;
end;

procedure cxGrid.SetLineStyle(AValue: TcxLineStyle);
begin
  if FLineStyle=AValue then Exit;
  FLineStyle:=AValue;
end;

procedure cxGrid.SetPenStyle(AValue: TFPPenStyle);
begin
  if FPenStyle=AValue then Exit;
  FPenStyle:=AValue;
end;

属性定义后默认情况下属性值都为0，我们在构造函数cxGrid.Create中添加代码为这些属性设置初始值：

  FBoxSize := 17;
  FLineStyle := lsDot;
  FPenStyle := Canvas.Pen.Style;
  FLineColor := Canvas.Pen.Color;

以上属性都是可以设置，也可以读取的。还有一类属性是通过其他属性计算出来的，这样的属性我们可以设定为函数，函数的返回值就是属性值。这样的函数包括网格的行数、列数。为此，我们添加两个函数。以下是这两个函数的实现代码：

{ 函数/过程操作说明：Rows/Cols
  返回当前完整的网格行/列数
  当最后一个网格只差边线时按完整网格计算}
function cxGrid.Rows: integer;
begin
  Result := (Height + 1) div BoxSize;
end;

function cxGrid.Cols: integer;
begin
  Result := (Width + 1) div BoxSize;
end;

5.3 给cxGrid类添加操作函数

网格组件的操作分为两类：一类是对网格组件本身的操作，另一类是对在网格中显示的其他组件的操作。

5.3.1 对网格本身的操作函数

表格操作的第一个内容就是画网格线。Lazarus几乎所有组件的画线和文字都是通过重写Paint函数实现的，我们也不例外。
在类定义中添加以下代码，override表示重写。

  protected
     procedure Paint; override;

在实现区添加以下代码，这是具体实现画网格线的代码，其中考虑和使用了前面定义的属性：

{ 函数/过程操作说明：cxGrid.Paint
  功能：在客户区画网格线
  网格间距为BoxSize，颜色为PenColor
  画线方式按LineStyle选择：lsNone不画线, lsDot网格交叉处画点, lsUsePen按Pen的样式}
procedure cxGrid.Paint;
var
  xx,yy,mx,my,bs:Integer;
  rc: TRect;
begin
  rc := ClientRect;
  bs := BoxSize;
  case LineStyle of
    lsDot:
    begin           
      Canvas.Pen.Color := LineColor;
      LCLIntf.DrawGrid(Canvas.Handle, rc, bs, bs);
    end;
    lsUsePen:
    begin
      Canvas.Pen.Style := PenStyle;
      Canvas.Pen.Color := LineColor;
      mx := rc.Right + 1;
      my := rc.Bottom + 1;
      xx := rc.Left;
      while xx < mx do
      begin
        Canvas.Line(xx,0,xx,my);
        Inc(xx, bs);
      end;
      yy := rc.Top;
      while yy < my do
      begin
        Canvas.Line(0, yy, mx, yy);
        Inc(yy, bs);
      end;
    end;
  end;

  inherited Paint;
end;

表格的一行包含很多的像素行，而组件的高度是按像素确定的，这样就有可能在最后一行出现一个不完整的行。表格的列也是如此。我们可以在编写程序时计算吧保持表格完整时组件的高度和宽度，但这样的计算应该在表格类cxGrid内，而不是在类之外添加代码。为此，我们添加一个函数，调整表格组件的高和宽来使得表格的最后一行/列保持完整。

{ 函数/过程操作说明： AdjustBox
  调整网格行列数、网格线间距，调整后保持最后的网格之后有边线
  调整会改变组件的长宽。当组件收到约束是可能会调整失败
  ACol, ARow参数值大于0为要设置的列/行数，
                  等于0补全最后以列/行，
                  小于0舍弃不完整的部分}
procedure cxGrid.AdjustBox(ACol, ARow, ABoxSize: Integer);
const
  BEX = 1;
var
  cw, ch, nw, nh, cc, cr, bs, dw, dh: integer;
begin
  cw := Width;
  ch := Height;
  bs := BoxSize;
  if ABoxSize > 0 then
  begin
    BoxSize := ABoxSize;
    bs := ABoxSize;
  end
  else
    bs := BoxSize;

  if ACol > 0 then
    cc := ACol
  else
    cc := Cols;
  if ARow > 0 then
    cr := ARow
  else
    cr := Rows;

  nw := cc * bs + BEX;
  nh := cr * bs + BEX;
  if nw <> cw then
  begin
    if nw <> cw + BEX then
    begin
      if ACol = 0 then
        nw := (cc + 1) * bs + BEX;
    end;
    dw := nw - cw;
    Parent.Width := Parent.Width + dw;
  end;
  if nh <> ch then
  begin
    if nh <> ch + BEX then
    begin
      if ARow = 0 then
        nh := (cr + 1) * bs + BEX;
    end;
    dh := nh - ch;
    Parent.Height := Parent.Height + dh;
  end;
end;

5.3.2 对在网格中显示的其他组件的操作

我们希望对在网格中显示的其他组件的定位使用网格坐标，也就是使用网格的行列来确定表格中组件的位置，这就需要对组件的网格坐标和客户区像素坐标进行换算。为此，我们添加坐标换算的函数。以下是函数的实现代码：

{ 函数/过程操作说明： ColRowToXY
  将网格坐标（ACol, ARow）转换为客户区像素坐标}
function cxGrid.ColRowToXY(ACol, ARow: integer): TPoint;
begin
  Result.X := ACol * BoxSize;
  Result.Y := ARow * BoxSize;
end;

function cxGrid.ColRowToXY(AColRow: TPoint): TPoint;
begin
  Result := ColRowToXY(AColRow.X, AColRow.Y);
end;
              
{ 函数/过程操作说明： ColRowFromXY
  将客户区像素坐标（x, y）转换为网格坐标}
function cxGrid.ColRowFromXY(x, y: integer): TPoint;
begin
  Result.X := x div BoxSize;
  Result.Y := y div BoxSize;
end;

function cxGrid.ColRowFromXY(xy: TPoint): TPoint;
begin
  Result := ColRowFromXY(xy.X, xy.Y);
end;

我们希望表格内的其他组件显示位置以网格的一个单元格为参照点。组件小于单元格时可以放在单元格之内，而组件大于单元格时，组件将会有一部分在单元格之外。为了满足这种定位需求，我们添加一个函数，以网格的单元格左上角与组件左上角的间隔距离来定位组件的位置，这个间隔距离可以在组件之外计算后通过参数传递给函数。以下是函数的实现代码：

{ 函数/过程操作说明：MoveTo
  将组件移动到网格（ACol, ARow）中，与网格单元格上边线和左边线的间隙为gap}
procedure cxGrid.MoveTo(ACtrl: TControl; ACol, ARow: integer; gap: integer);
var
  xy: TPoint;
begin
  xy := ColRowToXY(ACol, ARow);
  ACtrl.Left := xy.X + gap;
  ACtrl.Top := xy.Y + gap;
end;

procedure cxGrid.MoveTo(ACtrl: TControl; AColRow: TPoint; gap: integer);
begin
  MoveTo(ACtrl, AColRow.X, AColRow.Y, gap);
end;