path: root/plugins/Chess4Net/ChessBoardUnit.pas

////////////////////////////////////////////////////////////////////////////////
// All code below is exclusively owned by author of Chess4Net - Pavel Perminov
// (packpaul@mail.ru, packpaul1@gmail.com).
// Any changes, modifications, borrowing and adaptation are a subject for
// explicit permition from the owner.

unit ChessBoardUnit;

interface

uses
  Forms, ExtCtrls, Classes, Controls, Graphics, Types, Messages,
  //
  ChessRulesEngine, BitmapResUnit, PromotionUnit;

type
  TMode = (mView, mGame, mAnalyse, mEdit); // Board mode

  TAnimation = (aNo, aSlow, aQuick);

  TChessBoardEvent = (cbeMate, cbeStaleMate, cbeMoved, cbePosSet, cbeMenu);
  TChessBoardHandler = procedure(e: TChessBoardEvent;
                                 d1: pointer = nil; d2: pointer = nil) of object;

  TChessBoardLayerBase = class;

  TChessBoard = class(TForm, IChessRulesEngineable)
    PBoxBoard: TPaintBox;
    AnimateTimer: TTimer;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
    procedure FormResize(Sender: TObject);
    procedure AnimateTimerTimer(Sender: TObject);
    procedure PBoxBoardPaint(Sender: TObject);
    procedure PBoxBoardDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure PBoxBoardDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure PBoxBoardEndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure PBoxBoardMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PBoxBoardMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PBoxBoardMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PBoxBoardStartDrag(Sender: TObject; var DragObject: TDragObject);

  private
    m_ChessRulesEngine: TChessRulesEngine;
    m_BitmapRes: TBitmapRes; // Manager for bitmaps

    FHandler: TChessBoardHandler;

    dx, dy: integer;  // Расстояние от курсора до верхнего левого угла
    x0, y0: integer; // Предыдущие координаты курсора
    _flipped: boolean; // Доска перевёрнута или нет
    m_bHilighted: boolean; // Hilight the move that is being done

    m_i0, m_j0: integer;
    m_fig: TFigure;

    m_Mode: TMode;
    m_bViewGaming: boolean;

    m_bmHiddenBoard: TBitmap;
    m_bmChessBoard: TBitmap;
    m_bmFigure: array[TFigure] of TBitmap;
    m_bmBuf: TBitmap;

    m_iSquareSize: integer; // Size of one chess board field

    m_animation: TAnimation; // Animation speed
    m_iAnimStep, m_iPrevAnimStep, m_iAnimStepsCount: integer;
    anim_dx, anim_dy: real; // Variables for animation of a dragged piece

    m_PlayerColor: TFigureColor; // Color of player client
    m_bDraggedMoved: boolean; // Flag for switching of dragging
    last_hilight: boolean; // Flag for hilighting of the last move done
    coord_show: boolean; // Flag for showing coordinates

    // Resizing
    m_ResizingType: (rtNo, rtHoriz, rtVert);
    m_iDeltaWidthHeight: integer;
    m_bDeltaWidthHeightFlag: boolean;

    m_PromotionForm: TPromotionForm;

    m_EditPiece: TFigure;

    m_iUpdateCounter: integer;

    m_lstLayers: TList;

    procedure HilightLastMove;
    procedure Evaluate;

    function FGetLastMove: PMoveAbs;
    property lastMove: PMoveAbs read FGetLastMove;

    function FGetPosition: PChessPosition;
    property Position: PChessPosition read FGetPosition;

    function AskPromotionFigure(FigureColor: TFigureColor): TFigureName;

    procedure FSetMode(const Value: TMode);

    function FDoMove(i, j: integer; prom_fig: TFigureName = K): boolean;
    procedure FOnAfterMoveDone;
    procedure FOnAfterSetPosition;

    procedure FAnimate(const i, j: integer); // Animates a disposition of a piece from (i0,j0) to (i,j)
    procedure FDoAnimationStep;
    procedure FEndAnimation;

    procedure FWhatSquare(const P: TPoint; var i: Integer; var j: Integer);

    procedure FSetPlayerColor(const Value: TFigureColor);
    procedure FCancelAnimationDragging; // Caneling of animation and dragging for trace removal after draw
    procedure FSetFlipped(Value: boolean); // Flips chess position
    procedure FSetCoordinatesShown(Value: boolean);
    procedure FSetLastMoveHilighted(Value: boolean);
    function FGetPositionsList: TList;
    function FGetPositionColor: TFigureColor;
    function FGetMoveNotationFormat: TMoveNotationFormat;
    procedure FSetMoveNotationFormat(Value: TMoveNotationFormat);
    function FGetFENFormat: boolean;
    procedure FSetFENFormat(bValue: boolean);

    procedure FDrawHiddenBoard;
    function FGetHiddenBoardCanvas: TCanvas;

    procedure FDrawBoard;    
    procedure FOnDrawLayerUpdate(const ADrawLayer: TChessBoardLayerBase);

    function FGetMovesOffset: integer;
    function FGetColorStarts: TFigureColor;    

    procedure WMSizing(var Msg: TMessage); message WM_SIZING;

    procedure FDoHandler(e: TChessBoardEvent; d1: pointer = nil; d2: pointer = nil);

    property SquareSize: integer read m_iSquareSize;
    property PositionsList: TList read FGetPositionsList;    

  public
    constructor Create(Owner: TComponent; AHandler: TChessBoardHandler = nil); reintroduce;

    function DoMove(const strMove: string): boolean;
    procedure ResetMoveList;
    function SetPosition(const strPosition: string): boolean;
    function GetPosition: string;
    procedure InitPosition;
    procedure PPRandom;
    procedure TakeBack;
    function NMoveDone: integer;
    function NPlysDone: integer;

    function IsMoveAnimating: boolean;

    procedure BeginUpdate;
    procedure EndUpdate;

    procedure AddLayer(const ALayer: TChessBoardLayerBase);
    procedure RemoveLayer(const ALayer: TChessBoardLayerBase);

    property PlayerColor: TFigureColor read m_PlayerColor write FSetPlayerColor;
    property Mode: TMode read m_Mode write FSetMode;
    property CoordinatesShown: boolean read coord_show write FSetCoordinatesShown;
    property Flipped: boolean read _flipped write FSetFlipped;
    property LastMoveHilighted: boolean read last_hilight write FSetLastMoveHilighted;
    property Animation: TAnimation read m_animation write m_animation;
    property ViewGaming: boolean read m_bViewGaming write m_bViewGaming;
    property PositionColor: TFigureColor read FGetPositionColor; // Whos move it is in the current position
    property MoveNotationFormat: TMoveNotationFormat
      read FGetMoveNotationFormat write FSetMoveNotationFormat;
    property MovesOffset: integer read FGetMovesOffset;
    property FENFormat: boolean read FGetFENFormat write FSetFENFormat;
    property EditPiece: TFigure read m_EditPiece write m_EditPiece;
  end;


  TChessBoardLayerBase = class
  private
    m_ChessBoard: TChessBoard;
    function FGetSquareSize: integer;
    function FGetCanvas: TCanvas;
    function FGetPosition: PChessPosition;
    function FGetPositionsList: TList;
  protected
    procedure RDraw; virtual; abstract;
    function RGetColorStarts: TFigureColor;

    procedure RDoUpdate;

    procedure ROnAfterMoveDone; virtual;
    procedure ROnAfterSetPosition; virtual;
    procedure ROnAfterModeSet(const OldValue, NewValue: TMode); virtual;
    procedure ROnResetMoveList; virtual;

    property ChessBoard: TChessBoard read m_ChessBoard write m_ChessBoard;
    property SquareSize: integer read FGetSquareSize;
    property Canvas: TCanvas read FGetCanvas;
    property Position: PChessPosition read FGetPosition;
    property PositionsList: TList read FGetPositionsList;
  end;

implementation

{$R *.dfm}

uses
  Math, SysUtils, Windows,
  //
  ChessBoardHeaderUnit;

const
  HILIGHT_WIDTH = 1;
  HILIGHT_COLOR: TColor = clRed;
  HILIGHT_LAST_MOVE_WIDTH = 1;
  HILIGHT_LAST_MOVE_COLOR: TColor = clBlue;
  ANIMATION_SLOW = 30; // Time of animation in frames >= 1
  ANIMATION_QUICK = 9;
  CHB_WIDTH = 4;

////////////////////////////////////////////////////////////////////////////////
// TChessBoard

constructor TChessBoard.Create(Owner: TComponent; AHandler: TChessBoardHandler = nil);
begin
  FHandler := AHandler;
  inherited Create(Owner);
end;


procedure TChessBoard.AnimateTimerTimer(Sender: TObject);
begin
  FDoAnimationStep;
  if (m_iAnimStep >= m_iAnimStepsCount) then
    FEndAnimation;
end;


procedure TChessBoard.FDoAnimationStep;
var
  iX, iY: integer;
  rect: TRect;
begin
  if (m_iAnimStep < m_iAnimStepsCount) then
  begin
    inc(m_iAnimStep);

    iX := round(x0 + anim_dx * m_iAnimStep);
    iY := round(y0 + anim_dy * m_iAnimStep);
    dx := iX - x0 - Round(anim_dx * m_iPrevAnimStep);
    dy := iY - y0 - Round(anim_dy * m_iPrevAnimStep);

    // Восстановить фрагмент на m_bmHiddenBoard
    m_bmHiddenBoard.Canvas.Draw(iX - dx, iY - dy, m_bmBuf);
    // Копировать новый фрагмент в буфер
    m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize),
      m_bmHiddenBoard.Canvas, Bounds(iX, iY, m_iSquareSize, m_iSquareSize));
    // Нарисовать перетаскиваемую фигуру в новой позиции
    m_bmHiddenBoard.Canvas.Draw(iX, iY, m_bmFigure[m_fig]);
    // Перенести новый фрагмент на экран
    rect := Bounds(Min(iX - dx, iX), Min(iY - dy, iY),
      abs(dx) + m_iSquareSize, abs(dy) + m_iSquareSize);
    PBoxBoard.Canvas.CopyRect(rect, m_bmHiddenBoard.Canvas, rect);
  end;

  m_iPrevAnimStep := m_iAnimStep;
  
end;


procedure TChessBoard.FEndAnimation;
begin
  AnimateTimer.Enabled := FALSE;

  m_iAnimStep := m_iAnimStepsCount;

  FDrawBoard;
  HilightLastMove;
  Evaluate;
end;


procedure TChessBoard.FDrawBoard;
var
  i: integer;
begin
  if (csDestroying in ComponentState) then
    exit;

  if (m_iUpdateCounter > 0) then
    exit;

  FDrawHiddenBoard;

  for i := 0 to m_lstLayers.Count - 1 do
    TChessBoardLayerBase(m_lstLayers[i]).RDraw;

  PBoxBoardPaint(nil);
end;


procedure TChessBoard.HilightLastMove;
var
  i, j, l,
  _i0, _j0, x, y: integer;
begin
  if (not (m_Mode in [mGame, mAnalyse])) then
    exit;
    
  // Output the last move done
  if (last_hilight  and (lastMove.i0 <> 0)) then
  begin
    if (_flipped) then
    begin
      _i0 := 9 - lastMove.i0;
      _j0 := lastMove.j0;
      i := 9 - lastMove.i;
      j := lastMove.j;
    end
    else
    begin
      _i0 := lastMove.i0;
      _j0 := 9 - lastMove.j0;
      i := lastMove.i;
      j := 9 - lastMove.j;
    end;

    x := m_iSquareSize * (_i0 - 1) + CHB_X;
    y := m_iSquareSize * (_j0 - 1) + CHB_Y;
    m_bmHiddenBoard.Canvas.Pen.Color := HILIGHT_LAST_MOVE_COLOR;
    m_bmHiddenBoard.Canvas.Pen.Width := HILIGHT_LAST_MOVE_WIDTH;

    for l := 1 to 2 do
      with m_bmHiddenBoard.Canvas do
      begin
        MoveTo(x, y);
        LineTo(x + m_iSquareSize - 1, y);
        LineTo(x + m_iSquareSize - 1, y + m_iSquareSize - 1);
        LineTo(x, y + m_iSquareSize - 1);
        LineTo(x, y);

        x := m_iSquareSize * (i - 1) + CHB_X;
        y := m_iSquareSize * (j - 1) + CHB_Y;
      end;
    PBoxBoardPaint(nil);
  end;
end;


procedure TChessBoard.FDrawHiddenBoard;
var
  i, j: integer;
  x, y: integer;
begin
  if (not Assigned(m_bmHiddenBoard)) then
    exit;

  // Copy empty board to the hidden one
  with m_bmHiddenBoard do
  begin
    Canvas.CopyRect(Bounds(0,0, Width,Height), m_bmChessBoard.Canvas, Bounds(0,0, Width,Height));
  end;

  // Draw coordinates
  if (coord_show) then
    with m_bmHiddenBoard, m_bmHiddenBoard.Canvas do
    begin
      x:= CHB_X + m_iSquareSize div 2;
      y:= (m_bmHiddenBoard.Height + CHB_Y + 8 * m_iSquareSize + CHB_WIDTH) div 2;
      if _flipped then j := ord('h')
        else j:= ord('a');
      for i:= 1 to 8 do // буквы
        begin
          TextOut(x - TextWidth(chr(j)) div 2,
                  y + 1 - TextHeight(chr(j)) div 2 , chr(j));
          x := x + m_iSquareSize;
          if _flipped then dec(j)
            else inc(j);
        end;
      x:= (CHB_X - CHB_WIDTH) div 2;
      y:= CHB_Y + m_iSquareSize div 2;
      if _flipped then j:= ord('1')
        else j := ord('8');
      for i := 1 to 8 do // цифры
        begin
          TextOut(x - TextWidth(chr(j)) div 2,
                  y - TextHeight(chr(j)) div 2, chr(j));
          y:= y + m_iSquareSize;
          if _flipped then inc(j)
            else dec(j);
        end;
  end;

  // Draw pieces
  for i := 1 to 8 do
    for j := 1 to 8 do
      begin
        if ((Position.board[i,j] = ES)) then
          continue; // There's nothing to draw
        if not _flipped then // Загрузить нужную фигуру из ресурса и нарисовать
          m_bmHiddenBoard.Canvas.Draw(CHB_X + m_iSquareSize * (i-1),
                                    CHB_Y + m_iSquareSize * (8-j),
                                    m_bmFigure[Position.board[i,j]])
        else // Black is below
          m_bmHiddenBoard.Canvas.Draw(CHB_X + m_iSquareSize * (8-i),
                                    CHB_Y + m_iSquareSize * (j-1),
                                    m_bmFigure[Position.board[i,j]]);
      end;
end;


function TChessBoard.FGetHiddenBoardCanvas: TCanvas;
begin
  if (Assigned(m_bmHiddenBoard)) then
    Result := m_bmHiddenBoard.Canvas
  else
    Result := nil;
end;


procedure TChessBoard.Evaluate;
begin
  case m_ChessRulesEngine.GetEvaluation of
    evMate:
      FDoHandler(cbeMate, self);
    evStaleMate:
      FDoHandler(cbeStaleMate, self);
  end;
end;


procedure TChessBoard.PBoxBoardPaint(Sender: TObject);
begin
  PBoxBoard.Canvas.Draw(0, 0, m_bmHiddenBoard); // Draw hidden board on the form
//  PBoxBoard.Canvas.StretchDraw(Bounds(0, 0, PBoxBoard.Width, PBoxBoard.Height), m_bmHiddenBoard);
end;


function TChessBoard.FGetLastMove: PMoveAbs;
begin
  Result := m_ChessRulesEngine.lastMove;
end;


function TChessBoard.FGetPosition: PChessPosition;
begin
  Result := m_ChessRulesEngine.Position;
end;


function TChessBoard.AskPromotionFigure(FigureColor: TFigureColor): TFigureName;
var
  frmOwner: TForm;
begin
  if (Owner is TForm) then
    frmOwner := TForm(Owner)
  else
    frmOwner := self;

  if (Showing) then
  begin
    m_PromotionForm := TPromotionForm.Create(frmOwner, m_BitmapRes);
    try
      Result := m_PromotionForm.ShowPromotion(FigureColor);
    finally
      FreeAndNil(m_PromotionForm);
    end;
  end
  else
    Result := Q;
end;


procedure TChessBoard.FSetPlayerColor(const Value: TFigureColor);
begin
  FCancelAnimationDragging;
  m_PlayerColor := Value;
  if (m_PlayerColor = fcWhite) then
    FSetFlipped(FALSE)
  else // fcBlack
    FSetFlipped(TRUE);
end;


procedure TChessBoard.FCancelAnimationDragging;
begin
  // Cancel animation and dragging
  if (AnimateTimer.Enabled) then
  begin
    AnimateTimer.Enabled := FALSE;
    // iAnimStep := iAnimStepsCount;
    // AnimateTimerTimer(nil);
  end;
  
  if (PBoxBoard.Dragging) then
  begin
    m_bDraggedMoved := FALSE;
    PBoxBoard.EndDrag(FALSE);
  end;
end;


procedure TChessBoard.FSetFlipped(Value: boolean);
begin
  // TODO: ???
  _flipped := Value;
  FDrawBoard;
end;


procedure TChessBoard.FSetMode(const Value: TMode);
var
  OldMode: TMode;
  i: integer;
begin
  if (m_Mode = Value) then
    exit;

  OldMode := m_Mode;
  m_Mode := Value;

  if ((m_Mode in [mView, mEdit]) and (Assigned(m_PromotionForm))) then
    m_PromotionForm.Close;

  for i := 0 to m_lstLayers.Count - 1 do
    TChessBoardLayerBase(m_lstLayers[i]).ROnAfterModeSet(OldMode, m_Mode);

  FDrawBoard;
  HilightLastMove;
end;


procedure TChessBoard.FSetCoordinatesShown(Value: boolean);
begin
  coord_show := Value;
  FDrawBoard;
  HilightLastMove;
end;


procedure TChessBoard.FSetLastMoveHilighted(Value: boolean);
begin
  last_hilight := Value;
  FDrawBoard;
  HilightLastMove;
end;


function TChessBoard.DoMove(const strMove: string): boolean;
begin
  Result := FALSE;

  if (m_Mode = mEdit) then
    exit;

  // Animation canceling
  if (AnimateTimer.Enabled) then
    FEndAnimation;

  Result := m_ChessRulesEngine.DoMove(strMove);

  if (Result) then
  begin
    FOnAfterMoveDone;
    FAnimate(lastMove.i, lastMove.j);
  end;
end;


procedure TChessBoard.FOnAfterMoveDone;
var
  _fig: TFigure;
  strLastMove: string;
  i: integer;
begin
  m_i0 := lastMove.i0;
  m_j0 := lastMove.j0;

  _fig := Position.board[lastMove.i, lastMove.j];
  if (lastMove.prom_fig in [Q, R, B, N]) then
  begin
    if (_fig < ES) then
      m_fig := WP
    else
      m_fig := BP;
  end
  else
    m_fig := _fig;

  strLastMove := m_ChessRulesEngine.LastMoveStr;
  FDoHandler(cbeMoved, @strLastMove, self);

  if (m_Mode = mAnalyse) then
    m_PlayerColor := PositionColor;

  for i := 0 to m_lstLayers.Count - 1 do
    TChessBoardLayerBase(m_lstLayers[i]).ROnAfterMoveDone;
end;


procedure TChessBoard.FAnimate(const i, j: integer);
var
  x, y: integer;
begin
  if (not Showing) then
    exit;

  if ((m_i0 = 0) or (m_j0 = 0)) then
    exit;

  if (AnimateTimer.Enabled) then
  begin
    m_iAnimStep := m_iAnimStepsCount;
    exit;
  end;

  case animation of
    aNo:
      m_iAnimStepsCount := 1;
    aSlow:
      m_iAnimStepsCount := ANIMATION_SLOW;
    aQuick:
      m_iAnimStepsCount := ANIMATION_QUICK;
  end;

  if (_flipped) then
  begin
    x0 := (8 - m_i0) * m_iSquareSize + CHB_X;
    y0 := (m_j0 - 1) * m_iSquareSize + CHB_Y;
    x := (8 - i) * m_iSquareSize + CHB_X;
    y := (j - 1) * m_iSquareSize + CHB_Y;
  end
  else
  begin
    x0 := (m_i0 - 1) * m_iSquareSize + CHB_X;
    y0 := (8 - m_j0) * m_iSquareSize + CHB_Y;
    x := (i - 1) * m_iSquareSize + CHB_X;
    y := (8 - j) * m_iSquareSize + CHB_Y;
  end;

  anim_dx := (x - x0) / m_iAnimStepsCount;
  anim_dy := (y - y0) / m_iAnimStepsCount;

  m_iAnimStep := 0;
  m_iPrevAnimStep := m_iAnimStep;  

  // Copy image of the empty square to m_bmBuf
  m_bmBuf.Width := m_iSquareSize;
  m_bmBuf.Height := m_iSquareSize;
  if (((m_i0 + m_j0) and 1) <> 0) then
    m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize),
      m_bmFigure[ES].Canvas, Bounds(0, 0, m_iSquareSize, m_iSquareSize))
  else
    m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize),
      m_bmFigure[ES].Canvas, Bounds(m_iSquareSize, 0, m_iSquareSize, m_iSquareSize));

  AnimateTimer.Enabled := TRUE;
end;


procedure TChessBoard.ResetMoveList;
var
  i: integer;
begin
  m_ChessRulesEngine.ResetMoveList;

  for i := 0 to m_lstLayers.Count - 1 do
    TChessBoardLayerBase(m_lstLayers[i]).ROnResetMoveList;
end;


function TChessBoard.SetPosition(const strPosition: string): boolean;
begin
  Result := m_ChessRulesEngine.SetPosition(strPosition);
  if (Result) then
  begin
    FCancelAnimationDragging;
    FOnAfterSetPosition;
    FDrawBoard;
  end;
end;


function TChessBoard.GetPosition: string;
begin
  Result := m_ChessRulesEngine.GetPosition;
end;


procedure TChessBoard.FOnAfterSetPosition;
var
  strPosition: string;
  i: integer;
begin
  case m_Mode of
    mAnalyse:
      m_PlayerColor := PositionColor;

    mEdit:
      ResetMoveList;
  end;

  m_i0 := 0;
  m_j0 := 0;

  strPosition := GetPosition;
  FDoHandler(cbePosSet, @strPosition, self);

  for i := 0 to m_lstLayers.Count - 1 do
    TChessBoardLayerBase(m_lstLayers[i]).ROnAfterSetPosition;
end;


procedure TChessBoard.FormCreate(Sender: TObject);
begin
  // m_iDeltaWidthHeight := Width - Height;

  m_BitmapRes := TBitmapRes.Create(Size(PBoxBoard.Width, PBoxBoard.Height));

  coord_show:= TRUE;
  last_hilight:= FALSE;
  m_animation := aQuick;

  m_ChessRulesEngine := TChessRulesEngine.Create(self);
  m_lstLayers := TList.Create;
end;


procedure TChessBoard.FormDestroy(Sender: TObject);
var
  _fig: TFigure;
  i: integer;
begin
  for i := m_lstLayers.Count - 1 downto 0 do
    RemoveLayer(m_lstLayers[i]);
  m_lstLayers.Free;

  m_ChessRulesEngine.Free;

  m_bmHiddenBoard.Free;
  m_bmBuf.Free;

  for _fig := Low(TFigure) to High(TFigure) do
    m_bmFigure[_fig].Free;
  m_bmChessBoard.Free;

  m_BitmapRes.Free;
end;


procedure TChessBoard.PBoxBoardDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  i, j: Integer;
begin
  FWhatSquare(Point(X, Y), i, j);
  case m_Mode of
    mGame, mAnalyse:
    begin
      if (FDoMove(i, j)) then
        m_bDraggedMoved := TRUE;
    end;

    mEdit:
      m_bDraggedMoved := TRUE;
  end;
end;


procedure TChessBoard.FWhatSquare(const P: TPoint;
  var i: Integer; var j: Integer);
begin
  with P do
  begin
    i := (X - CHB_X + m_iSquareSize) div m_iSquareSize;
    j := 8 - (Y - CHB_Y) div m_iSquareSize;
    if (_flipped) then
    begin
      i := 9 - i;
      j := 9 - j;
    end;
  end;
end;


function TChessBoard.FDoMove(i, j: integer; prom_fig: TFigureName = K): boolean;
begin
  Result := m_ChessRulesEngine.DoMove(m_i0, m_j0, i, j, prom_fig);
  if (Result) then
    FOnAfterMoveDone;
end;


procedure TChessBoard.PBoxBoardDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  rect: TRect;
  i, j: integer;
begin
  case State of
    dsDragEnter:
      m_bHilighted := FALSE;

    dsDragMove:
      begin
        // Repaint a fragment on m_bmHiddenBoard
        m_bmHiddenBoard.Canvas.Draw(x0 - dx, y0 - dy, m_bmBuf);
        // Copy new fragment to the buffer
        m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize),
          m_bmHiddenBoard.Canvas, Bounds(X - dx, Y - dy, m_iSquareSize, m_iSquareSize));
        // Draw the dragging piece in a new position
        m_bmHiddenBoard.Canvas.Draw(X - dx, Y - dy, m_bmFigure[m_fig]);
        // Copy the new fragment to the screen
        rect:= Bounds(Min(x0,X) - dx, Min(y0, Y) - dy,
          abs(X - x0) + m_iSquareSize, abs(Y - y0) + m_iSquareSize);
        PBoxBoard.Canvas.CopyRect(rect, m_bmHiddenBoard.Canvas, rect);

        x0 := X;
        y0 := Y;

        FWhatSquare(Point(X,Y), i, j);

        Accept := ((i in [1..8]) and (j in [1..8]));
      end;
  end;
end;


procedure TChessBoard.PBoxBoardEndDrag(Sender, Target: TObject; X, Y: Integer);
var
  i, j: integer;
  bRes: boolean;
begin
  case m_Mode of
    mGame, mAnalyse:
    begin
      if (m_bHilighted) then
      begin
        with m_bmHiddenBoard.Canvas do
        begin
          Pen.Color:= HILIGHT_COLOR;
          Pen.Width := HILIGHT_WIDTH;
          x0:= x0 - dx;
          y0:= y0 - dy;
          MoveTo(x0,y0);
          LineTo(x0 + m_iSquareSize - 1, y0);
          LineTo(x0 + m_iSquareSize - 1, y0 + m_iSquareSize - 1);
          LineTo(x0, y0 + m_iSquareSize - 1);
          LineTo(x0, y0);

          PBoxBoardPaint(nil);
        end;
      end
      else
      begin
        if (AnimateTimer.Enabled) then
          AnimateTimer.Enabled := FALSE;
        FDrawBoard;
        if (m_bDraggedMoved) then
        begin
          HilightLastMove;
          Evaluate;
          m_bDraggedMoved := FALSE;
        end;
      end;
    end;

    mEdit:
    begin
      if (m_bDraggedMoved) then
      begin
        FWhatSquare(Point(X, Y), i, j);
        bRes := (((i <> m_i0) or (j <> m_j0)) and  Position.SetPiece(i, j, m_fig));
      end
      else
        bRes := TRUE;

      if (bRes) then
      begin
        Position.SetPiece(m_i0, m_j0, ES);
        FOnAfterSetPosition;
      end;

      FDrawBoard;      
    end;
  end; // case
end;


procedure TChessBoard.PBoxBoardMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i, j: Integer;
  f: TFigure;
begin
  if (Button <> mbLeft) then
    exit;

  FWhatSquare(Point(X, Y), i, j);
  if (not ((i in [1..8]) and (j in [1..8]))) then
    exit;

  m_bDraggedMoved := FALSE;

  f := Position.board[i,j];

  case m_Mode of
    mGame, mAnalyse:
    begin
      if (m_bViewGaming) then
        exit;
      if ((Position.color <> m_PlayerColor) or
          (((Position.color <> fcWhite) or (f >= ES)) and
           ((Position.color <> fcBlack) or (f <= ES)))) then
        exit;

      if ((i = m_i0) and (j = m_j0)) then
        m_bHilighted := (m_bHilighted xor TRUE)
      else
        m_bHilighted := TRUE;
    end;

    mEdit:
    begin
      if (f = ES) then
        exit;    
    end;

  else
    exit;
  end;

  if (m_iAnimStep < m_iAnimStepsCount) then
    FEndAnimation;

  m_fig := f;
  m_i0 := i;
  m_j0 := j;

  dx := (X - CHB_X) mod m_iSquareSize;
  dy := (Y - CHB_Y) mod m_iSquareSize;
  x0 := X;
  y0 := Y;

  m_bDraggedMoved := TRUE;
  PBoxBoard.BeginDrag(FALSE);
end;


procedure TChessBoard.PBoxBoardMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  f: TFigure;
  i,j: Integer;
begin
  FWhatSquare(Point(X,Y), i,j);
  if (not ((i in [1..8]) and (j in [1..8]))) then
  begin
    PBoxBoard.Cursor:= crDefault;
    exit;
  end;

  f := Position.board[i,j];

  case m_Mode of
    mGame, mAnalyse:
    begin
      if (m_bViewGaming) then
        exit;

      if (m_PlayerColor = Position.color) and
         (((Position.color = fcWhite) and (f < ES)) or
          ((Position.color = fcBlack) and (f > ES))) then
        PBoxBoard.Cursor:= crHandPoint
      else
        PBoxBoard.Cursor:= crDefault;
    end;

    mEdit:
    begin
      if (f <> ES) then
        PBoxBoard.Cursor:= crHandPoint
      else
        PBoxBoard.Cursor:= crDefault;
    end;

  else
    PBoxBoard.Cursor := crDefault;
  end;
end;


function TChessBoard.FGetPositionsList: TList;
begin
  Result := m_ChessRulesEngine.PositionsList;
end;


function TChessBoard.FGetColorStarts: TFigureColor;
begin
  Result := m_ChessRulesEngine.GetColorStarts;
end;


procedure TChessBoard.PBoxBoardMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i, j: integer;
begin
  case Button of
    mbLeft:
    begin
      case m_Mode of
        mGame, mAnalyse:
        begin
          if (not m_bHilighted) then
            exit;
          FWhatSquare(Point(X, Y), i, j);
          if (m_bDraggedMoved) then
            FDrawBoard
          else
          begin
            m_bHilighted := FALSE;
            if (FDoMove(i, j)) then
              FAnimate(i, j)
            else
              FDrawBoard;
          end;
        end;

        mEdit:
        begin
          if (m_bDraggedMoved) then
            exit;
          // Assert(empty field)
          FWhatSquare(Point(X, Y), i, j);
          if (Position.SetPiece(i, j, m_EditPiece)) then
          begin
            FOnAfterSetPosition;
            FDrawBoard;
          end;
        end;

      end; // case
    end;

    mbRight:
    begin
      FDoHandler(cbeMenu, self);
    end;

  end;
end;


procedure TChessBoard.PBoxBoardStartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  // Copy image of an empty square to m_bmBuf
  m_bmBuf.Width := m_iSquareSize;
  m_bmBuf.Height:= m_iSquareSize;
  if (((m_i0 + m_j0) and 1) <> 0) then
      m_bmBuf.Canvas.CopyRect(Bounds(0,0, m_iSquareSize, m_iSquareSize),
        m_bmFigure[ES].Canvas, Bounds(0,0, m_iSquareSize, m_iSquareSize))
  else
    m_bmBuf.Canvas.CopyRect(Bounds(0,0, m_iSquareSize, m_iSquareSize),
      m_bmFigure[ES].Canvas, Bounds(m_iSquareSize,0, m_iSquareSize, m_iSquareSize));

  m_bDraggedMoved := FALSE;
end;


procedure TChessBoard.InitPosition;
begin
  m_ChessRulesEngine.InitNewGame;

  FCancelAnimationDragging;
  FOnAfterSetPosition;

  FDrawBoard;
end;


procedure TChessBoard.PPRandom;
begin
  m_ChessRulesEngine.InitNewPPRandomGame;

  FCancelAnimationDragging;
  FOnAfterSetPosition;
  
  FDrawBoard;
end;


procedure TChessBoard.TakeBack;
begin
  if (m_Mode = mEdit) then
    exit;

  if (not m_ChessRulesEngine.TakeBack) then
    exit;

  FOnAfterSetPosition;
  // TODO: animation
  FDrawBoard;
end;


function TChessBoard.NMoveDone: integer;
begin
  Result := m_ChessRulesEngine.NMovesDone;
end;


function TChessBoard.NPlysDone: integer;
begin
  Result := m_ChessRulesEngine.NPlysDone;
end;


function TChessBoard.FGetMovesOffset: integer;
begin
  Result := m_ChessRulesEngine.MovesOffset;
end;


function TChessBoard.FGetPositionColor: TFigureColor;
begin
  Result := Position.color;
end;


procedure TChessBoard.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
var
  NewBoardSize: TSize;
begin
  if (not m_bDeltaWidthHeightFlag) then
  begin
    m_iDeltaWidthHeight := Width - Height;
    m_bDeltaWidthHeightFlag := TRUE;
  end;

  Resize := (m_ResizingType <> rtNo);
  if (not Resize) then
    exit;

  if (m_ResizingType = rtVert) then
    NewWidth := NewHeight + m_iDeltaWidthHeight
  else // rtHoriz
    NewHeight := NewWidth - m_iDeltaWidthHeight;

  NewBoardSize := m_BitmapRes.GetOptimalBoardSize(
    Size(PBoxBoard.Width + (NewWidth - Width), PBoxBoard.Height + (NewHeight - Height)));

  Resize := (NewBoardSize.cx > 0) and (NewBoardSize.cy > 0) and
    ((NewBoardSize.cx <> PBoxBoard.Width) or (NewBoardSize.cy <> PBoxBoard.Height));
  if (Resize) then
  begin
    NewWidth := Width + (NewBoardSize.cx - PBoxBoard.Width);
    NewHeight := Height + (NewBoardSize.cy - PBoxBoard.Height);
  end;
end;


procedure TChessBoard.FormResize(Sender: TObject);
var
  _fig: TFigure;
begin
  FreeAndNil(m_bmChessBoard);
  m_BitmapRes.CreateBoardBitmap(Size(PBoxBoard.Width, PBoxBoard.Height), self.Color,
    m_bmChessBoard);
  m_iSquareSize := m_BitmapRes.SquareSize;

  for _fig := Low(TFigure) to High(TFigure) do
  begin
    FreeAndNil(m_bmFigure[_fig]);
    m_BitmapRes.CreateFigureBitmap(_fig, m_bmFigure[_fig]);
  end;

  // Graphics initialization
  if (not Assigned(m_bmHiddenBoard)) then
  begin
    m_bmHiddenBoard := Graphics.TBitmap.Create;
    m_bmHiddenBoard.Palette := m_bmChessBoard.Palette;
    m_bmHiddenBoard.Canvas.Font := PBoxBoard.Font; // Характеристики шрифта координат задаются в инспекторе
    m_bmHiddenBoard.Canvas.Brush.Style := bsClear;
  end;
  m_bmHiddenBoard.Width := m_bmChessBoard.Width;
  m_bmHiddenBoard.Height := m_bmChessBoard.Height;

  if (not Assigned(m_bmBuf)) then
  begin
    m_bmBuf := Graphics.TBitmap.Create;
    m_bmBuf.Palette:= m_bmChessBoard.Palette;
  end;

  FDrawBoard;
end;


procedure TChessBoard.WMSizing(var Msg: TMessage);
begin
  case Msg.WParam of
    WMSZ_RIGHT, WMSZ_LEFT, WMSZ_BOTTOMRIGHT, WMSZ_TOPLEFT:
      m_ResizingType := rtHoriz;
    WMSZ_BOTTOM, WMSZ_TOP:
      m_ResizingType := rtVert;
  else
    begin
      m_ResizingType := rtNo;
      PRect(Msg.LParam).Left := Left;
      PRect(Msg.LParam).Top := Top;
    end;
  end; // case
end;


procedure TChessBoard.FDoHandler(e: TChessBoardEvent; d1: pointer = nil; d2: pointer = nil);
begin
  if (Assigned(FHandler)) then
    FHandler(e, d1, d2);
end;


function TChessBoard.FGetMoveNotationFormat: TMoveNotationFormat;
begin
  Result := m_ChessRulesEngine.MoveNotationFormat;
end;


procedure TChessBoard.FSetMoveNotationFormat(Value: TMoveNotationFormat);
begin
  m_ChessRulesEngine.MoveNotationFormat := Value;
end;


function TChessBoard.FGetFENFormat: boolean;
begin
  Result := m_ChessRulesEngine.FENFormat;
end;


procedure TChessBoard.FSetFENFormat(bValue: boolean);
begin
  m_ChessRulesEngine.FENFormat := bValue;
end;


procedure TChessBoard.BeginUpdate;
begin
  inc(m_iUpdateCounter);
end;


procedure TChessBoard.EndUpdate;
begin
  if (m_iUpdateCounter > 0) then
  begin
    dec(m_iUpdateCounter);
    if (m_iUpdateCounter = 0) then
      FDrawBoard;
  end;
end;


procedure TChessBoard.FOnDrawLayerUpdate(const ADrawLayer: TChessBoardLayerBase);
begin
  if (not AnimateTimer.Enabled) then
    FDrawBoard;
end;


procedure TChessBoard.AddLayer(const ALayer: TChessBoardLayerBase);
begin
  if (m_lstLayers.IndexOf(ALayer) >= 0) then
    exit;

  ALayer.ChessBoard := self;
  m_lstLayers.Add(ALayer);

  FOnDrawLayerUpdate(ALayer);
end;


procedure TChessBoard.RemoveLayer(const ALayer: TChessBoardLayerBase);
begin
  if (m_lstLayers.Remove(ALayer) >= 0) then
  begin
    ALayer.ChessBoard := nil;

    FOnDrawLayerUpdate(ALayer);
  end;
end;


function TChessBoard.IsMoveAnimating: boolean;
begin
  Result := AnimateTimer.Enabled; 
end;

////////////////////////////////////////////////////////////////////////////////
// TChessBoardDrawBase

procedure TChessBoardLayerBase.RDoUpdate;
begin
  if (Assigned(m_ChessBoard)) then
    m_ChessBoard.FOnDrawLayerUpdate(self);
end;


function TChessBoardLayerBase.FGetSquareSize: integer;
begin
  if (Assigned(m_ChessBoard)) then
    Result := m_ChessBoard.SquareSize
  else
    Result := 0;  
end;


function TChessBoardLayerBase.FGetCanvas: TCanvas;
begin
  if (Assigned(m_ChessBoard)) then
    Result := m_ChessBoard.FGetHiddenBoardCanvas
  else
    Result := nil;
end;


function TChessBoardLayerBase.FGetPosition: PChessPosition;
begin
  if (Assigned(m_ChessBoard)) then
    Result := m_ChessBoard.Position
  else
    Result := nil;
end;


function TChessBoardLayerBase.RGetColorStarts: TFigureColor;
begin
  if (Assigned(m_ChessBoard)) then
    Result := m_ChessBoard.FGetColorStarts
  else
    Result := fcWhite;
end;


function TChessBoardLayerBase.FGetPositionsList: TList;
begin
  if (Assigned(m_ChessBoard)) then
    Result := m_ChessBoard.PositionsList
  else
    Result := nil;
end;


procedure TChessBoardLayerBase.ROnAfterMoveDone;
begin
end;


procedure TChessBoardLayerBase.ROnAfterSetPosition;
begin
end;


procedure TChessBoardLayerBase.ROnAfterModeSet(const OldValue, NewValue: TMode);
begin
end;


procedure TChessBoardLayerBase.ROnResetMoveList;
begin
end;

end.