diff options
Diffstat (limited to 'plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas')
| -rw-r--r-- | plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas | 1381 |
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.
|