FireMonkey3D之中国象棋程序界面设计

Posted 2021-12-12 交流学习编程知识

声明：本程序设计参考象棋巫师源码（开发工具dephi 11，建议用delphi 10.3以上版本）。

第一步我们设计图形界面，显示初始化棋局。效果如下图：

 我们先做个3D象棋子控件（请看我的博客关于FireMonkey3D的文章），源码如下：

unit ChessPiece;

interface

uses
  System.SysUtils,System.Types,System.UITypes,System.Classes, FMX.Types, FMX.Controls3D, FMX.Objects3D,FMX.Types3D,
  FMX.Materials,System.Math.Vectors,FMX.Graphics,System.Math,System.RTLConsts;
type
  TChessPiece = class(TControl3D)
  private
    FMat:TLightMaterial;
    FBitmap:TTextureBitmap;
	  FChessName:string;
    FSide,FID:Byte;//ID为棋子序号
    FColor:TAlphaColor;
    procedure SetChessName(const Value:string);
    procedure SetSide(const Value:Byte);
	  procedure SetID(const Value:Byte);
    procedure DrawPiece;
  protected
    procedure Render; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ChessName:string  read FChessName write SetChessName;
	  property Side:Byte  read FSide write SetSide default 0;
	  property id:Byte read FID write SetID;
    property Cursor default crDefault;
    property DragMode default TDragMode.dmManual;
    property Position;
    property Scale;
    property RotationAngle;
    property Locked default False;
    property Width;
    property Height;
    property Depth nodefault;
    property Opacity nodefault;
    property Projection;
    property HitTest default True;
    property VisibleContextMenu default True;
    property Visible default True;
    property ZWrite default True;
    property OnDragEnter;
    property OnDragLeave;
    property OnDragOver;
    property OnDragDrop;
    property OnDragEnd;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnKeyDown;
    property OnKeyUp;
    property OnRender;
  end;
procedure Register;

implementation
procedure TChessPiece.DrawPiece;
var
  Rect:TRectF;
begin
  with FBitmap do
  begin
	Canvas.BeginScene;
  Clear($FFFFFFFF);
  Rect:=TRectF.Create(2,2,98,98);
  Canvas.Stroke.Thickness:=2;
  Canvas.Stroke.Color:=FColor;
	Canvas.DrawEllipse(Rect,1);
  Canvas.Fill.Color:=FColor;
	Canvas.FillText(Rect,FChessName,false,1,[TFillTextFlag.RightToLeft],TTextAlign.Center,TTextAlign.Center);
	Canvas.EndScene;
  end;
  Repaint;
end;

constructor TChessPiece.Create(AOwner: TComponent);
begin
  inherited;
  FColor:=$FFFF0000;
  FChessName:=\'车\';
  FMat:=TLightMaterial.Create;
  FMat.Emissive:=TAlphaColorRec.Burlywood;
  FBitmap:=TTextureBitmap.Create;
  with FBitmap do
  begin
    SetSize(100,200);
    Canvas.Font.Family:=\'方正隶书繁体\';
	  Canvas.Font.Size:=85;
  end;
  DrawPiece;
end;

destructor TChessPiece.Destroy;
begin
  FMat.Free;
  FBitmap.Free;
  inherited;
  
end;
procedure TChessPiece.SetChessName(const Value:string);
begin
  if FChessName <> Value then
  begin
    FChessName := Value;
    DrawPiece;
  end;
end;
procedure TChessPiece.SetSide(const Value:Byte);
begin
  if FSide <> Value then
  begin
    FSide := Value;
    case FSide of
         0:  FColor:=$FFFF0000;
         1:  FColor:=$FF24747D;
    end;
    DrawPiece;
  end;
end;
procedure TChessPiece.SetID(const Value:Byte);
begin
  if FID<>value then
     FID:=Value;
end;
procedure TChessPiece.Render;
var
  i,j,k,VH,VW,AA,BB,M:Integer;
  indice:array of  Integer;
  P,P1:TPoint3D;
  Ver:TVertexBuffer;
  Idx:TIndexBuffer;
  Pt:TPointF;
  Angle,H,D,R:Single;//H:前后圆的半径Height/2,R:棋子周边圆弧的半径,D棋子的厚度Height/5
begin
  VH:=32;VW:=12;
  indice:=[0,1,3,0,3,2];
  H:=0.5*Height;
  D:=0.2*Height;
  R:=D/sin(DegToRad(48));
  FMat.Texture:=nil;
  FMat.Texture:=FBitmap.Texture;
  Ver:=TVertexBuffer.Create([TVertexFormat.Vertex,TVertexFormat.Normal,TVertexFormat.TexCoord0],VH*VW*4+VH*2);
  Idx:=TIndexBuffer.Create(VH*6*VW+VH*6-12,TIndexFormat.UInt32);
  AA:=0;BB:=0;
  //Around棋子周边
  for I := 0 to VH-1 do
  for J := 0 to VW-1 do
  begin
    for k := 0 to 1 do
    begin
      Angle:=DegToRad((318-(j+k)*8));
      P:=Point3D(0,R*sin(Angle),R*Cos(Angle));
      P1:=P/R;
      P.Offset(0,-R*Sin(DegToRad(318))-H,0);
      Ver.Vertices[AA+k*2]:=P*TMatrix3D.CreateRotationZ(2*Pi/VH*i);
      Ver.Normals[AA+k*2]:=P1*TMatrix3D.CreateRotationZ(2*Pi/VH*i);
	    Ver.Vertices[AA+k*2+1]:=P*TMatrix3D.CreateRotationZ(2*Pi/VH*(i+1));
      Ver.Normals[AA+k*2+1]:=P1*TMatrix3D.CreateRotationZ(2*Pi/VH*(i+1));
	    //按横向、纵向细分一个贴图
      Ver.TexCoord0[AA+k*2]:=PointF(1/12*(J+k),I/128+0.5);
      Ver.TexCoord0[AA+k*2+1]:=PointF(1/12*(J+k),(I+1)/128+0.5);
    end;
    inc(AA,4);
    for k :=0 to 5 do
    begin
      Idx.Indices[BB]:=indice[k]+4*(BB div 6);
      inc(BB);
    end;
  end;
  //Front Back 前后圆
  M:=AA;
  for I := 0 to VH-1 do
  begin
    P:=Point3D(0,-H,-D);
    Ver.Vertices[AA]:=P*TMatrix3D.CreateRotationZ(2*Pi/VH*i);
    Ver.Normals[AA]:=Point3D(0,0,-1);
    Pt:=PointF(0,-0.5).Rotate(2*Pi/VH*i);
    Pt.Offset(0.5,0.5);
    Ver.TexCoord0[AA]:=PointF(Pt.x,Pt.y/2);;
    P:=Point3D(0,-H,D);
    Ver.Vertices[AA+1]:=P*TMatrix3D.CreateRotationZ(2*Pi/VH*i);
    Ver.Normals[AA+1]:=Point3D(0,0,1);
    Ver.TexCoord0[AA+1]:=PointF(Pt.x,Pt.y/2+0.5);
    Inc(AA,2);
  end;
  for I := 0 to VH-3 do
  begin
    Idx.Indices[BB]:=M+2+I*2;
    Idx.Indices[BB+1]:=M+4+I*2;
    Idx.Indices[BB+2]:=M;
    Idx.Indices[BB+3]:=M+5+I*2;
    Idx.Indices[BB+4]:=M+3+i*2;
    Idx.Indices[BB+5]:=M+1;
    Inc(BB,6);
  end;
  Context.DrawTriangles(ver,idx,FMat,Opacity);
  Ver.Free;
  Idx.Free;
end;
procedure Register;
begin
  RegisterComponents(\'3D Others\', [TChessPiece]);
end;

end.

1.1、棋盘表示

中国象棋有10行9列，很自然地想到可以用10×9矩阵表示棋盘。界面左侧棋盘为Image3D控件，加载一个做好的“棋盘.png”，设定其width、height分别为9、10，3D里的单位不是像素，根据估算，1个单位相当于50像素。同时放置一个TDummy控件，Name=PieceDy，用来放棋子。由于3D控件的特性，其MouseUp事件并不能确定位纵横坐标值，所有我定义了csLy:array [0..9,0..8]  of TLayout3D控件，对应10×9矩阵，这样通过点击TLayout3D就可以知道所在格子的纵横坐标。先把棋盘做好：

var
  I,J:Integer;
  csLy:array[0..9,0..8]of TLayOut3D;
begin
  ChessBg.Bitmap.LoadFromFile(\'棋盘.png\');
  for i := 0 to 9 do
    for j := 0 to 8 do
    begin
      csLy[i,j]:=TLayout3D.Create(self);
      csLy[i,j].Parent:=PieceDy;
      csLy[i,j].Position.Point:=Point3D(j-4,i-4.5,0);//3D物体的原点在其中心，所以csLy要偏移
      csLy[i,j].SetSize(1,1,0);
      csLy[i,j].OnClick:=csBoard;//Click事件统一使用csBoard。
    end;
end;

1.2、棋子表示

为了与象棋巫师兼容，使用整数表示棋子： 

 //棋子编号
 const 
  csName: string = \'车马相仕帅仕相马车炮炮兵兵兵兵兵车马象士将士象马车炮炮卒卒卒卒卒\';
  PcCode: array[0..31] of Byte=    //棋子的编号
   (4,3,2,1,0,1,2,3,4,5,5,6,6,6,6,6,
    4,3,2,1,0,1,2,3,4,5,5,6,6,6,6,6);

  PIECE_KING    = 0;    //帅（将）
  PIECE_ADVISOR = 1;    //士（仕）
  PIECE_BISHOP  = 2;    //相（象）
  PIECE_KNIGHT  = 3;    //马
  PIECE_ROOK    = 4;    //车
  PIECE_CANNON  = 5;    //炮
  PIECE_PAWN    = 6;    //兵（卒）　

3D程序设计时，32个棋子必须要有自己的id，否则不好调用，0-15为红棋，16-31为黑棋，其顺序按csName排列，现在把32个棋子建立起来： 

var chess:array[0..31] of TChessPiece;
for I :=0 to 31 do
  begin
    chess[i]:=TChessPiece.Create(Self);
    chess[i].Parent:=PieceDy;
    if i>15 then
       chess[i].side:=1;//side表示红黑走棋方
    chess[i].ChessName:=csName[i+1];
    chess[i].ID:=i;
    chess[i].Height:=0.8;
    chess[i].OnClick:=csBoard;//同上
  end;

1.3、字符串（或数组）表示局面

根据UCCI标准，我们用一行字符串表示一个局面，这就是FEN文件格式串。中国象棋的初始局面可表示为：

rnbakabnr/9/1c5c1/p1p1p1p1p/9/9/P1P1P1P1P/1C5C1/9/RNBAKABNR w - - 0 1

红色区域，表示棋盘布局，小写表示黑方，大写表示红方。一个字母表示一个棋子，与上面定义的首字母对应，数字表示有n个空。本程序只解析红色部分。“/”用来区分每一行，共10行。1c5c1解析起来就是：□炮□□□□□炮□，代码：

procedure FromFen(FEN:string);
var
  i,j,k,id:Integer;
  Str,CODE:string;
  ss:TArray<string>;
begin
  CODE:=\'RNBAKABNRCCPPPPPrnbakabnrccppppp\';
  ss:=FEN.Substring(0,FEN.IndexOf(\' \')).Split([\'/\']);
  for I := 0 to 31 do
  begin
    chess[i].Visible:=False;
  end;
  for I := 0 to 9 do
  begin
    Str:=ss[i];
    k:=0;
    for j := 1 to Length(Str) do
    begin
      id:=CODE.IndexOf(Str[j]);
      if id>=0 then
      begin
        chess[id].Visible:=True;
        chess[id].Position.Point:=Point3D(k-4,i-4.5,-0.16);
        CODE[id+1]:=\' \';
        Inc(k);
      end
      else
        Inc(k,ord(Str[j])-$30);
    end;
  end;
end;　　

　其实用数组简单得多：

var
  i:Integer;
  P:TPoint;
const
  startPos: array[0..31] of Byte =//棋子的初始位置
    ($09, $19, $29, $39, $49, $59, $69, $79, $89, $17, $77, $06, $26, $46, $66, $86,
     $00, $10, $20, $30, $40, $50, $60, $70, $80, $12, $72, $03, $23, $43, $63, $83);
  
begin
  for I := 0 to 31 do
  begin
    chess[i].Visible:=False;
    chess[i].ResetRotationAngle;
    P:=Point(startPos[i] shr 4,startPos[i] and $F);
    chess[i].Position.Point:=Point3D(P.X-4,P.Y-4.5,-0.16);
    chess[i].Visible:=true;
   end;
end;

1.4、走动棋子

我们让棋子可以通过点击实现走棋。点击时，要考虑源点和目标点，选中的是哪个棋子等细节。定义全局变量：selecti=32，因为棋子的id是从0-31，零已被占用，就用32表示未选中棋子。棋子从源点的位置走到目标点的位置，即实现走棋。

首先要定义两个函数：

var  
  selecti:Byte=32;
function GetPos(Pt:TPosition3D):TPoint;
begin
  Result:=Point(Round(Pt.X+4),Round(Pt.Y+4.5));
end;
function GetChessPos(i:Byte):TPoint;
var
  Pt:TPosition3D;
begin
  Pt:=chess[i].Position;
  Result:=Point(Round(Pt.X+4),Round(Pt.Y+4.5));
end;
//GetPos根据3D控件的位置，获取其坐标
//GetChessPos根据chess的id，获取其坐标　

 然后，定义csBoard鼠标点击事件，我们已经把chess和csLy的点击事件关联到了csBoard，这样只需要写一个函数即可实现所有控件的点击事件。这里要实现红黑方轮流走棋，就要定义Player，0表示红棋，1表黑棋，完成走棋后必须切换Player。我们用动画实现走棋，体现走棋的过程。代码如下：

var
  player:Byte=0;//默认0为红，黑为1；
  Animator:TAnimator;//动画控件
procedure TChessForm.MoveAni(i:integer;dest:TPoint);
begin
  Animator.AnimateFloat(chess[i],\'Position.X\',csLy[dest.Y,dest.X].Position.X,0.1);
  Animator.AnimateFloat(chess[i],\'Position.Y\',csLy[dest.Y,dest.X].Position.Y,0.1);
  Animator.AnimateFloatWait(chess[i],\'Position.Z\',-0.16,0.1);
end;
procedure ChangeSide;
begin
  Player:=1-Player;//换边
end;
procedure csBoard(Sender: TObject);
var
  id:Byte;
  src,dest:TPoint;
begin
  if selecti=32 then
  begin
    if Sender is TLayout3D then Exit; //未选棋且点击空白处
    id:=TChessPiece(Sender).id;
    if Player<>chess[id].Side then Exit; //未轮到某方走棋
    chess[id].Position.Z:=-0.5;//选中的棋“抬”起来，类似天天象棋的效果
    selecti:=id;
    Exit;
  end;
  if Sender is TChessPiece then   //已选中棋子，且dest点也是棋子
  begin
    id:=TChessPiece(Sender).id;
    if id=selecti then Exit;      //与选中棋子相同
    if Player=chess[id].Side then //与选中棋子同属一个阵营
    begin
      chess[id].Position.Z:=-0.5;
      chess[selecti].Position.Z:=-0.16;
      selecti:=id;
      Exit;
    end;
  end;
  src:=GetChessPos(selecti);
  dest:=GetPos(TControl3D(Sender).Position);
  MoveAni(selecti,dest);
   if  Sender is TChessPiece then
  begin
    chess[id].Visible:=False;
  end;
  selecti:=32;
  changeSide;
end;

　说明：为了便于程序后续设计，所有常量及全局变量放在csCommn单元内，实现走棋的函数全面放在csPieceMove单元。csPieceMove定义了一个record：

type TPieceMove=record
  Player:Integer;//轮到谁走，0=红方，1=黑方
  procedure Startup;                   //初始化棋盘
  procedure FromFen(FEN:string);       //从棋谱开局初始化棋盘
  procedure ChangeSide;                //换边
end;

使用记录将函数、变量进行封装，调用起来就非常简单，不需要声明函数（为何不用calss，class需要Create和Free，哪有记录使用方便）。本程序关键部分已讲解，整个源码共享在百度网盘：

链接：https://pan.baidu.com/s/1ju5txx3uNJDaie4zJKb-TA
提取码：1234