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

声明：本程序设计参考象棋巫师源码（开发工具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.