Plugin is not adapted until someone can compile it and tell others how to do the same

git-svn-id: http://svn.miranda-ng.org/main/trunk@1809 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c

1 files changed, 1381 insertions, 0 deletions

diff --git a/plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas b/plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas
new file mode 100644
index 0000000000..8a7042f292
--- /dev/null
+++ b/plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas
@@ -0,0 +1,1381 @@
+////////////////////////////////////////////////////////////////////////////////

+// 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.