diff options
Diffstat (limited to 'plugins/Chess4Net/ChessBoardUnit.pas')
| -rw-r--r-- | plugins/Chess4Net/ChessBoardUnit.pas | 1788 |
1 files changed, 889 insertions, 899 deletions
diff --git a/plugins/Chess4Net/ChessBoardUnit.pas b/plugins/Chess4Net/ChessBoardUnit.pas index 6b655058ad..8a7042f292 100644 --- a/plugins/Chess4Net/ChessBoardUnit.pas +++ b/plugins/Chess4Net/ChessBoardUnit.pas @@ -1,410 +1,396 @@ +////////////////////////////////////////////////////////////////////////////////
+// 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
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, TntForms,
- Dialogs, StdCtrls, TntStdCtrls, ExtCtrls, Buttons,
- // Chess4net
- ChessBoardHeaderUnit, ChessRulesEngine, BitmapResUnit, LocalizerUnit;
+ Forms, ExtCtrls, Classes, Controls, Graphics, Types, Messages,
+ //
+ ChessRulesEngine, BitmapResUnit, PromotionUnit;
type
- TMode = (mView, mGame); // состояние доски
- TChessBoardEvent =
- (cbeMoved, cbeMate, cbeStaleMate, cbeInsuffMaterial, cbeKeyPressed,
- cbeClockSwitched, cbeTimeOut, cbeExit, cbeMenu, cbeActivate, cbeFormMoving,
- cbeRefreshAll); // возможно добавление новых событий
- // cbeRefreshAll сигнализирует, что были изменены глобальные опции.
+ 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;
- TAnimation = (aNo, aSlow, aQuick);
-{$IFDEF THREADED_CHESSCLOCK}
- TChessBoard = class;
- TTimeLabelThread = class(TThread)
- private
- ChessBoard: TChessBoard;
- player_time: array[TFigureColor] of TDateTime;
- protected
- procedure Execute; override;
- public
- WhiteTime, BlackTime: string;
- constructor Create(ChessBoard: TChessBoard);
- end;
-{$ENDIF}
+ TChessBoardLayerBase = class;
- TChessBoard = class(TTntForm, ILocalizable, IChessRulesEngineable)
+ TChessBoard = class(TForm, IChessRulesEngineable)
PBoxBoard: TPaintBox;
- TimePanel: TPanel;
- WhiteLabel: TTntLabel;
- WhiteTimeLabel: TLabel;
- BlackLabel: TTntLabel;
- BlackTimeLabel: TLabel;
- GameTimer: TTimer;
AnimateTimer: TTimer;
- WhiteFlagButton: TSpeedButton;
- BlackFlagButton: TSpeedButton;
- WhitePanel: TPanel;
- BlackPanel: TPanel;
+
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 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);
- procedure AnimateTimerTimer(Sender: TObject);
- procedure GameTimerTimer(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure FormActivate(Sender: TObject);
- procedure FlagButtonClick(Sender: TObject);
- procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;
- var Resize: Boolean);
- procedure FormResize(Sender: TObject);
- procedure TimePanelResize(Sender: TObject);
+ procedure PBoxBoardStartDrag(Sender: TObject; var DragObject: TDragObject);
private
m_ChessRulesEngine: TChessRulesEngine;
+ m_BitmapRes: TBitmapRes; // Manager for bitmaps
- m_i0, m_j0: integer;
- m_fig: TFigure;
+ FHandler: TChessBoardHandler;
- mode_var: TMode;
dx, dy: integer; // Расстояние от курсора до верхнего левого угла
x0, y0: integer; // Предыдущие координаты курсора
_flipped: boolean; // Доска перевёрнута или нет
- hilighted: 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;
- Handler: TChessBoardHandler;
-
- m_animation: TAnimation; // скорость анимации
-
- anim_dx, anim_dy: real; // переменные для анимации перемещения фигуры
- anim_step, anim_step_num: integer; // количество шагов в анимации
- player_color: TFigureColor; // цвет игрока клиента
- dragged_moved: boolean; // индикатор включения перетаскивания
- last_hilight: boolean; // флаг подсветки последнего хода
- m_bFlash_move: boolean; // flag for flashing on icoming move
- coord_show: boolean; // флаг координат
+ m_iSquareSize: integer; // Size of one chess board field
- auto_flag: boolean; // индикатор автофлага
- player_time: array[TFigureColor] of TDateTime; // время белых и чёрных
- past_time: TDateTime; // время начала обдумывания хода
- unlimited_var: array[TFigureColor] of boolean; // партия без временного контроля
- clock_color: TFigureColor; // цвет анимируемой фигуры
+ m_animation: TAnimation; // Animation speed
+ m_iAnimStep, m_iPrevAnimStep, m_iAnimStepsCount: integer;
+ anim_dx, anim_dy: real; // Variables for animation of a dragged piece
- shuted: boolean; // индикатор внешнего закрытия окна
+ 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_BitmapRes: TBitmapRes; // Manager for bitmaps
- m_iTimePanelInitialWidth: integer;
- m_iWhitePanelInitialLeft, m_iBlackPanelInitialLeft: integer;
- m_iWhitePanelInitialWidth, m_iBlackPanelInitialWidth: integer;
- m_TimeFont: TFont;
+ m_bDeltaWidthHeightFlag: boolean;
- m_bViewGaming: boolean;
+ m_PromotionForm: TPromotionForm;
+
+ m_EditPiece: TFigure;
-{$IFDEF THREADED_CHESSCLOCK}
- TimeLabelThread: TTimeLabelThread; // нить используется для борьбы с лагом в Миранде
-{$ENDIF}
+ m_iUpdateCounter: integer;
+
+ m_lstLayers: TList;
procedure HilightLastMove;
- procedure WhatSquare(const P: TPoint; var i: Integer; var j: Integer);
- procedure Animate(const i, j: integer); // Анимирует перемещение фигуры с (i0,j0) до (i,j)
- procedure SetMode(const m: TMode);
- procedure ShowTime(const c: TFigureColor);
- procedure SetPlayerColor(const color: TFigureColor);
- procedure SetTime(color: TFigureColor; const tm: TDateTime);
- function GetTime(color: TFigureColor): TDateTime;
- procedure SetUnlimited(color: TFigureColor; const unl: boolean);
- function GetUnlimited(color: TFigureColor): boolean;
procedure Evaluate;
- procedure SetHilightLastMove(const yes: boolean);
- procedure SetCoordinates(const yes: boolean);
- procedure SetFlipped(const f: boolean); // Переварачивает позицию при отображении
- function GetStayOnTop: boolean;
- procedure SetStayOnTop(onTop: boolean);
- procedure FCancelAnimationDragging; // отмена анимации и перетаскивания для удаления грязи при прорисовки
- procedure SetAutoFlag(auto_flag: boolean);
- procedure FFlashWindow;
- // Localization
- procedure ILocalizable.Localize = FLocalize;
- procedure FLocalize;
-
- procedure WMMoving(var Msg: TWMMoving); message WM_MOVING;
- procedure WMSizing(var Msg: TMessage); message WM_SIZING;
- function FGetPositinoColor: TFigureColor;
+ function FGetLastMove: PMoveAbs;
+ property lastMove: PMoveAbs read FGetLastMove;
+
function FGetPosition: PChessPosition;
+ property Position: PChessPosition read FGetPosition;
+
function AskPromotionFigure(FigureColor: TFigureColor): TFigureName;
- function FGetLastMove: PMoveAbs;
+ 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 FOnAfterMoveDone;
+ procedure FDrawHiddenBoard;
+ function FGetHiddenBoardCanvas: TCanvas;
- property ChessRulesEngine: TChessRulesEngine read m_ChessRulesEngine;
- property Position: PChessPosition read FGetPosition;
+ procedure FDrawBoard;
+ procedure FOnDrawLayerUpdate(const ADrawLayer: TChessBoardLayerBase);
- property lastMove: PMoveAbs read FGetLastMove;
+ function FGetMovesOffset: integer;
+ function FGetColorStarts: TFigureColor;
- protected
- iSquareSize: integer; // Size of a chess board field
- bmHiddenBoard: TBitmap;
- procedure RDrawBoard;
+ procedure WMSizing(var Msg: TMessage); message WM_SIZING;
- procedure RDrawHiddenBoard; virtual;
- procedure ROnAfterSetPosition; virtual;
- function RDoMove(i, j: integer; prom_fig: TFigureName = K): boolean;
- procedure ROnAfterMoveDone; virtual;
+ procedure FDoHandler(e: TChessBoardEvent; d1: pointer = nil; d2: pointer = nil);
- property PositionsList: TList read FGetPositionsList;
+ property SquareSize: integer read m_iSquareSize;
+ property PositionsList: TList read FGetPositionsList;
public
- constructor Create(Owner: TComponent; h: TChessBoardHandler = nil); reintroduce;
+ constructor Create(Owner: TComponent; AHandler: TChessBoardHandler = nil); reintroduce;
- procedure TakeBack; // взятие хода обратно
- procedure SwitchClock(clock_color: TFigureColor);
+ function DoMove(const strMove: string): boolean;
+ procedure ResetMoveList;
+ function SetPosition(const strPosition: string): boolean;
+ function GetPosition: string;
procedure InitPosition;
procedure PPRandom;
- procedure StopClock;
+ procedure TakeBack;
+ function NMoveDone: integer;
+ function NPlysDone: integer;
- procedure ResetMoveList;
- function SetPosition(const posstr: string): boolean;
- function GetPosition: string;
- function NMoveDone: integer; // количество сделанных ходов
- function DoMove(move_str: string): boolean;
- procedure Shut;
-
- property Unlimited[color: TFigureColor]: boolean read GetUnlimited write SetUnlimited;
- property Time[color: TFigureColor]: TDateTime read GetTime write SetTime;
- property PlayerColor: TFigureColor read player_color write SetPlayerColor;
- property PositionColor: TFigureColor read FGetPositinoColor; // чей ход в текущей позиции
- property ClockColor: TFigureColor read clock_color;
- property Mode: TMode read mode_var write SetMode;
- property CoordinatesShown: boolean read coord_show write SetCoordinates;
-
- property flipped: boolean read _flipped write SetFlipped;
- property LastMoveHilighted: boolean read last_hilight write SetHilightLastMove;
- property FlashOnMove: boolean read m_bFlash_move write m_bFlash_move;
- property StayOnTop: boolean read GetStayOnTop write SetStayOnTop;
- property AutoFlag: boolean read auto_flag write SetAutoFlag;
- property animation: TAnimation read m_animation write m_animation;
+ 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;
-implementation
-{$J+}
+ 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
- StrUtils, Math, DateUtils,
- // Chess4Net
- PromotionUnit;
+ 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; // Время анимации хода в фреймах >= 1
+ ANIMATION_SLOW = 30; // Time of animation in frames >= 1
ANIMATION_QUICK = 9;
CHB_WIDTH = 4;
- TIME_COLOR = clBlack;
-// FULL_TIME_FORMAT = 'h:n:s"."z';
- HOUR_TIME_FORMAT = 'h:nn:ss';
- MIN_TIME_FORMAT = 'n:ss';
- ZEITNOT_BOARDER = 10; // сек - цетйтнотная граница
- ZEITNOT_COLOR = clMaroon;
- ZEITNOT_FORMAT = 's"."zzz';
-// CHEAT_TIME_CONST = 1.5; // > 1
- WHITE_LONG_LABEL: WideString = 'White ';
- WHITE_MEDIUM_LABEL: WideString = 'White ';
- WHITE_SHORT_LABEL: WideString = 'W ';
- BLACK_LONG_LABEL: WideString = 'Black ';
- BLACK_MEDIUM_LABEL: WideString = 'Black ';
- BLACK_SHORT_LABEL: WideString = 'B ';
////////////////////////////////////////////////////////////////////////////////
-// Globals
+// TChessBoard
-function TChessBoard.DoMove(move_str: string): boolean;
+constructor TChessBoard.Create(Owner: TComponent; AHandler: TChessBoardHandler = nil);
begin
- // Отмена анимации
- if (AnimateTimer.Enabled) then
- begin
- AnimateTimer.Enabled := FALSE;
- anim_step := anim_step_num;
- AnimateTimerTimer(nil);
- end;
+ FHandler := AHandler;
+ inherited Create(Owner);
+end;
- Result := ChessRulesEngine.DoMove(move_str);
- if (Result) then
- begin
- FOnAfterMoveDone;
- Animate(lastMove.i, lastMove.j);
- SwitchClock(PositionColor);
- if (m_bFlash_move and (mode_var = mGame)) then
- FFlashWindow;
- end;
+procedure TChessBoard.AnimateTimerTimer(Sender: TObject);
+begin
+ FDoAnimationStep;
+ if (m_iAnimStep >= m_iAnimStepsCount) then
+ FEndAnimation;
end;
-procedure TChessBoard.ShowTime(const c: TFigureColor);
+procedure TChessBoard.FDoAnimationStep;
var
- time_label: TLabel;
+ iX, iY: integer;
+ rect: TRect;
begin
- if c = fcWhite then time_label:= WhiteTimeLabel
- else time_label:= BlackTimeLabel;
-
- if unlimited_var[c] then
- begin
- time_label.Caption:= '';
- exit;
- end;
+ if (m_iAnimStep < m_iAnimStepsCount) then
+ begin
+ inc(m_iAnimStep);
- time_label.Font.Color:= TIME_COLOR;
+ 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);
- LongTimeFormat:= MIN_TIME_FORMAT;
- if player_time[c] >= EncodeTime(1, 0, 0, 0) then
- LongTimeFormat:= HOUR_TIME_FORMAT
- else
- if (player_time[c] < EncodeTime(0, 0, ZEITNOT_BOARDER, 0)) and
- (player_time[c] > 0) then
- begin
- LongTimeFormat:= ZEITNOT_FORMAT;
- time_label.Font.Color:= ZEITNOT_COLOR;
- end;
+ // Восстановить фрагмент на 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;
- time_label.Caption:= TimeToStr(player_time[c]);
+ m_iPrevAnimStep := m_iAnimStep;
+
end;
-
-procedure TChessBoard.SetFlipped(const f: boolean);
+procedure TChessBoard.FEndAnimation;
begin
- // TODO: ???
- _flipped:= f;
- RDrawBoard;
-end;
+ AnimateTimer.Enabled := FALSE;
+ m_iAnimStep := m_iAnimStepsCount;
-procedure TChessBoard.ResetMoveList;
-begin
- ChessRulesEngine.ResetMoveList;
+ FDrawBoard;
+ HilightLastMove;
+ Evaluate;
end;
-function TChessBoard.SetPosition(const posstr: string): boolean;
+procedure TChessBoard.FDrawBoard;
+var
+ i: integer;
begin
- Result := ChessRulesEngine.SetPosition(posstr);
- if (not Result) then
+ if (csDestroying in ComponentState) then
exit;
- FCancelAnimationDragging;
- ROnAfterSetPosition;
- clock_color := Position.color;
- RDrawBoard;
-end;
+ if (m_iUpdateCounter > 0) then
+ exit;
+ FDrawHiddenBoard;
-function TChessBoard.GetPosition: string;
-begin
- Result := ChessRulesEngine.GetPosition;
+ for i := 0 to m_lstLayers.Count - 1 do
+ TChessBoardLayerBase(m_lstLayers[i]).RDraw;
+
+ PBoxBoardPaint(nil);
end;
-procedure TChessBoard.FormCreate(Sender: TObject);
+procedure TChessBoard.HilightLastMove;
+var
+ i, j, l,
+ _i0, _j0, x, y: integer;
begin
- m_iDeltaWidthHeight := Width - Height;
-
- m_iTimePanelInitialWidth := TimePanel.Width;
- m_iWhitePanelInitialLeft := WhitePanel.Left;
- m_iWhitePanelInitialWidth := WhitePanel.Width;
- m_iBlackPanelInitialLeft := BlackPanel.Left;
- m_iBlackPanelInitialWidth := BlackPanel.Width;
-
- m_TimeFont := TFont.Create;
- m_TimeFont.Assign(WhiteTimeLabel.Font);
-
- m_BitmapRes := TBitmapRes.Create(Size(PBoxBoard.Width, PBoxBoard.Height));
-
- BlackFlagButton.Glyph := WhiteFlagButton.Glyph; // чтоб не тащить лишнего
- coord_show:= TRUE;
- last_hilight:= FALSE;
- m_animation := aQuick;
-
- TLocalizer.Instance.AddSubscriber(self);
- FLocalize;
+ 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;
- m_ChessRulesEngine := TChessRulesEngine.Create(self);
+ 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;
- // Clock initialization
- SetUnlimited(fcWhite, TRUE); SetUnlimited(fcBlack, TRUE);
+ 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);
- InitPosition;
+ x := m_iSquareSize * (i - 1) + CHB_X;
+ y := m_iSquareSize * (j - 1) + CHB_Y;
+ end;
+ PBoxBoardPaint(nil);
+ end;
end;
-procedure TChessBoard.RDrawHiddenBoard;
+procedure TChessBoard.FDrawHiddenBoard;
var
i, j: integer;
x, y: integer;
begin
- if (not Assigned(bmHiddenBoard)) then
+ if (not Assigned(m_bmHiddenBoard)) then
exit;
// Copy empty board to the hidden one
- with bmHiddenBoard do
+ 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 bmHiddenBoard, bmHiddenBoard.Canvas do
+ with m_bmHiddenBoard, m_bmHiddenBoard.Canvas do
begin
- x:= CHB_X + iSquareSize div 2;
- y:= (bmHiddenBoard.Height + CHB_Y + 8 * iSquareSize + CHB_WIDTH) div 2;
+ 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 + iSquareSize;
+ x := x + m_iSquareSize;
if _flipped then dec(j)
else inc(j);
end;
x:= (CHB_X - CHB_WIDTH) div 2;
- y:= CHB_Y + iSquareSize 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 + iSquareSize;
+ y:= y + m_iSquareSize;
if _flipped then inc(j)
else dec(j);
end;
@@ -417,45 +403,346 @@ begin if ((Position.board[i,j] = ES)) then
continue; // There's nothing to draw
if not _flipped then // Загрузить нужную фигуру из ресурса и нарисовать
- bmHiddenBoard.Canvas.Draw(CHB_X + iSquareSize * (i-1),
- CHB_Y + iSquareSize * (8-j),
+ 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
- bmHiddenBoard.Canvas.Draw(CHB_X + iSquareSize * (8-i),
- CHB_Y + iSquareSize * (j-1),
+ m_bmHiddenBoard.Canvas.Draw(CHB_X + m_iSquareSize * (8-i),
+ CHB_Y + m_iSquareSize * (j-1),
m_bmFigure[Position.board[i,j]]);
end;
end;
-procedure TChessBoard.RDrawBoard;
+function TChessBoard.FGetHiddenBoardCanvas: TCanvas;
begin
- RDrawHiddenBoard;
- PBoxBoardPaint(nil);
+ 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, bmHiddenBoard); // Вывод скрытой доски на форму
-// PBoxBoard.Canvas.StretchDraw(Bounds(0, 0, PBoxBoard.Width, PBoxBoard.Height), bmHiddenBoard);
+ 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;
-constructor TChessBoard.Create(Owner: TComponent; h: TChessBoardHandler);
+function TChessBoard.FGetLastMove: PMoveAbs;
begin
- inherited Create(Owner);
- Handler:= h;
+ 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;
- bmHiddenBoard.Free;
+ m_bmHiddenBoard.Free;
m_bmBuf.Free;
for _fig := Low(TFigure) to High(TFigure) do
@@ -463,9 +750,6 @@ begin m_bmChessBoard.Free;
m_BitmapRes.Free;
- m_TimeFont.Free;
-
- TLocalizer.Instance.DeleteSubscriber(self);
end;
@@ -474,15 +758,41 @@ procedure TChessBoard.PBoxBoardDragDrop(Sender, Source: TObject; X, var
i, j: Integer;
begin
- WhatSquare(Point(X, Y), i, j);
- if (Mode = mGame) then
+ 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
- if (RDoMove(i, j)) then
+ i := (X - CHB_X + m_iSquareSize) div m_iSquareSize;
+ j := 8 - (Y - CHB_Y) div m_iSquareSize;
+ if (_flipped) then
begin
- SwitchClock(PositionColor);
- dragged_moved:= TRUE;
+ i := 9 - i;
+ j := 9 - j;
end;
- end; // if
+ 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;
@@ -494,25 +804,26 @@ var begin
case State of
dsDragEnter:
- hilighted:= FALSE;
+ m_bHilighted := FALSE;
+
dsDragMove:
begin
- // Восстановить фрагмент на bmHiddenBoard
- bmHiddenBoard.Canvas.Draw(x0 - dx, y0 - dy, m_bmBuf);
- // Копировать новый фрагмент в буфер
- m_bmBuf.Canvas.CopyRect(Bounds(0, 0, iSquareSize, iSquareSize),
- bmHiddenBoard.Canvas, Bounds(X - dx, Y - dy, iSquareSize, iSquareSize));
- // Нарисовать перетаскиваемую фигуру в новой позиции
- bmHiddenBoard.Canvas.Draw(X - dx, Y - dy, m_bmFigure[m_fig]);
- // Перенести новый фрагмент на экран
+ // 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) + iSquareSize, abs(Y - y0) + iSquareSize);
- PBoxBoard.Canvas.CopyRect(rect, bmHiddenBoard.Canvas, rect);
+ abs(X - x0) + m_iSquareSize, abs(Y - y0) + m_iSquareSize);
+ PBoxBoard.Canvas.CopyRect(rect, m_bmHiddenBoard.Canvas, rect);
x0 := X;
y0 := Y;
- WhatSquare(Point(X,Y), i,j);
+ FWhatSquare(Point(X,Y), i, j);
Accept := ((i in [1..8]) and (j in [1..8]));
end;
@@ -520,50 +831,64 @@ begin end;
-procedure TChessBoard.PBoxBoardEndDrag(Sender, Target: TObject; X,
- Y: Integer);
+procedure TChessBoard.PBoxBoardEndDrag(Sender, Target: TObject; X, Y: Integer);
+var
+ i, j: integer;
+ bRes: boolean;
begin
- if hilighted then
- with bmHiddenBoard.Canvas do
+ case m_Mode of
+ mGame, mAnalyse:
+ begin
+ if (m_bHilighted) then
begin
- Pen.Color:= HILIGHT_COLOR;
- Pen.Width := HILIGHT_WIDTH;
- x0:= x0 - dx;
- y0:= y0 - dy;
- MoveTo(x0,y0);
- LineTo(x0 + iSquareSize - 1, y0);
- LineTo(x0 + iSquareSize - 1, y0 + iSquareSize - 1);
- LineTo(x0, y0 + iSquareSize - 1);
- LineTo(x0,y0);
-
- PBoxBoardPaint(nil);
+ 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
- RDrawBoard;
- if dragged_moved then
+ else
+ begin
+ if (AnimateTimer.Enabled) then
+ AnimateTimer.Enabled := FALSE;
+ FDrawBoard;
+ if (m_bDraggedMoved) then
begin
HilightLastMove;
Evaluate;
- dragged_moved:= FALSE;
+ m_bDraggedMoved := FALSE;
end;
+ end;
end;
-end;
-
-procedure TChessBoard.WhatSquare(const P: TPoint;
- var i: Integer; var j: Integer);
-begin
- with P do
+ mEdit:
begin
- i := (X - CHB_X + iSquareSize) div iSquareSize;
- j := 8 - (Y - CHB_Y) div iSquareSize;
- if (_flipped) then
+ if (m_bDraggedMoved) then
begin
- i := 9 - i;
- j := 9 - j;
+ 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;
- end;
+
+ FDrawBoard;
+ end;
+ end; // case
end;
@@ -573,58 +898,67 @@ var i, j: Integer;
f: TFigure;
begin
- WhatSquare(Point(X, Y), i, j);
+ 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 Mode of
- mGame:
+ case m_Mode of
+ mGame, mAnalyse:
begin
- if (ViewGaming) then
+ if (m_bViewGaming) then
exit;
- if (Button <> mbLeft) or (Position.color <> player_color) or
- (((Position.color <> fcWhite) or (f >= ES)) and
- ((Position.color <> fcBlack) or (f <= ES))) then
+ 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;
- else
- exit;
- end;
- if (anim_step < anim_step_num) then
+ mEdit:
begin
- anim_step:= anim_step_num;
- AnimateTimerTimer(nil);
+ if (f = ES) then
+ exit;
end;
- if ((i = m_i0) and (j = m_j0)) then
- hilighted := (hilighted xor TRUE)
else
- hilighted:= TRUE;
+ exit;
+ end;
+
+ if (m_iAnimStep < m_iAnimStepsCount) then
+ FEndAnimation;
m_fig := f;
m_i0 := i;
m_j0 := j;
- dx := (X - CHB_X) mod iSquareSize;
- dy := (Y - CHB_Y) mod iSquareSize;
+ dx := (X - CHB_X) mod m_iSquareSize;
+ dy := (Y - CHB_Y) mod m_iSquareSize;
x0 := X;
y0 := Y;
- dragged_moved := TRUE;
+ m_bDraggedMoved := TRUE;
PBoxBoard.BeginDrag(FALSE);
end;
-procedure TChessBoard.PBoxBoardMouseMove(Sender: TObject;
- Shift: TShiftState; X, Y: Integer);
+procedure TChessBoard.PBoxBoardMouseMove(Sender: TObject; Shift: TShiftState;
+ X, Y: Integer);
var
f: TFigure;
i,j: Integer;
begin
- WhatSquare(Point(X,Y), i,j);
+ FWhatSquare(Point(X,Y), i,j);
if (not ((i in [1..8]) and (j in [1..8]))) then
begin
PBoxBoard.Cursor:= crDefault;
@@ -633,388 +967,185 @@ begin f := Position.board[i,j];
- case Mode of
- mGame:
+ case m_Mode of
+ mGame, mAnalyse:
begin
- if (ViewGaming) then
+ if (m_bViewGaming) then
exit;
-
- if (player_color = Position.color) and
+
+ 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;
-
- else
- PBoxBoard.Cursor:= crDefault;
- end;
-end;
-
-
-procedure TChessBoard.ROnAfterMoveDone;
-var
- strLastMove: string;
-begin
- if (Assigned(Handler) and
- ((Mode = mGame) and (Position.color <> player_color))) then
- begin
- strLastMove := ChessRulesEngine.LastMoveStr;
- Handler(cbeMoved, @strLastMove, self);
- end;
-end;
-
+ end;
-procedure TChessBoard.FOnAfterMoveDone;
-var
- _fig: TFigure;
-begin
- m_i0 := lastMove.i0;
- m_j0 := lastMove.j0;
+ mEdit:
+ begin
+ if (f <> ES) then
+ PBoxBoard.Cursor:= crHandPoint
+ else
+ PBoxBoard.Cursor:= crDefault;
+ end;
- _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;
-
- ROnAfterMoveDone;
+ PBoxBoard.Cursor := crDefault;
+ end;
end;
-function TChessBoard.RDoMove(i, j: integer; prom_fig: TFigureName = K): boolean;
+function TChessBoard.FGetPositionsList: TList;
begin
- Result := ChessRulesEngine.DoMove(m_i0, m_j0, i, j, prom_fig);
- if (Result) then
- FOnAfterMoveDone;
+ Result := m_ChessRulesEngine.PositionsList;
end;
-function TChessBoard.FGetPositionsList: TList;
+function TChessBoard.FGetColorStarts: TFigureColor;
begin
- Result := ChessRulesEngine.PositionsList;
+ Result := m_ChessRulesEngine.GetColorStarts;
end;
-procedure TChessBoard.PBoxBoardMouseUp(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+procedure TChessBoard.PBoxBoardMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
var
i, j: integer;
begin
case Button of
mbLeft:
- case Mode of
- mGame:
+ 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
- if (not hilighted) then
- exit;
- WhatSquare(Point(X, Y), i, j);
- if (dragged_moved) then
- RDrawBoard
+ m_bHilighted := FALSE;
+ if (FDoMove(i, j)) then
+ FAnimate(i, j)
else
- begin
- hilighted:= FALSE;
- if (RDoMove(i, j)) then
- begin
- Animate(i, j);
- SwitchClock(PositionColor);
- end
- else
- RDrawBoard;
- end;
+ FDrawBoard;
end;
- 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:
- if (Assigned(Handler)) then
- Handler(cbeMenu, self);
+ begin
+ FDoHandler(cbeMenu, self);
+ end;
+
end;
end;
+
procedure TChessBoard.PBoxBoardStartDrag(Sender: TObject;
var DragObject: TDragObject);
begin
- // Копировать изображение пустого поля в m_bmBuf
- m_bmBuf.Width:= iSquareSize; m_bmBuf.Height:= iSquareSize;
+ // 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, iSquareSize, iSquareSize),
- m_bmFigure[ES].Canvas, Bounds(0,0, iSquareSize, iSquareSize))
+ 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, iSquareSize, iSquareSize),
- m_bmFigure[ES].Canvas, Bounds(iSquareSize,0, iSquareSize, iSquareSize));
+ m_bmBuf.Canvas.CopyRect(Bounds(0,0, m_iSquareSize, m_iSquareSize),
+ m_bmFigure[ES].Canvas, Bounds(m_iSquareSize,0, m_iSquareSize, m_iSquareSize));
- dragged_moved:= FALSE;
-end;
-
-
-procedure TChessBoard.Animate(const i, j: integer);
-var
- x, y: integer;
-begin
- if not Showing then exit;
-
- case animation of
- aNo: anim_step_num:= 1;
- aSlow: anim_step_num:= ANIMATION_SLOW;
- aQuick: anim_step_num:= ANIMATION_QUICK;
- end;
-
- if (_flipped) then
- begin
- x0 := (8 - m_i0) * iSquareSize + CHB_X;
- y0 := (m_j0 - 1) * iSquareSize + CHB_Y;
- x := (8 - i) * iSquareSize + CHB_X;
- y := (j - 1) * iSquareSize + CHB_Y;
- end
- else
- begin
- x0:= (m_i0 - 1) * iSquareSize + CHB_X;
- y0:= (8 - m_j0) * iSquareSize + CHB_Y;
- x:= (i - 1) * iSquareSize + CHB_X;
- y:= (8 - j) * iSquareSize + CHB_Y;
- end;
-
- anim_dx:= (x-x0) / anim_step_num;
- anim_dy:= (y-y0) / anim_step_num;
-
- anim_step:= 0;
-
- // Копировать изображение пустого поля в m_bmBuf
- m_bmBuf.Width := iSquareSize;
- m_bmBuf.Height := iSquareSize;
- if (((m_i0 + m_j0) and 1) <> 0) then
- m_bmBuf.Canvas.CopyRect(Bounds(0, 0, iSquareSize, iSquareSize),
- m_bmFigure[ES].Canvas, Bounds(0, 0, iSquareSize, iSquareSize))
- else
- m_bmBuf.Canvas.CopyRect(Bounds(0, 0, iSquareSize, iSquareSize),
- m_bmFigure[ES].Canvas, Bounds(iSquareSize, 0, iSquareSize, iSquareSize));
-
- AnimateTimer.Enabled := TRUE;
-end;
-
-
-procedure TChessBoard.AnimateTimerTimer(Sender: TObject);
-var
- X,Y: integer;
- rect: TRect;
-begin
- inc(anim_step);
- if (anim_step < anim_step_num) then
- begin
- X := round(x0 + anim_dx * anim_step);
- Y := round(y0 + anim_dy * anim_step);
- dx := X - x0 - round(anim_dx * (anim_step - 1));
- dy := Y - y0 - round(anim_dy * (anim_step - 1));
-
- // Восстановить фрагмент на bmHiddenBoard
- bmHiddenBoard.Canvas.Draw(X - dx, Y - dy, m_bmBuf);
- // Копировать новый фрагмент в буфер
- m_bmBuf.Canvas.CopyRect(Bounds(0, 0, iSquareSize, iSquareSize),
- bmHiddenBoard.Canvas, Bounds(X, Y, iSquareSize, iSquareSize));
- // Нарисовать перетаскиваемую фигуру в новой позиции
- bmHiddenBoard.Canvas.Draw(X, Y, m_bmFigure[m_fig]);
- // Перенести новый фрагмент на экран
- rect := Bounds(Min(X - dx, X), Min(Y - dy, Y),
- abs(dx) + iSquareSize, abs(dy) + iSquareSize);
- PBoxBoard.Canvas.CopyRect(rect, bmHiddenBoard.Canvas, rect);
- end
- else
- begin
- AnimateTimer.Enabled := FALSE;
- RDrawBoard;
- HilightLastMove;
- Evaluate;
- end;
+ m_bDraggedMoved := FALSE;
end;
procedure TChessBoard.InitPosition;
begin
- ChessRulesEngine.InitNewGame;
- RDrawBoard;
-end;
+ m_ChessRulesEngine.InitNewGame;
+ FCancelAnimationDragging;
+ FOnAfterSetPosition;
-procedure TChessBoard.SetMode(const m: TMode);
-begin
- mode_var := m;
- RDrawBoard;
- HilightLastMove;
- if (mode_var <> mGame) then
- begin
- WhiteFlagButton.Visible := FALSE;
- BlackFlagButton.Visible := FALSE;
- end;
+ FDrawBoard;
end;
-procedure TChessBoard.SetTime(color: TFigureColor; const tm: TDateTime);
+procedure TChessBoard.PPRandom;
begin
- if (not Unlimited[color]) then
- begin
- if ((not auto_flag) and (not ViewGaming)) then
- begin
- case color of
- fcWhite:
- WhiteFlagButton.Visible := ((player_color = fcBlack) and (tm = 0.0));
- fcBlack:
- BlackFlagButton.Visible := ((player_color = fcWhite) and (tm = 0.0));
- end;
- end;
- player_time[color]:= tm;
- ShowTime(color);
- end;
-end;
+ m_ChessRulesEngine.InitNewPPRandomGame;
-
-function TChessBoard.GetTime(color: TFigureColor): TDateTime;
-begin
- Result:= player_time[color];
+ FCancelAnimationDragging;
+ FOnAfterSetPosition;
+
+ FDrawBoard;
end;
-procedure TChessBoard.GameTimerTimer(Sender: TObject);
+procedure TChessBoard.TakeBack;
begin
- if unlimited_var[clock_color] then
- begin
- GameTimer.Enabled := FALSE;
- exit;
- end;
- // TODO: cheating check
- player_time[clock_color] := player_time[clock_color] - (Now - past_time);
- if player_time[clock_color] <= 0.0 then
- begin
- player_time[clock_color] := 0.0;
- ShowTime(clock_color);
- if ((not auto_flag) and (player_color <> clock_color) and (not ViewGaming)) then
- begin
- case clock_color of
- fcWhite:
- WhiteFlagButton.Visible := TRUE;
- fcBlack:
- BlackFlagButton.Visible := TRUE;
- end;
- end;
- if ((player_color <> clock_color) and Assigned(Handler) and (Mode = mGame) and (auto_flag)) then
- Handler(cbeTimeOut, self);
- GameTimer.Enabled := FALSE;
- end;
-{$IFNDEF THREADED_CHESSCLOCK}
- ShowTime(clock_color);
-{$ENDIF}
-
- past_time:= Now;
-end;
+ if (m_Mode = mEdit) then
+ exit;
+ if (not m_ChessRulesEngine.TakeBack) then
+ exit;
-procedure TChessBoard.SetUnlimited(color: TFigureColor; const unl: boolean);
-begin
- unlimited_var[color]:= unl;
- ShowTime(color);
+ FOnAfterSetPosition;
+ // TODO: animation
+ FDrawBoard;
end;
-function TChessBoard.GetUnlimited(color: TFigureColor): boolean;
+function TChessBoard.NMoveDone: integer;
begin
- Result := unlimited_var[color];
+ Result := m_ChessRulesEngine.NMovesDone;
end;
-procedure TChessBoard.SwitchClock(clock_color: TFigureColor);
+function TChessBoard.NPlysDone: integer;
begin
- self.clock_color := clock_color;
- if (not GameTimer.Enabled) then
- begin
- past_time := Now;
- GameTimer.Enabled := TRUE;
- end;
- if (Assigned(Handler) and (Mode = mGame)) then
- Handler(cbeClockSwitched, self);
- ShowTime(clock_color);
-
-{$IFDEF THREADED_CHESSCLOCK}
- if (not Assigned(TimeLabelThread)) then
- TimeLabelThread := TTimeLabelThread.Create(self);
-{$ENDIF}
+ Result := m_ChessRulesEngine.NPlysDone;
end;
-procedure TChessBoard.HilightLastMove;
-var
- i, j, l,
- _i0, _j0, x, y: integer;
+function TChessBoard.FGetMovesOffset: integer;
begin
- // вывод последнего сделанного хода
- 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 := iSquareSize * (_i0 - 1) + CHB_X;
- y := iSquareSize * (_j0 - 1) + CHB_Y;
- bmHiddenBoard.Canvas.Pen.Color := HILIGHT_LAST_MOVE_COLOR;
- bmHiddenBoard.Canvas.Pen.Width := HILIGHT_LAST_MOVE_WIDTH;
-
- for l := 1 to 2 do
- with bmHiddenBoard.Canvas do
- begin
- MoveTo(x, y);
- LineTo(x + iSquareSize - 1, y);
- LineTo(x + iSquareSize - 1, y + iSquareSize - 1);
- LineTo(x, y + iSquareSize - 1);
- LineTo(x, y);
-
- x := iSquareSize * (i - 1) + CHB_X;
- y := iSquareSize * (j - 1) + CHB_Y;
- end;
- PBoxBoardPaint(nil);
- end;
+ Result := m_ChessRulesEngine.MovesOffset;
end;
-procedure TChessBoard.SetPlayerColor(const color: TFigureColor);
+function TChessBoard.FGetPositionColor: TFigureColor;
begin
- FCancelAnimationDragging;
- player_color:= color;
- if (player_color = fcWhite) then
- SetFlipped(FALSE)
- else
- SetFlipped(TRUE); // player_color = fcBlack
-end;
-
-
-procedure TChessBoard.StopClock;
-begin
- GameTimer.Enabled := FALSE;
- WhiteFlagButton.Visible := FALSE;
- BlackFlagButton.Visible := FALSE;
+ 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;
@@ -1037,355 +1168,214 @@ begin end;
-procedure TChessBoard.FormClose(Sender: TObject; var Action: TCloseAction);
-begin
- if ((not shuted) and Assigned(Handler)) then
- begin
- Handler(cbeExit, self);
- Action:= caNone;
- end
- else
- shuted := FALSE;
-end;
-
-
-procedure TChessBoard.Shut;
+procedure TChessBoard.FormResize(Sender: TObject);
+var
+ _fig: TFigure;
begin
- shuted:= TRUE;
- Close;
-end;
+ 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;
-procedure TChessBoard.Evaluate;
-begin
- if (Assigned(Handler)) then
+ // Graphics initialization
+ if (not Assigned(m_bmHiddenBoard)) then
begin
- case ChessRulesEngine.GetEvaluation of
- evMate:
- Handler(cbeMate, self);
- evStaleMate:
- Handler(cbeStaleMate, self);
- end;
+ m_bmHiddenBoard := Graphics.TBitmap.Create;
+ m_bmHiddenBoard.Palette := m_bmChessBoard.Palette;
+ m_bmHiddenBoard.Canvas.Font := PBoxBoard.Font; // Характеристики шрифта координат задаются в инспекторе
+ m_bmHiddenBoard.Canvas.Brush.Style := bsClear;
end;
-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;
-procedure TChessBoard.PPRandom;
-begin
- ChessRulesEngine.InitNewPPRandomGame;
- RDrawBoard;
+ FDrawBoard;
end;
-procedure TChessBoard.TakeBack;
+procedure TChessBoard.WMSizing(var Msg: TMessage);
begin
- if (not ChessRulesEngine.TakeBack) then
- exit;
- ROnAfterSetPosition;
- // TODO: animation
- RDrawBoard;
+ 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.SetHilightLastMove(const yes: boolean);
+procedure TChessBoard.FDoHandler(e: TChessBoardEvent; d1: pointer = nil; d2: pointer = nil);
begin
- last_hilight := yes;
- RDrawBoard;
- HilightLastMove;
+ if (Assigned(FHandler)) then
+ FHandler(e, d1, d2);
end;
-procedure TChessBoard.SetCoordinates(const yes: boolean);
+function TChessBoard.FGetMoveNotationFormat: TMoveNotationFormat;
begin
- coord_show := yes;
- RDrawBoard;
- HilightLastMove;
+ Result := m_ChessRulesEngine.MoveNotationFormat;
end;
-function TChessBoard.NMoveDone: integer;
+procedure TChessBoard.FSetMoveNotationFormat(Value: TMoveNotationFormat);
begin
- Result := ChessRulesEngine.NMovesDone;
+ m_ChessRulesEngine.MoveNotationFormat := Value;
end;
-procedure TChessBoard.ROnAfterSetPosition;
-begin
-end;
-
-{$IFDEF THREADED_CHESSCLOCK}
-procedure TTimeLabelThread.Execute;
+function TChessBoard.FGetFENFormat: boolean;
begin
- while ChessBoard.GameTimer.Enabled do
- begin
- if self.player_time[fcWhite] <> ChessBoard.player_time[fcWhite] then
- ChessBoard.ShowTime(fcWhite);
- if self.player_time[fcBlack] <> ChessBoard.player_time[fcBlack] then
- ChessBoard.ShowTime(fcBlack);
- Sleep(ChessBoard.GameTimer.Interval div 2);
- end;
- ChessBoard.TimeLabelThread := nil;
+ Result := m_ChessRulesEngine.FENFormat;
end;
-constructor TTimeLabelThread.Create(ChessBoard: TChessBoard);
+procedure TChessBoard.FSetFENFormat(bValue: boolean);
begin
- self.ChessBoard := ChessBoard;
- self.player_time[fcWhite] := ChessBoard.player_time[fcWhite];
- self.player_time[fcBlack] := ChessBoard.player_time[fcBlack];
-
- inherited Create(TRUE);
-//Priority := tpNormal;
- FreeOnTerminate := TRUE;
- Resume;
-end;
-{$ENDIF}
-
-procedure TChessBoard.FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
-begin
- if Assigned(Handler) then
- Handler(cbeKeyPressed, Pointer(Key), self);
+ m_ChessRulesEngine.FENFormat := bValue;
end;
-function TChessBoard.GetStayOnTop: boolean;
+procedure TChessBoard.BeginUpdate;
begin
- Result := (self.FormStyle = fsStayOnTop);
+ inc(m_iUpdateCounter);
end;
-procedure TChessBoard.SetStayOnTop(onTop: boolean);
+procedure TChessBoard.EndUpdate;
begin
- if (onTop) then
- self.FormStyle := fsStayOnTop
- else
- self.FormStyle := fsNormal;
+ if (m_iUpdateCounter > 0) then
+ begin
+ dec(m_iUpdateCounter);
+ if (m_iUpdateCounter = 0) then
+ FDrawBoard;
+ end;
end;
-procedure TChessBoard.FormActivate(Sender: TObject);
+procedure TChessBoard.FOnDrawLayerUpdate(const ADrawLayer: TChessBoardLayerBase);
begin
- if Assigned(Handler) then
- Handler(cbeActivate, self);
+ if (not AnimateTimer.Enabled) then
+ FDrawBoard;
end;
-procedure TChessBoard.WMMoving(var Msg: TWMMoving);
+procedure TChessBoard.AddLayer(const ALayer: TChessBoardLayerBase);
begin
- // TODO: it's possible to handle if form is outside of the screen
- if Assigned(Handler) then
- Handler(cbeFormMoving, Pointer(Msg.DragRect.Left - Left), Pointer(Msg.DragRect.Top - Top));
- inherited;
-end;
+ if (m_lstLayers.IndexOf(ALayer) >= 0) then
+ exit;
+ ALayer.ChessBoard := self;
+ m_lstLayers.Add(ALayer);
-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 }
+ FOnDrawLayerUpdate(ALayer);
end;
-function TChessBoard.FGetPositinoColor: TFigureColor;
+procedure TChessBoard.RemoveLayer(const ALayer: TChessBoardLayerBase);
begin
- Result := Position.color;
-end;
-
+ if (m_lstLayers.Remove(ALayer) >= 0) then
+ begin
+ ALayer.ChessBoard := nil;
-function TChessBoard.FGetPosition: PChessPosition;
-begin
- Result := ChessRulesEngine.Position;
+ FOnDrawLayerUpdate(ALayer);
+ end;
end;
-function TChessBoard.AskPromotionFigure(FigureColor: TFigureColor): TFigureName;
+function TChessBoard.IsMoveAnimating: boolean;
begin
- if (Showing) then
- begin
- with TPromotionForm.Create(self, m_BitmapRes) do
- try
- Result := ShowPromotion(FigureColor);
- finally
- Free;
- end;
- end
- else
- Result := Q;
+ Result := AnimateTimer.Enabled;
end;
+////////////////////////////////////////////////////////////////////////////////
+// TChessBoardDrawBase
-function TChessBoard.FGetLastMove: PMoveAbs;
+procedure TChessBoardLayerBase.RDoUpdate;
begin
- Result := ChessRulesEngine.lastMove;
+ if (Assigned(m_ChessBoard)) then
+ m_ChessBoard.FOnDrawLayerUpdate(self);
end;
-procedure TChessBoard.FCancelAnimationDragging;
+function TChessBoardLayerBase.FGetSquareSize: integer;
begin
- // Отмена анимации и перетаскивания
- if (AnimateTimer.Enabled) then
- begin
- AnimateTimer.Enabled := FALSE;
- // anim_step := anim_step_num;
- // AnimateTimerTimer(nil);
- end;
- if (PBoxBoard.Dragging) then
- begin
- dragged_moved := FALSE;
- PBoxBoard.EndDrag(FALSE);
- end;
+ if (Assigned(m_ChessBoard)) then
+ Result := m_ChessBoard.SquareSize
+ else
+ Result := 0;
end;
-procedure TChessBoard.FlagButtonClick(Sender: TObject);
+function TChessBoardLayerBase.FGetCanvas: TCanvas;
begin
- if Assigned(Handler) and (Mode = mGame) then
- Handler(cbeTimeOut, self);
+ if (Assigned(m_ChessBoard)) then
+ Result := m_ChessBoard.FGetHiddenBoardCanvas
+ else
+ Result := nil;
end;
-procedure TChessBoard.SetAutoFlag(auto_flag: boolean);
+function TChessBoardLayerBase.FGetPosition: PChessPosition;
begin
- self.auto_flag := auto_flag;
- if (auto_flag) then
- begin
- WhiteFlagButton.Visible := FALSE;
- BlackFlagButton.Visible := FALSE;
- end;
+ if (Assigned(m_ChessBoard)) then
+ Result := m_ChessBoard.Position
+ else
+ Result := nil;
end;
-procedure TChessBoard.FormResize(Sender: TObject);
-var
- _fig: TFigure;
+function TChessBoardLayerBase.RGetColorStarts: TFigureColor;
begin
- FreeAndNil(m_bmChessBoard);
- m_BitmapRes.CreateBoardBitmap(Size(PBoxBoard.Width, PBoxBoard.Height), self.Color,
- m_bmChessBoard);
- 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(bmHiddenBoard)) then
- begin
- bmHiddenBoard := TBitmap.Create;
- bmHiddenBoard.Palette := m_bmChessBoard.Palette;
- bmHiddenBoard.Canvas.Font := PBoxBoard.Font; // Характеристики шрифта координат задаются в инспекторе
- bmHiddenBoard.Canvas.Brush.Style := bsClear;
- end;
- bmHiddenBoard.Width := m_bmChessBoard.Width;
- bmHiddenBoard.Height := m_bmChessBoard.Height;
-
- if (not Assigned(m_bmBuf)) then
- begin
- m_bmBuf := TBitmap.Create;
- m_bmBuf.Palette:= m_bmChessBoard.Palette;
- end;
-
- RDrawBoard;
+ if (Assigned(m_ChessBoard)) then
+ Result := m_ChessBoard.FGetColorStarts
+ else
+ Result := fcWhite;
end;
-procedure TChessBoard.TimePanelResize(Sender: TObject);
-var
- rRatio: real;
+function TChessBoardLayerBase.FGetPositionsList: TList;
begin
- // Adjust panels on TimePanel
- rRatio := TimePanel.Width / m_iTimePanelInitialWidth;
- WhitePanel.Left := Round(rRatio * m_iWhitePanelInitialLeft);
- WhitePanel.Width := m_iWhitePanelInitialWidth;
- BlackPanel.Left := Round(rRatio * m_iBlackPanelInitialLeft);
- BlackPanel.Width := m_iBlackPanelInitialWidth;
-
-
- WhiteTimeLabel.Font.Assign(m_TimeFont);
- BlackTimeLabel.Font.Assign(m_TimeFont);
- if (WhitePanel.Left + WhitePanel.Width < BlackPanel.Left) then
- begin
- WhiteLabel.Caption := WHITE_LONG_LABEL;
- BlackLabel.Caption := BLACK_LONG_LABEL;
- end
+ if (Assigned(m_ChessBoard)) then
+ Result := m_ChessBoard.PositionsList
else
- begin
- WhitePanel.Left := 4;
- WhitePanel.Width := TimePanel.Width div 2;
- BlackPanel.Left := TimePanel.Width div 2;
- BlackPanel.Width := TimePanel.Width div 2 - 4;
+ Result := nil;
+end;
- WhiteLabel.Caption := WHITE_MEDIUM_LABEL;
- BlackLabel.Caption := BLACK_MEDIUM_LABEL;
- end;
- // Adjust color labels
- if ((WhiteTimeLabel.Left + WhiteTimeLabel.Width > WhitePanel.Width) or
- (BlackTimeLabel.Left + BlackTimeLabel.Width > BlackPanel.Width)) then
- begin
- WhiteTimeLabel.Font.Size := WhiteTimeLabel.Font.Size - 4;
- BlackTimeLabel.Font.Size := BlackTimeLabel.Font.Size - 4;
- WhiteLabel.Caption := WHITE_SHORT_LABEL;
- BlackLabel.Caption := BLACK_SHORT_LABEL;
- end;
+procedure TChessBoardLayerBase.ROnAfterMoveDone;
+begin
end;
-procedure TChessBoard.FFlashWindow;
-var
- flushWindowInfo: TFlashWInfo;
+procedure TChessBoardLayerBase.ROnAfterSetPosition;
begin
- // Flash with taskbar
- flushWindowInfo.cbSize := SizeOf(flushWindowInfo);
- flushWindowInfo.hwnd := Application.Handle;
- flushWindowInfo.dwflags := FLASHW_TRAY; // FLASHW_ALL; //FLASHW_TRAY;
- flushWindowInfo.ucount := 3; // Flash times
- flushWindowInfo.dwtimeout := 0; // speed in msec, 0 - frequency of cursor flashing
- FlashWindowEx(flushWindowInfo);
-
- if (self.Focused) then
- exit;
- // Flash window
- flushWindowInfo.hwnd := self.Handle; // handle of the flashing window
- flushWindowInfo.dwflags := FLASHW_CAPTION; // FLASHW_TRAY; // FLASHW_ALL; //FLASHW_TRAY;
- FlashWindowEx(flushWindowInfo);
end;
-procedure TChessBoard.FLocalize;
+procedure TChessBoardLayerBase.ROnAfterModeSet(const OldValue, NewValue: TMode);
begin
- with TLocalizer.Instance do
- begin
- WHITE_LONG_LABEL := GetLabel(13);
- WHITE_MEDIUM_LABEL := GetLabel(14);
- WHITE_SHORT_LABEL := GetLabel(15);
- BLACK_LONG_LABEL := GetLabel(16);
- BLACK_MEDIUM_LABEL := GetLabel(17);
- BLACK_SHORT_LABEL := GetLabel(18);
- end;
-
- TimePanelResize(nil);
end;
-initialization
+procedure TChessBoardLayerBase.ROnResetMoveList;
begin
- Randomize; // для PP Random
end;
-finalization
-
end.
|