声明：本程序设计参考象棋巫师源码（开发工具dephi 11，建议用delphi 10.3以上版本）。
第一步我们设计图形界面，显示初始化棋局。效果如下图：
我们先做个3D象棋子控件（请看我的博客关于FireMonkey3D的文章：万能控件Mesh详解），源码如下：
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，哪有记录使用方便）。本程序关键部分已讲解，整个源码共享在百度网盘：
链接：中国象棋程序设计（一）界面设计
提取码：1234
内容来源于网络如有侵权请私信删除
文章来源: 博客园
- 还没有人评论，欢迎说说您的想法！
客服
