在Lazarus下的Free Pascal编程教程——使用JSON管理游戏排行榜

0.前言

我想通过编写一个完整的游戏程序方式引导读者体验程序设计的全过程。我将采用多种方式编写具有相同效果的应用程序，并通过不同方式形成的代码和实现方法的对比来理解程序开发更深层的知识。
了解我编写教程的思路，请参阅体现我最初想法的那篇文章中的“1.编程计划”和“2.已经编写完成的文章（目录）”：

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

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

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

这是一篇专题文章，我们将通过一个简单的例子，讲述如何构建基于json的管理排行榜的类。

俄罗斯方块游戏中需要记录用户游戏的成绩，包括当前游戏的成绩和以往游戏的成绩，在这里我们就介绍用json格式保存排行榜数据的方法。

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

pTetris项目中排行榜的设计构想
给pTetris项目定制排行榜数据管理类的定义
给pTetris项目定制排行榜数据管理类cxRankings的实现详解
给pTetris项目定制排行榜数据管理类cxRankTable的实现详解
结束语

1. pTetris项目中排行榜的设计构想

pTetris项目中玩游戏的成绩记录在排行榜中，用户通过争取更好的排名来达到竞技游戏的挑战性效果。
pTetris项目的排行榜的设计构想包括：

pTetris项目提供了计分规则、加速规则、起始难度等多种选项，针对每种选项组合设立一个排行榜
游戏进行中实时记录游戏的成绩，并显示当前游戏在排行榜中的位置（名次）
- 排行榜显示在程序主界面右侧的表格中，表格中动态显示当前游戏的成绩
- 当前游戏的成绩及相关信息显示在游戏的方块移动区右侧的信息显示区

2.给pTetris项目定制排行榜数据管理类的定义

2.1 排行榜管理类概述

pTetris项目的排行榜管理建立两个类：

cxRankTable类：用来管理单个排行榜数据形成的表
- 提供当前配置对应的排行榜表的数据存取、排序
cxRankings类：用来管理所有的排行榜，包含所有的排行榜表，
- 提供从排行榜数据中选取当前配置对应的排行榜数据表提供给cxRankTable对象
- 提供将排行榜数据保存到磁盘文件、从磁盘文件读入内存的功能

排行榜管理类的代码编写参考Lazarus提供的TJSONConfig类编写。
分成两个类是为了方便下一步的使用。

编写数据管理类一般有两种方式：

格式无关：编写的数据管理类与数据存储格式无关，只有在存盘时才转换成json格式数据。
json类：使用特定的json对象作为管理数据的容器，编写的代码只是对于容器内数据的存取。

显然，有一种方式可以充分利用现有的成熟代码，编程工作量小。我们就选择这种方式。

2.2 排行榜管理类cxRankings的定义

cxRankings类是排行榜数据管理的入口，提供对应于所有选项组合的排行榜的综合管理。下面是cxRankings类的定义，具体的成员函数在下一小节中详细解说。

  cxRankings = class(TComponent)
  private
    FFormatIndentSize: Integer;
    FFormatoptions: TFormatOptions;
    FFormatted: Boolean;
    FJSONOptions: TJSONOptions;
    FModified: Boolean;
    procedure SetJSONOptions(AValue: TJSONOptions);
  protected
    FRankData: TJSONObject;  
    function Filename: string;
  public
    class function KeyName: string;  constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadFromFile;
    function LoadFromStream(S: TStream): boolean;
    procedure SaveToFile;
    function RankTable: cxRankTable;
    function RankTable(key: string): cxRankTable;
    property Modified: Boolean read FModified Write FModified;
  published
    Property Formatted : Boolean Read FFormatted Write FFormatted;
    Property FormatOptions : TFormatOptions Read FFormatoptions Write FFormatOptions Default DefaultFormat;
    Property FormatIndentsize : Integer Read FFormatIndentSize Write FFormatIndentSize Default DefaultIndentSize;
    Property JSONOptions : TJSONOptions Read FJSONOptions Write SetJSONOptions Default DefaultJSONOptions;
  end;

2.3 排行榜管理类cxRankTable的定义

cxRankTable类是单个排行榜数据管理的对象，提供对当前选项组合的排行榜数据表的管理。下面是cxRankTable类的定义，具体的成员函数在下一小节中详细解说。

  cxRankTable = class(TComponent)
  const
    MaxItems = 99;
    Keys = 5;
    Header: array[0..Keys - 1] of string = ('排名', '总分', '耗时', '方块数', '消除行');
    Names: array[0..Keys - 1] of string = ('rank', 'scores', 'time', 'boxs', 'rows');
  private
    FTable: TJSONObject;
    function GetColValueAsDouble(ARow: integer; key: string): double;
    function GetColValueAsInteger(ARow: integer; key: string): integer;
    function GetColValueAsString(ARow: integer; key: string): string;
    function GetCurrentRow: Integer;
    procedure SetColValueAsDouble(ARow: integer; key: string; AValue: double);
    procedure SetColValueAsInteger(ARow: integer; key: string; AValue: integer);
    procedure SetColValueAsString(ARow: integer; key: string; AValue: string);
    procedure SetCurrentRow(AValue: Integer);
    procedure SetTable(AValue: TJSONObject);

  protected
    function HasRow(ARow: integer; var ARankRow: cxRankRow): boolean;
  public
    //constructor Create(AOwner: cxRankings); override;
    //destructor Destroy; override;
    property Table: TJSONObject read FTable write SetTable;
    function List: TJSONArray;
    function OwnerRank: cxRankings;
    function NewRow:integer;
    function CheckRow:boolean;
    property CurrentRow:Integer read GetCurrentRow write SetCurrentRow;
    property ColValueAsString[ARow: integer;key: string]: string read GetColValueAsString write SetColValueAsString;
    property ColValueAsInteger[ARow: integer;key: string]: integer read GetColValueAsInteger write SetColValueAsInteger;
    property ColValueAsDouble[ARow: integer;key: string]: double read GetColValueAsDouble write SetColValueAsDouble;
  end;

3.给pTetris项目定制排行榜数据管理类cxRankings的实现详解

3.1 用来存储数据的json对象

定义一个变量保存json数据对象，这个数据对象中保存完整的排行榜数据。

FRankData: TJSONObject;

这个接送数据对象在构造函数中创建，在析构函数中销毁。

constructor cxRankings.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRankData:=TJSONObject.Create;
  FFormatOptions:=DefaultFormat;
  FFormatIndentsize:=DefaultIndentSize;
  FJSONOptions:=DefaultJSONOptions;
end;

destructor cxRankings.Destroy;
begin
  if Assigned(FRankData) then
  begin
    SaveToFile;
    FreeAndNil(FRankData);
  end;
  inherited Destroy;
end;

3.2 排行榜数据的保存

Lazarus的json代码没有提供保存到文件的函数，只提供的转换为json格式的字符串的函数。我们需要自己编写保存到文件的代码。分为两部分操作：

先将json对象中的数据转换为json格式的字符串
然后将字符串保存到磁盘文件

排行榜存盘有关的函数和属性包括：

定义函数SaveToFile将json对象中的排行榜数据保存到磁盘文件中。SaveToFile函数仅在析构函数Destroy中调用
定义了属性Formatted、FormatOptions、FormatIndentsize、JSONOptions用来指示保存文件后的文本格式。如果不需要考虑存盘文本的可读性，可以不考虑这些属性
定义属性Modified作为数据修改的标志，仅当Modified=true时才将数据保存到文件。Modified的值在cxRankTable中设置
函数FileName生成存盘文件名

SaveToFile函数的实现参考了代码如下：

procedure cxRankings.SaveToFile;
var
  F: TFileStream;
  S: TJSONStringType;
begin
  if Modified then
  begin
    F := TFileStream.Create(FileName, fmCreate);
    try
      if Formatted then
        S := FRankData.FormatJSON(Formatoptions, FormatIndentSize)
      else
        S := FRankData.AsJSON;
      if S > '' then
        F.WriteBuffer(S[1], Length(S));
    finally
      F.Free;
    end;
    FModified := False;
  end;
end;

FileName函数的代码如下：

function cxRankings.Filename: string;
var
  fn: string;
begin
  fn := Application.ExeName;
  Result := ChangeFileExt(fn, '.rank');
end;

3.3 排行榜数据的读取

Lazarus的json代码中TJSONParser提供了解析文本格式的json数据保存到内存json对象的操作。由于可能有文件不存在或解析失败的情况，我们需要自己编写读取文件的代码。分为两部分操作：

先将读取文件到TFileStream
然后使用TJSONParser使用TFileStream对象中的数据创建TJSONObject对象保存到FRankData
考虑文件不存在或者解析失败时创建一个空的TJSONObject对象保存到FRankData

读取文件用到两个函数LoadFromFile、LoadFromStream，代码如下：

procedure cxRankings.LoadFromFile;
var
  F: TFileStream;
  fn: string;
  ok: boolean;
begin
  ok := False;
  //读入上次存盘的文件
  fn := Filename;
  if FileExists(fn) then
  begin
    F := TFileStream.Create(fn, fmopenRead or fmShareDenyWrite);
    try
      ok := LoadFromStream(F);
    finally
      F.Free;
    end;
  end;
  //如果读文件失败，创建空的对象
  if not ok then
  begin
    FreeAndNil(FRankData);
    FRankData := TJSONObject.Create;
  end;
end;

function cxRankings.LoadFromStream(S: TStream):boolean;
const
  SErrInvalidJSONFile = '"%s" is not a valid JSON configuration file.';
var
  P: TJSONParser;
  J: TJSONData;
begin
  //解析S中的数据，仅当 J 为 TJSONObject 对象时返回解析的数据
  Result:=False;
  P := TJSONParser.Create(S, FJSONOptions);
  try
    J := P.Parse;
    if (J is TJSONObject) then
    begin
      FreeAndNil(FRankData);
      FRankData := J as TJSONObject;
      Result:=True;
    end
    else
    begin
      FreeAndNil(J);
      //raise EJSONConfigError.CreateFmt(SErrInvalidJSONFile, [FileName]);
    end;
  finally
    P.Free;
  end;
end;

3.4 获取当前配置对应的排行榜数据表

FRankData对象中包含所有的排行榜表，cxRankings提供了读取当前配置对应的排行榜表的方法：

每个排行榜表通过KeyName函数生成的关键字来命名
RankTable函数通过当前配置的KeyName从FRankData中获得当前配置的旁行榜数据提供给cxRankTable对象

KeyName函数从FConfig对象中获得当前配置数据生成当前配置对应的排行榜数据在FRankData对象中的关键字名称。KeyName函数代码如下：

class function cxRankings.KeyName: string;
var
  stb: TStringBuilder;
  iii: integer;
  bbb, bbc: boolean;
begin
  Result := '';
  stb := TStringBuilder.Create;
  try
    //计分规则
    iii := FConfig.ConfigData.GetValue('trcScoreBase/Position', 1);
    stb.Append(iii);
    bbb := FConfig.ConfigData.GetValue('ckScoreHeight/Checked', True);
    iii := FConfig.ConfigData.GetValue('trcScoreHeight/Position', 1);
    if bbb then
      stb.Append(iii)
    else
      stb.Append(0);
    bbb := FConfig.ConfigData.GetValue('ckScoreDesBase/Checked', True);
    iii := FConfig.ConfigData.GetValue('trcScoreDesBase/Position', 1);
    if bbb then
    begin
      stb.Append(iii);
      bbc := FConfig.ConfigData.GetValue('ckScoreDesHeight/Checked', True);
      iii := FConfig.ConfigData.GetValue('trcScoreDesHeight/Position', 1);
      if bbc then
        stb.Append(iii)
      else
        stb.Append(0);
      bbc := FConfig.ConfigData.GetValue('ckScoreDesRows/Checked', True);
      iii := FConfig.ConfigData.GetValue('trcScoreDesRows/Position', 1);
      if bbc then
        stb.Append(iii)
      else
        stb.Append(0);
    end
    else
      stb.Append('000');
    //加速规则
    iii := FConfig.ConfigData.GetValue('trcSpeedBase/Position', 1);
    stb.Append(iii);
    bbb := FConfig.ConfigData.GetValue('ckSpeedKey/Checked', True);
    iii := FConfig.ConfigData.GetValue('trcSpeedKey/Position', 1);
    if bbb then
      stb.Append(iii)
    else
      stb.Append(0);
    bbb := FConfig.ConfigData.GetValue('ckSpeedTimer/Checked', True);
    iii := FConfig.ConfigData.GetValue('trcSpeedTimer/Position', 1);
    if bbb then
      stb.Append(iii)
    else
      stb.Append(0);
    iii := FConfig.ConfigData.GetValue('grpTimeCalc/ItemIndex', 0);
    stb.Append(iii);
    //起始难度       
    iii := FConfig.ConfigData.GetValue('trcStartTime/Position', 9);
    stb.Append(iii);
    iii := FConfig.ConfigData.GetValue('trcStartHeight/Position', 0);
    if iii < 10 then
    begin
      stb.Append('0');
      stb.Append(iii);
    end
    else
      stb.Append(iii);
    iii := FConfig.ConfigData.GetValue('trcNextNumber/Position', 4);
    stb.Append(iii);
    iii := FConfig.ConfigData.GetValue('grpBoxStyle/ItemIndex', 0);
    stb.Append(iii);
    bbb := FConfig.ConfigData.GetValue('ckPenetrate/Checked', False);
    iii := IfThen(bbb, 1, 0);
    stb.Append(iii);    
    bbb := FConfig.ConfigData.GetValue('ckGameKeptTime/Checked', True);
    iii := FConfig.ConfigData.GetValue('trcGameKeptTime/Position', 1);
    if bbb then
      stb.Append(iii)
    else
      stb.Append(0);
    bbb := FConfig.ConfigData.GetValue('ckBoxHeap/Checked', True);
    iii := FConfig.ConfigData.GetValue('trcBoxHeap/Position', 2);
    if bbb then
      stb.Append(iii)
    else
      stb.Append(0);
    Result := stb.toString;
  finally
    stb.Free;
  end;
end;

RankTable函数获得当前排行榜的数据表提供给cxRankTable对象返回，这个cxRankTable对象将是我们在程序中存取当前排行榜数据的场所。
cxRankings仅保持一个cxRankTable对象，采用的是子组件管理，而没有创建变量来保存对象。如果你不希望cxRankings从组件继承，则需要设置一个变量来保存当前cxRankTable对象。这两种保存cxRankTable对象的方式没有优劣之分，其效果是一样的，全凭程序员的爱好来选择。
RankTable函数的代码如下：

function cxRankings.RankTable: cxRankTable;
begin
  Result := RankTable(KeyName);
end;

function cxRankings.RankTable(key: string): cxRankTable;
var
  ja: TJSONObject;
  cmp: TComponent;
  jd: TJSONData;
begin
  //获得 cxRankTable 对象实例，保持唯一的
  if ComponentCount > 0 then
  begin
    cmp := Components[0];
    Result := cmp as cxRankTable;
  end
  else
  begin
    Result := cxRankTable.Create(Self);
  end;
  //获取 TJSONArray 对象，按key查找
  jd := FRankData.Find(key, jtObject);
  if Assigned(jd) then
  begin
    ja := jd as TJSONObject;
  end
  else
  begin
    ja := TJSONObject.Create;
    FRankData.Add(key, ja);
  end;
  Result.Table := ja;
end;

4.给pTetris项目定制排行榜数据管理类cxRankTable的实现详解

4.1 获取当前cxRankTable所属的cxRankings对象

cxRankTable对象在cxRankings中创建，其Owner指向创建它的cxRankings对象。通过函数OwnerRank获得这个对象并完成类型转换，代码如下：

function cxRankTable.OwnerRank: cxRankings;
begin
  Result := Owner as cxRankings;
end;

4.2 用来存储数据的json对象

cxRankTable中的json数据对象通过属性Table存取，其定义如下：

property Table: TJSONObject read FTable write SetTable;

变量FTable和函数SetTable保持了Lazarus代码补全生成的默认代码。
FTable对象中的数据包含两个元素：row和list。

4.3 json对象中的排行榜表list

定义函数List获得Table对象中的list元素所指的对象。List返回的对象是TJSONArray类型的，它的每一个元素是排行榜表格的一行。对排行榜表格的所有操作都使用List获得排行榜表格对象。函数List代码如下：

function cxRankTable.List: TJSONArray;
const
  key = 'list';
var
  jd: TJSONData;
begin
  jd := Table.Find(key, jtArray);
  if Assigned(jd) then
  begin
    Result := jd as TJSONArray;
  end
  else
  begin
    Result := TJSONArray.Create;
    Table.Add(key, Result);
  end;
end;

4.4 排行榜表格的行

List获得的排行榜表格由若干行组成，每一个行在List中都是一个TJSONObject对象。为了可读性，更是为了方便可能存在的修改，定义了行对象的名字如下：

cxRankRow = TJSONObject;

采用这种定义方式可以在程序中使用cxRankRow而不是直接使用TJSONObject，这样做了之后，如果将来想使用其他的数据类型，只需要重新定义cxRankRow即可，其他代码的修改会很少。
存取排行榜表格中的数据首先需要获得ARow所指的行对象，为此定义了函数HasRow，其实现代码如下：

function cxRankTable.HasRow(ARow: integer; var ARankRow: cxRankRow): boolean;
var
  lst: TJSONArray;
begin
  lst:=List;
  Result := (ARow >= 0) and (ARow < lst.Count);
  if Result then
    ARankRow := lst.Objects[ARow]
  else
    ARankRow := nil;
end;

如果指定的行不存在就使用NewRow函数添加一个新的空行。函数NewRow的代码如下：

function cxRankTable.NewRow: integer;
var
  jsn: cxRankRow;
  lst: TJSONArray;
begin
  lst:=List;
  while lst.Count > MaxItems do
    lst.Delete(lst.Count - 1);
  jsn := cxRankRow.Create;
  Result := lst.Add(jsn);
  CurrentRow := Result;
end;

NewRow函数的代码中有两点需要说明：
一个是排行榜中表格的最大行数由常数MaxItems限定，仅保留排名前MaxItems的成绩，超过MaxItems的行要删除。
另一个是CurrentRow新建行的行号保存在CurrentRow中。这里的CurrentRow是指当前行，在游戏中指向当前正在进行的游戏的成绩在排行榜表中的位置。CurrentRow的数值保存在Table对象的row元素中。
属性CurrentRow的定义如下：

    property CurrentRow:Integer read GetCurrentRow write SetCurrentRow;

属性 CurrentRow数值存取的实现如下：

function cxRankTable.GetCurrentRow: Integer;
begin
  Result := Table.Get('row', 0);
end; 

procedure cxRankTable.SetCurrentRow(AValue: Integer);
begin
  if CurrentRow = AValue then Exit;
  Table.Integers['row'] := AValue;
end;

排行榜表格的每一行对象中包含的元素就是表格的列。通过列的名字key识别列对象。理论上key可以使用任何符合json约定的字符串，但是在排行榜中约定了key的取值，那就是定义的常数Names：

Names: array[0..Keys - 1] of string = ('rank', 'scores', 'time', 'boxs', 'rows');

Keys是排行榜列数。
排行榜的行是通过scores列的值排序的，排序的操作使用函数CheckRow完成。CheckRow函数仅检查CurrentRow所指的当前行，按当前行的scores列的值移动到List对象的适当位置，移动后新的位置保存在CurrentRow中。
CheckRow函数的代码如下：

function cxRankTable.CheckRow: boolean;
var
  cRow, pRow: cxRankRow;
  crw, scc, scp: integer;
begin
  Result := False;
  crw := CurrentRow;
  if HasRow(crw, cRow) then
  begin
    while HasRow(crw - 1, pRow) do
    begin
      scc := cRow.Get('scores', 0);
      scp := pRow.Get('scores', 0);
      if scc > scp then
      begin
        List.Exchange(crw, crw - 1);
        crw := crw - 1;
        CurrentRow := crw;
        Result := True;
      end
      else
        Break;
    end;
  end;
end;

4.5 对排行榜表格中数据的存取

定义ColValueAsString、ColValueAsInteger、ColValueAsDouble三个属性用来存取排行榜表格中的数据，每个属性代表一种数据类型。只要符合规则，不同类型的数据可以相互转换。

property ColValueAsString[ARow: integer;key: string]: string read GetColValueAsString write SetColValueAsString;
    property ColValueAsInteger[ARow: integer;key: string]: integer read GetColValueAsInteger write SetColValueAsInteger;
    property ColValueAsDouble[ARow: integer;key: string]: double read GetColValueAsDouble write SetColValueAsDouble;

上述属性定义中ARow是行号，key是列的名字。按着约定，key的取值应该包含的常数Names中。
使用属性ColValueAsString、ColValueAsInteger、ColValueAsDouble保存排行榜表格中数据的代码如下：

procedure cxRankTable.SetColValueAsDouble(ARow: integer; key: string; AValue: double);
var
  cRow: cxRankRow;
begin
  while not HasRow(ARow, cRow) do
    NewRow;
  cRow.Floats[key] := AValue;   
  OwnerRank.Modified := True;
end;

procedure cxRankTable.SetColValueAsInteger(ARow: integer; key: string; AValue: integer);
var
  cRow: cxRankRow;
begin
  while not HasRow(ARow, cRow) do
    NewRow;
  cRow.Integers[key] := AValue;  
  OwnerRank.Modified := True;
end;

procedure cxRankTable.SetColValueAsString(ARow: integer; key: string; AValue: string);
var
  cRow: cxRankRow;
begin
  while not HasRow(ARow, cRow) do
    NewRow;
  cRow.Strings[key] := AValue;
  OwnerRank.Modified := True;
end;

从上述代码中可以看出，首先使用HasRow获得行的对象，如果指定的行不存在就使用NewRow函数添加一个新的空行，写入数据后设置修改标志。
使用属性ColValueAsString、ColValueAsInteger、ColValueAsDouble读入排行榜表格中数据的代码如下：

function cxRankTable.GetColValueAsDouble(ARow: integer; key: string): double;
var
  cRow: cxRankRow;
  jd: TJSONData;
begin
  Result := 0.0;
  if HasRow(ARow, cRow) then
  begin
    jd := cRow.Find(key);
    if Assigned(jd) then
      Result := jd.AsFloat;
  end;
end;

function cxRankTable.GetColValueAsInteger(ARow: integer; key: string): integer;
var
  cRow: cxRankRow;
  jd: TJSONData;
begin
  Result := 0;
  if HasRow(ARow, cRow) then
  begin
    jd := cRow.Find(key);
    if Assigned(jd) then
      Result := jd.AsInteger;
  end;
end;

function cxRankTable.GetColValueAsString(ARow: integer; key: string): string;
var
  cRow: cxRankRow;
  jd: TJSONData;
begin
  Result := '';
  if HasRow(ARow, cRow) then
  begin
    jd := cRow.Find(key);
    if Assigned(jd) then
      Result := jd.AsString;
  end;
end;

从以上代码中可以看出，读和写数据使用的json的对象的方法不一样，这是因为Lazarus提供的json管理代码的缺陷造成的。当然，采用这样的方式可以更安全地读写数据，避免因为节点不存在而出现错误。

5.结束语

Lazarus提供了丰富灵活的json数据管理代码，用户可以在自己的程序中直接使用这些代码存取数据，但是这样有两个缺陷就是可读性差和维护成本高。避免这种缺陷的方法就是将json对象封装在自己的类中，这样做虽然增加了编写代码的工作量，但可读性和可维护性都得到了改善。

posted @ 2025-04-06 15:41 lexyao 阅读(103) 评论(0) 收藏举报

刷新页面返回顶部

业余高级程序员

记录生活中的点点滴滴，作为将来茶余饭后回味生活的……