From a0f6fd68a56068a20e7186e2dd2d7daccfbce4aa Mon Sep 17 00:00:00 2001 From: Pavel Perminov Date: Wed, 26 Sep 2012 19:02:53 +0000 Subject: Chess4Net_MI 2010.0 release (106 rev. truncated adjusted copy) git-svn-id: http://svn.miranda-ng.org/main/trunk@1666 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- plugins/Chess4Net/ChessBoardUnit.pas | 1391 ++++++++++++++++++++++++++++++++++ 1 file changed, 1391 insertions(+) create mode 100644 plugins/Chess4Net/ChessBoardUnit.pas (limited to 'plugins/Chess4Net/ChessBoardUnit.pas') diff --git a/plugins/Chess4Net/ChessBoardUnit.pas b/plugins/Chess4Net/ChessBoardUnit.pas new file mode 100644 index 0000000000..6b655058ad --- /dev/null +++ b/plugins/Chess4Net/ChessBoardUnit.pas @@ -0,0 +1,1391 @@ +unit ChessBoardUnit; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, TntForms, + Dialogs, StdCtrls, TntStdCtrls, ExtCtrls, Buttons, + // Chess4net + ChessBoardHeaderUnit, ChessRulesEngine, BitmapResUnit, LocalizerUnit; + +type + TMode = (mView, mGame); // состояние доски + TChessBoardEvent = + (cbeMoved, cbeMate, cbeStaleMate, cbeInsuffMaterial, cbeKeyPressed, + cbeClockSwitched, cbeTimeOut, cbeExit, cbeMenu, cbeActivate, cbeFormMoving, + cbeRefreshAll); // возможно добавление новых событий + // cbeRefreshAll сигнализирует, что были изменены глобальные опции. + 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} + + TChessBoard = class(TTntForm, ILocalizable, 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 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); + 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); + + private + m_ChessRulesEngine: TChessRulesEngine; + + m_i0, m_j0: integer; + m_fig: TFigure; + + mode_var: TMode; + dx, dy: integer; // Расстояние от курсора до верхнего левого угла + x0, y0: integer; // Предыдущие координаты курсора + _flipped: boolean; // Доска перевёрнута или нет + hilighted: boolean; // Подсветка делаемого хода + + 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; // флаг координат + + auto_flag: boolean; // индикатор автофлага + player_time: array[TFigureColor] of TDateTime; // время белых и чёрных + past_time: TDateTime; // время начала обдумывания хода + unlimited_var: array[TFigureColor] of boolean; // партия без временного контроля + clock_color: TFigureColor; // цвет анимируемой фигуры + + shuted: boolean; // индикатор внешнего закрытия окна + + // 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_bViewGaming: boolean; + +{$IFDEF THREADED_CHESSCLOCK} + TimeLabelThread: TTimeLabelThread; // нить используется для борьбы с лагом в Миранде +{$ENDIF} + + 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 FGetPosition: PChessPosition; + function AskPromotionFigure(FigureColor: TFigureColor): TFigureName; + + function FGetLastMove: PMoveAbs; + + function FGetPositionsList: TList; + + procedure FOnAfterMoveDone; + + property ChessRulesEngine: TChessRulesEngine read m_ChessRulesEngine; + property Position: PChessPosition read FGetPosition; + + property lastMove: PMoveAbs read FGetLastMove; + + protected + iSquareSize: integer; // Size of a chess board field + bmHiddenBoard: TBitmap; + procedure RDrawBoard; + + procedure RDrawHiddenBoard; virtual; + procedure ROnAfterSetPosition; virtual; + function RDoMove(i, j: integer; prom_fig: TFigureName = K): boolean; + procedure ROnAfterMoveDone; virtual; + + property PositionsList: TList read FGetPositionsList; + + public + constructor Create(Owner: TComponent; h: TChessBoardHandler = nil); reintroduce; + + procedure TakeBack; // взятие хода обратно + procedure SwitchClock(clock_color: TFigureColor); + procedure InitPosition; + procedure PPRandom; + procedure StopClock; + + 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; + property ViewGaming: boolean read m_bViewGaming write m_bViewGaming; + end; + +implementation + +{$J+} + +{$R *.dfm} + +uses + StrUtils, Math, DateUtils, + // Chess4Net + PromotionUnit; + +const + HILIGHT_WIDTH = 1; + HILIGHT_COLOR: TColor = clRed; + HILIGHT_LAST_MOVE_WIDTH = 1; + HILIGHT_LAST_MOVE_COLOR: TColor = clBlue; + ANIMATION_SLOW = 30; // Время анимации хода в фреймах >= 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 + +function TChessBoard.DoMove(move_str: string): boolean; +begin + // Отмена анимации + if (AnimateTimer.Enabled) then + begin + AnimateTimer.Enabled := FALSE; + anim_step := anim_step_num; + AnimateTimerTimer(nil); + 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; +end; + + +procedure TChessBoard.ShowTime(const c: TFigureColor); +var + time_label: TLabel; +begin + if c = fcWhite then time_label:= WhiteTimeLabel + else time_label:= BlackTimeLabel; + + if unlimited_var[c] then + begin + time_label.Caption:= ''; + exit; + end; + + time_label.Font.Color:= TIME_COLOR; + + 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; + + time_label.Caption:= TimeToStr(player_time[c]); +end; + + + +procedure TChessBoard.SetFlipped(const f: boolean); +begin + // TODO: ??? + _flipped:= f; + RDrawBoard; +end; + + +procedure TChessBoard.ResetMoveList; +begin + ChessRulesEngine.ResetMoveList; +end; + + +function TChessBoard.SetPosition(const posstr: string): boolean; +begin + Result := ChessRulesEngine.SetPosition(posstr); + if (not Result) then + exit; + + FCancelAnimationDragging; + ROnAfterSetPosition; + clock_color := Position.color; + RDrawBoard; +end; + + +function TChessBoard.GetPosition: string; +begin + Result := ChessRulesEngine.GetPosition; +end; + + +procedure TChessBoard.FormCreate(Sender: TObject); +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; + + m_ChessRulesEngine := TChessRulesEngine.Create(self); + + // Clock initialization + SetUnlimited(fcWhite, TRUE); SetUnlimited(fcBlack, TRUE); + + InitPosition; +end; + + +procedure TChessBoard.RDrawHiddenBoard; +var + i, j: integer; + x, y: integer; +begin + if (not Assigned(bmHiddenBoard)) then + exit; + + // Copy empty board to the hidden one + with 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 + begin + x:= CHB_X + iSquareSize div 2; + y:= (bmHiddenBoard.Height + CHB_Y + 8 * 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; + if _flipped then dec(j) + else inc(j); + end; + x:= (CHB_X - CHB_WIDTH) div 2; + y:= CHB_Y + 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; + 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 // Загрузить нужную фигуру из ресурса и нарисовать + bmHiddenBoard.Canvas.Draw(CHB_X + iSquareSize * (i-1), + CHB_Y + 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_bmFigure[Position.board[i,j]]); + end; +end; + + +procedure TChessBoard.RDrawBoard; +begin + RDrawHiddenBoard; + PBoxBoardPaint(nil); +end; + + +procedure TChessBoard.PBoxBoardPaint(Sender: TObject); +begin + PBoxBoard.Canvas.Draw(0,0, bmHiddenBoard); // Вывод скрытой доски на форму +// PBoxBoard.Canvas.StretchDraw(Bounds(0, 0, PBoxBoard.Width, PBoxBoard.Height), bmHiddenBoard); +end; + + +constructor TChessBoard.Create(Owner: TComponent; h: TChessBoardHandler); +begin + inherited Create(Owner); + Handler:= h; +end; + + +procedure TChessBoard.FormDestroy(Sender: TObject); +var + _fig: TFigure; +begin + m_ChessRulesEngine.Free; + + bmHiddenBoard.Free; + m_bmBuf.Free; + + for _fig := Low(TFigure) to High(TFigure) do + m_bmFigure[_fig].Free; + m_bmChessBoard.Free; + + m_BitmapRes.Free; + m_TimeFont.Free; + + TLocalizer.Instance.DeleteSubscriber(self); +end; + + +procedure TChessBoard.PBoxBoardDragDrop(Sender, Source: TObject; X, + Y: Integer); +var + i, j: Integer; +begin + WhatSquare(Point(X, Y), i, j); + if (Mode = mGame) then + begin + if (RDoMove(i, j)) then + begin + SwitchClock(PositionColor); + dragged_moved:= TRUE; + end; + end; // if +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: + hilighted:= 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]); + // Перенести новый фрагмент на экран + 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); + + x0 := X; + y0 := Y; + + WhatSquare(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); +begin + if hilighted then + with bmHiddenBoard.Canvas do + 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); + end + else + begin + RDrawBoard; + if dragged_moved then + begin + HilightLastMove; + Evaluate; + dragged_moved:= FALSE; + end; + end; +end; + + +procedure TChessBoard.WhatSquare(const P: TPoint; + var i: Integer; var j: Integer); +begin + with P do + begin + i := (X - CHB_X + iSquareSize) div iSquareSize; + j := 8 - (Y - CHB_Y) div iSquareSize; + if (_flipped) then + begin + i := 9 - i; + j := 9 - j; + end; + end; +end; + + +procedure TChessBoard.PBoxBoardMouseDown(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + i, j: Integer; + f: TFigure; +begin + WhatSquare(Point(X, Y), i, j); + if (not ((i in [1..8]) and (j in [1..8]))) then + exit; + + f := Position.board[i,j]; + + case Mode of + mGame: + begin + if (ViewGaming) 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 + exit; + end; + else + exit; + end; + + if (anim_step < anim_step_num) then + begin + anim_step:= anim_step_num; + AnimateTimerTimer(nil); + end; + + if ((i = m_i0) and (j = m_j0)) then + hilighted := (hilighted xor TRUE) + else + hilighted:= TRUE; + + m_fig := f; + m_i0 := i; + m_j0 := j; + + dx := (X - CHB_X) mod iSquareSize; + dy := (Y - CHB_Y) mod iSquareSize; + x0 := X; + y0 := Y; + + dragged_moved := TRUE; + PBoxBoard.BeginDrag(FALSE); +end; + + +procedure TChessBoard.PBoxBoardMouseMove(Sender: TObject; + Shift: TShiftState; X, Y: Integer); +var + f: TFigure; + i,j: Integer; +begin + WhatSquare(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 Mode of + mGame: + begin + if (ViewGaming) then + exit; + + if (player_color = 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; + + +procedure TChessBoard.FOnAfterMoveDone; +var + _fig: TFigure; +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; + + ROnAfterMoveDone; +end; + + +function TChessBoard.RDoMove(i, j: integer; prom_fig: TFigureName = K): boolean; +begin + Result := ChessRulesEngine.DoMove(m_i0, m_j0, i, j, prom_fig); + if (Result) then + FOnAfterMoveDone; +end; + + +function TChessBoard.FGetPositionsList: TList; +begin + Result := ChessRulesEngine.PositionsList; +end; + + +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 + if (not hilighted) then + exit; + WhatSquare(Point(X, Y), i, j); + if (dragged_moved) then + RDrawBoard + else + begin + hilighted:= FALSE; + if (RDoMove(i, j)) then + begin + Animate(i, j); + SwitchClock(PositionColor); + end + else + RDrawBoard; + end; + end; + end; + + mbRight: + if (Assigned(Handler)) then + Handler(cbeMenu, self); + end; +end; + +procedure TChessBoard.PBoxBoardStartDrag(Sender: TObject; + var DragObject: TDragObject); +begin + // Копировать изображение пустого поля в 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)); + + 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; +end; + + +procedure TChessBoard.InitPosition; +begin + ChessRulesEngine.InitNewGame; + RDrawBoard; +end; + + +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; +end; + + +procedure TChessBoard.SetTime(color: TFigureColor; const tm: TDateTime); +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; + + +function TChessBoard.GetTime(color: TFigureColor): TDateTime; +begin + Result:= player_time[color]; +end; + + +procedure TChessBoard.GameTimerTimer(Sender: TObject); +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; + + +procedure TChessBoard.SetUnlimited(color: TFigureColor; const unl: boolean); +begin + unlimited_var[color]:= unl; + ShowTime(color); +end; + + +function TChessBoard.GetUnlimited(color: TFigureColor): boolean; +begin + Result := unlimited_var[color]; +end; + + +procedure TChessBoard.SwitchClock(clock_color: TFigureColor); +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} +end; + + +procedure TChessBoard.HilightLastMove; +var + i, j, l, + _i0, _j0, x, y: 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; +end; + + +procedure TChessBoard.SetPlayerColor(const color: 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; +end; + + +procedure TChessBoard.FormCanResize(Sender: TObject; var NewWidth, + NewHeight: Integer; var Resize: Boolean); +var + + NewBoardSize: TSize; +begin + 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.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; +begin + shuted:= TRUE; + Close; +end; + + +procedure TChessBoard.Evaluate; +begin + if (Assigned(Handler)) then + begin + case ChessRulesEngine.GetEvaluation of + evMate: + Handler(cbeMate, self); + evStaleMate: + Handler(cbeStaleMate, self); + end; + end; +end; + + +procedure TChessBoard.PPRandom; +begin + ChessRulesEngine.InitNewPPRandomGame; + RDrawBoard; +end; + + +procedure TChessBoard.TakeBack; +begin + if (not ChessRulesEngine.TakeBack) then + exit; + ROnAfterSetPosition; + // TODO: animation + RDrawBoard; +end; + + +procedure TChessBoard.SetHilightLastMove(const yes: boolean); +begin + last_hilight := yes; + RDrawBoard; + HilightLastMove; +end; + + +procedure TChessBoard.SetCoordinates(const yes: boolean); +begin + coord_show := yes; + RDrawBoard; + HilightLastMove; +end; + + +function TChessBoard.NMoveDone: integer; +begin + Result := ChessRulesEngine.NMovesDone; +end; + + +procedure TChessBoard.ROnAfterSetPosition; +begin +end; + +{$IFDEF THREADED_CHESSCLOCK} +procedure TTimeLabelThread.Execute; +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; +end; + + +constructor TTimeLabelThread.Create(ChessBoard: TChessBoard); +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); +end; + + +function TChessBoard.GetStayOnTop: boolean; +begin + Result := (self.FormStyle = fsStayOnTop); +end; + + +procedure TChessBoard.SetStayOnTop(onTop: boolean); +begin + if (onTop) then + self.FormStyle := fsStayOnTop + else + self.FormStyle := fsNormal; +end; + + +procedure TChessBoard.FormActivate(Sender: TObject); +begin + if Assigned(Handler) then + Handler(cbeActivate, self); +end; + + +procedure TChessBoard.WMMoving(var Msg: TWMMoving); +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; + + +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; + + +function TChessBoard.FGetPositinoColor: TFigureColor; +begin + Result := Position.color; +end; + + +function TChessBoard.FGetPosition: PChessPosition; +begin + Result := ChessRulesEngine.Position; +end; + + +function TChessBoard.AskPromotionFigure(FigureColor: TFigureColor): TFigureName; +begin + if (Showing) then + begin + with TPromotionForm.Create(self, m_BitmapRes) do + try + Result := ShowPromotion(FigureColor); + finally + Free; + end; + end + else + Result := Q; +end; + + +function TChessBoard.FGetLastMove: PMoveAbs; +begin + Result := ChessRulesEngine.lastMove; +end; + + +procedure TChessBoard.FCancelAnimationDragging; +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; +end; + + +procedure TChessBoard.FlagButtonClick(Sender: TObject); +begin + if Assigned(Handler) and (Mode = mGame) then + Handler(cbeTimeOut, self); +end; + + +procedure TChessBoard.SetAutoFlag(auto_flag: boolean); +begin + self.auto_flag := auto_flag; + if (auto_flag) then + begin + WhiteFlagButton.Visible := FALSE; + BlackFlagButton.Visible := FALSE; + 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); + 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; +end; + + +procedure TChessBoard.TimePanelResize(Sender: TObject); +var + rRatio: real; +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 + else + begin + WhitePanel.Left := 4; + WhitePanel.Width := TimePanel.Width div 2; + BlackPanel.Left := TimePanel.Width div 2; + BlackPanel.Width := TimePanel.Width div 2 - 4; + + 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; +end; + + +procedure TChessBoard.FFlashWindow; +var + flushWindowInfo: TFlashWInfo; +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; +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 + +begin + Randomize; // для PP Random +end; + +finalization + +end. -- cgit v1.2.3