From 690f5e6d29d1c85c4be72638eb22843964c2f512 Mon Sep 17 00:00:00 2001 From: Alexander Lantsev Date: Fri, 24 Apr 2015 08:21:28 +0000 Subject: All non-working stuff moved from trunk git-svn-id: http://svn.miranda-ng.org/main/trunk@13071 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas | 1381 ---------------------- 1 file changed, 1381 deletions(-) delete mode 100644 plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas (limited to 'plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas') diff --git a/plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas b/plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas deleted file mode 100644 index 8a7042f292..0000000000 --- a/plugins/!NotAdopted/Chess4Net/ChessBoardUnit.pas +++ /dev/null @@ -1,1381 +0,0 @@ -//////////////////////////////////////////////////////////////////////////////// -// All code below is exclusively owned by author of Chess4Net - Pavel Perminov -// (packpaul@mail.ru, packpaul1@gmail.com). -// Any changes, modifications, borrowing and adaptation are a subject for -// explicit permition from the owner. - -unit ChessBoardUnit; - -interface - -uses - Forms, ExtCtrls, Classes, Controls, Graphics, Types, Messages, - // - ChessRulesEngine, BitmapResUnit, PromotionUnit; - -type - TMode = (mView, mGame, mAnalyse, mEdit); // Board mode - - TAnimation = (aNo, aSlow, aQuick); - - TChessBoardEvent = (cbeMate, cbeStaleMate, cbeMoved, cbePosSet, cbeMenu); - TChessBoardHandler = procedure(e: TChessBoardEvent; - d1: pointer = nil; d2: pointer = nil) of object; - - TChessBoardLayerBase = class; - - TChessBoard = class(TForm, IChessRulesEngineable) - PBoxBoard: TPaintBox; - AnimateTimer: TTimer; - - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure FormCanResize(Sender: TObject; var NewWidth, - NewHeight: Integer; var Resize: Boolean); - procedure FormResize(Sender: TObject); - procedure AnimateTimerTimer(Sender: TObject); - procedure PBoxBoardPaint(Sender: TObject); - procedure PBoxBoardDragDrop(Sender, Source: TObject; X, Y: Integer); - procedure PBoxBoardDragOver(Sender, Source: TObject; X, Y: Integer; - State: TDragState; var Accept: Boolean); - procedure PBoxBoardEndDrag(Sender, Target: TObject; X, Y: Integer); - procedure PBoxBoardMouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure PBoxBoardMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); - procedure PBoxBoardMouseUp(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - procedure PBoxBoardStartDrag(Sender: TObject; var DragObject: TDragObject); - - private - m_ChessRulesEngine: TChessRulesEngine; - m_BitmapRes: TBitmapRes; // Manager for bitmaps - - FHandler: TChessBoardHandler; - - dx, dy: integer; // Расстояние от курсора до верхнего левого угла - x0, y0: integer; // Предыдущие координаты курсора - _flipped: boolean; // Доска перевёрнута или нет - m_bHilighted: boolean; // Hilight the move that is being done - - m_i0, m_j0: integer; - m_fig: TFigure; - - m_Mode: TMode; - m_bViewGaming: boolean; - - m_bmHiddenBoard: TBitmap; - m_bmChessBoard: TBitmap; - m_bmFigure: array[TFigure] of TBitmap; - m_bmBuf: TBitmap; - - m_iSquareSize: integer; // Size of one chess board field - - m_animation: TAnimation; // Animation speed - m_iAnimStep, m_iPrevAnimStep, m_iAnimStepsCount: integer; - anim_dx, anim_dy: real; // Variables for animation of a dragged piece - - m_PlayerColor: TFigureColor; // Color of player client - m_bDraggedMoved: boolean; // Flag for switching of dragging - last_hilight: boolean; // Flag for hilighting of the last move done - coord_show: boolean; // Flag for showing coordinates - - // Resizing - m_ResizingType: (rtNo, rtHoriz, rtVert); - m_iDeltaWidthHeight: integer; - m_bDeltaWidthHeightFlag: boolean; - - m_PromotionForm: TPromotionForm; - - m_EditPiece: TFigure; - - m_iUpdateCounter: integer; - - m_lstLayers: TList; - - procedure HilightLastMove; - procedure Evaluate; - - function FGetLastMove: PMoveAbs; - property lastMove: PMoveAbs read FGetLastMove; - - function FGetPosition: PChessPosition; - property Position: PChessPosition read FGetPosition; - - function AskPromotionFigure(FigureColor: TFigureColor): TFigureName; - - procedure FSetMode(const Value: TMode); - - function FDoMove(i, j: integer; prom_fig: TFigureName = K): boolean; - procedure FOnAfterMoveDone; - procedure FOnAfterSetPosition; - - procedure FAnimate(const i, j: integer); // Animates a disposition of a piece from (i0,j0) to (i,j) - procedure FDoAnimationStep; - procedure FEndAnimation; - - procedure FWhatSquare(const P: TPoint; var i: Integer; var j: Integer); - - procedure FSetPlayerColor(const Value: TFigureColor); - procedure FCancelAnimationDragging; // Caneling of animation and dragging for trace removal after draw - procedure FSetFlipped(Value: boolean); // Flips chess position - procedure FSetCoordinatesShown(Value: boolean); - procedure FSetLastMoveHilighted(Value: boolean); - function FGetPositionsList: TList; - function FGetPositionColor: TFigureColor; - function FGetMoveNotationFormat: TMoveNotationFormat; - procedure FSetMoveNotationFormat(Value: TMoveNotationFormat); - function FGetFENFormat: boolean; - procedure FSetFENFormat(bValue: boolean); - - procedure FDrawHiddenBoard; - function FGetHiddenBoardCanvas: TCanvas; - - procedure FDrawBoard; - procedure FOnDrawLayerUpdate(const ADrawLayer: TChessBoardLayerBase); - - function FGetMovesOffset: integer; - function FGetColorStarts: TFigureColor; - - procedure WMSizing(var Msg: TMessage); message WM_SIZING; - - procedure FDoHandler(e: TChessBoardEvent; d1: pointer = nil; d2: pointer = nil); - - property SquareSize: integer read m_iSquareSize; - property PositionsList: TList read FGetPositionsList; - - public - constructor Create(Owner: TComponent; AHandler: TChessBoardHandler = nil); reintroduce; - - function DoMove(const strMove: string): boolean; - procedure ResetMoveList; - function SetPosition(const strPosition: string): boolean; - function GetPosition: string; - procedure InitPosition; - procedure PPRandom; - procedure TakeBack; - function NMoveDone: integer; - function NPlysDone: integer; - - function IsMoveAnimating: boolean; - - procedure BeginUpdate; - procedure EndUpdate; - - procedure AddLayer(const ALayer: TChessBoardLayerBase); - procedure RemoveLayer(const ALayer: TChessBoardLayerBase); - - property PlayerColor: TFigureColor read m_PlayerColor write FSetPlayerColor; - property Mode: TMode read m_Mode write FSetMode; - property CoordinatesShown: boolean read coord_show write FSetCoordinatesShown; - property Flipped: boolean read _flipped write FSetFlipped; - property LastMoveHilighted: boolean read last_hilight write FSetLastMoveHilighted; - property Animation: TAnimation read m_animation write m_animation; - property ViewGaming: boolean read m_bViewGaming write m_bViewGaming; - property PositionColor: TFigureColor read FGetPositionColor; // Whos move it is in the current position - property MoveNotationFormat: TMoveNotationFormat - read FGetMoveNotationFormat write FSetMoveNotationFormat; - property MovesOffset: integer read FGetMovesOffset; - property FENFormat: boolean read FGetFENFormat write FSetFENFormat; - property EditPiece: TFigure read m_EditPiece write m_EditPiece; - end; - - - TChessBoardLayerBase = class - private - m_ChessBoard: TChessBoard; - function FGetSquareSize: integer; - function FGetCanvas: TCanvas; - function FGetPosition: PChessPosition; - function FGetPositionsList: TList; - protected - procedure RDraw; virtual; abstract; - function RGetColorStarts: TFigureColor; - - procedure RDoUpdate; - - procedure ROnAfterMoveDone; virtual; - procedure ROnAfterSetPosition; virtual; - procedure ROnAfterModeSet(const OldValue, NewValue: TMode); virtual; - procedure ROnResetMoveList; virtual; - - property ChessBoard: TChessBoard read m_ChessBoard write m_ChessBoard; - property SquareSize: integer read FGetSquareSize; - property Canvas: TCanvas read FGetCanvas; - property Position: PChessPosition read FGetPosition; - property PositionsList: TList read FGetPositionsList; - end; - -implementation - -{$R *.dfm} - -uses - Math, SysUtils, Windows, - // - ChessBoardHeaderUnit; - -const - HILIGHT_WIDTH = 1; - HILIGHT_COLOR: TColor = clRed; - HILIGHT_LAST_MOVE_WIDTH = 1; - HILIGHT_LAST_MOVE_COLOR: TColor = clBlue; - ANIMATION_SLOW = 30; // Time of animation in frames >= 1 - ANIMATION_QUICK = 9; - CHB_WIDTH = 4; - -//////////////////////////////////////////////////////////////////////////////// -// TChessBoard - -constructor TChessBoard.Create(Owner: TComponent; AHandler: TChessBoardHandler = nil); -begin - FHandler := AHandler; - inherited Create(Owner); -end; - - -procedure TChessBoard.AnimateTimerTimer(Sender: TObject); -begin - FDoAnimationStep; - if (m_iAnimStep >= m_iAnimStepsCount) then - FEndAnimation; -end; - - -procedure TChessBoard.FDoAnimationStep; -var - iX, iY: integer; - rect: TRect; -begin - if (m_iAnimStep < m_iAnimStepsCount) then - begin - inc(m_iAnimStep); - - iX := round(x0 + anim_dx * m_iAnimStep); - iY := round(y0 + anim_dy * m_iAnimStep); - dx := iX - x0 - Round(anim_dx * m_iPrevAnimStep); - dy := iY - y0 - Round(anim_dy * m_iPrevAnimStep); - - // Восстановить фрагмент на m_bmHiddenBoard - m_bmHiddenBoard.Canvas.Draw(iX - dx, iY - dy, m_bmBuf); - // Копировать новый фрагмент в буфер - m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize), - m_bmHiddenBoard.Canvas, Bounds(iX, iY, m_iSquareSize, m_iSquareSize)); - // Нарисовать перетаскиваемую фигуру в новой позиции - m_bmHiddenBoard.Canvas.Draw(iX, iY, m_bmFigure[m_fig]); - // Перенести новый фрагмент на экран - rect := Bounds(Min(iX - dx, iX), Min(iY - dy, iY), - abs(dx) + m_iSquareSize, abs(dy) + m_iSquareSize); - PBoxBoard.Canvas.CopyRect(rect, m_bmHiddenBoard.Canvas, rect); - end; - - m_iPrevAnimStep := m_iAnimStep; - -end; - - -procedure TChessBoard.FEndAnimation; -begin - AnimateTimer.Enabled := FALSE; - - m_iAnimStep := m_iAnimStepsCount; - - FDrawBoard; - HilightLastMove; - Evaluate; -end; - - -procedure TChessBoard.FDrawBoard; -var - i: integer; -begin - if (csDestroying in ComponentState) then - exit; - - if (m_iUpdateCounter > 0) then - exit; - - FDrawHiddenBoard; - - for i := 0 to m_lstLayers.Count - 1 do - TChessBoardLayerBase(m_lstLayers[i]).RDraw; - - PBoxBoardPaint(nil); -end; - - -procedure TChessBoard.HilightLastMove; -var - i, j, l, - _i0, _j0, x, y: integer; -begin - if (not (m_Mode in [mGame, mAnalyse])) then - exit; - - // Output the last move done - if (last_hilight and (lastMove.i0 <> 0)) then - begin - if (_flipped) then - begin - _i0 := 9 - lastMove.i0; - _j0 := lastMove.j0; - i := 9 - lastMove.i; - j := lastMove.j; - end - else - begin - _i0 := lastMove.i0; - _j0 := 9 - lastMove.j0; - i := lastMove.i; - j := 9 - lastMove.j; - end; - - x := m_iSquareSize * (_i0 - 1) + CHB_X; - y := m_iSquareSize * (_j0 - 1) + CHB_Y; - m_bmHiddenBoard.Canvas.Pen.Color := HILIGHT_LAST_MOVE_COLOR; - m_bmHiddenBoard.Canvas.Pen.Width := HILIGHT_LAST_MOVE_WIDTH; - - for l := 1 to 2 do - with m_bmHiddenBoard.Canvas do - begin - MoveTo(x, y); - LineTo(x + m_iSquareSize - 1, y); - LineTo(x + m_iSquareSize - 1, y + m_iSquareSize - 1); - LineTo(x, y + m_iSquareSize - 1); - LineTo(x, y); - - x := m_iSquareSize * (i - 1) + CHB_X; - y := m_iSquareSize * (j - 1) + CHB_Y; - end; - PBoxBoardPaint(nil); - end; -end; - - -procedure TChessBoard.FDrawHiddenBoard; -var - i, j: integer; - x, y: integer; -begin - if (not Assigned(m_bmHiddenBoard)) then - exit; - - // Copy empty board to the hidden one - with m_bmHiddenBoard do - begin - Canvas.CopyRect(Bounds(0,0, Width,Height), m_bmChessBoard.Canvas, Bounds(0,0, Width,Height)); - end; - - // Draw coordinates - if (coord_show) then - with m_bmHiddenBoard, m_bmHiddenBoard.Canvas do - begin - x:= CHB_X + m_iSquareSize div 2; - y:= (m_bmHiddenBoard.Height + CHB_Y + 8 * m_iSquareSize + CHB_WIDTH) div 2; - if _flipped then j := ord('h') - else j:= ord('a'); - for i:= 1 to 8 do // буквы - begin - TextOut(x - TextWidth(chr(j)) div 2, - y + 1 - TextHeight(chr(j)) div 2 , chr(j)); - x := x + m_iSquareSize; - if _flipped then dec(j) - else inc(j); - end; - x:= (CHB_X - CHB_WIDTH) div 2; - y:= CHB_Y + m_iSquareSize div 2; - if _flipped then j:= ord('1') - else j := ord('8'); - for i := 1 to 8 do // цифры - begin - TextOut(x - TextWidth(chr(j)) div 2, - y - TextHeight(chr(j)) div 2, chr(j)); - y:= y + m_iSquareSize; - if _flipped then inc(j) - else dec(j); - end; - end; - - // Draw pieces - for i := 1 to 8 do - for j := 1 to 8 do - begin - if ((Position.board[i,j] = ES)) then - continue; // There's nothing to draw - if not _flipped then // Загрузить нужную фигуру из ресурса и нарисовать - m_bmHiddenBoard.Canvas.Draw(CHB_X + m_iSquareSize * (i-1), - CHB_Y + m_iSquareSize * (8-j), - m_bmFigure[Position.board[i,j]]) - else // Black is below - m_bmHiddenBoard.Canvas.Draw(CHB_X + m_iSquareSize * (8-i), - CHB_Y + m_iSquareSize * (j-1), - m_bmFigure[Position.board[i,j]]); - end; -end; - - -function TChessBoard.FGetHiddenBoardCanvas: TCanvas; -begin - if (Assigned(m_bmHiddenBoard)) then - Result := m_bmHiddenBoard.Canvas - else - Result := nil; -end; - - -procedure TChessBoard.Evaluate; -begin - case m_ChessRulesEngine.GetEvaluation of - evMate: - FDoHandler(cbeMate, self); - evStaleMate: - FDoHandler(cbeStaleMate, self); - end; -end; - - -procedure TChessBoard.PBoxBoardPaint(Sender: TObject); -begin - PBoxBoard.Canvas.Draw(0, 0, m_bmHiddenBoard); // Draw hidden board on the form -// PBoxBoard.Canvas.StretchDraw(Bounds(0, 0, PBoxBoard.Width, PBoxBoard.Height), m_bmHiddenBoard); -end; - - -function TChessBoard.FGetLastMove: PMoveAbs; -begin - Result := m_ChessRulesEngine.lastMove; -end; - - -function TChessBoard.FGetPosition: PChessPosition; -begin - Result := m_ChessRulesEngine.Position; -end; - - -function TChessBoard.AskPromotionFigure(FigureColor: TFigureColor): TFigureName; -var - frmOwner: TForm; -begin - if (Owner is TForm) then - frmOwner := TForm(Owner) - else - frmOwner := self; - - if (Showing) then - begin - m_PromotionForm := TPromotionForm.Create(frmOwner, m_BitmapRes); - try - Result := m_PromotionForm.ShowPromotion(FigureColor); - finally - FreeAndNil(m_PromotionForm); - end; - end - else - Result := Q; -end; - - -procedure TChessBoard.FSetPlayerColor(const Value: TFigureColor); -begin - FCancelAnimationDragging; - m_PlayerColor := Value; - if (m_PlayerColor = fcWhite) then - FSetFlipped(FALSE) - else // fcBlack - FSetFlipped(TRUE); -end; - - -procedure TChessBoard.FCancelAnimationDragging; -begin - // Cancel animation and dragging - if (AnimateTimer.Enabled) then - begin - AnimateTimer.Enabled := FALSE; - // iAnimStep := iAnimStepsCount; - // AnimateTimerTimer(nil); - end; - - if (PBoxBoard.Dragging) then - begin - m_bDraggedMoved := FALSE; - PBoxBoard.EndDrag(FALSE); - end; -end; - - -procedure TChessBoard.FSetFlipped(Value: boolean); -begin - // TODO: ??? - _flipped := Value; - FDrawBoard; -end; - - -procedure TChessBoard.FSetMode(const Value: TMode); -var - OldMode: TMode; - i: integer; -begin - if (m_Mode = Value) then - exit; - - OldMode := m_Mode; - m_Mode := Value; - - if ((m_Mode in [mView, mEdit]) and (Assigned(m_PromotionForm))) then - m_PromotionForm.Close; - - for i := 0 to m_lstLayers.Count - 1 do - TChessBoardLayerBase(m_lstLayers[i]).ROnAfterModeSet(OldMode, m_Mode); - - FDrawBoard; - HilightLastMove; -end; - - -procedure TChessBoard.FSetCoordinatesShown(Value: boolean); -begin - coord_show := Value; - FDrawBoard; - HilightLastMove; -end; - - -procedure TChessBoard.FSetLastMoveHilighted(Value: boolean); -begin - last_hilight := Value; - FDrawBoard; - HilightLastMove; -end; - - -function TChessBoard.DoMove(const strMove: string): boolean; -begin - Result := FALSE; - - if (m_Mode = mEdit) then - exit; - - // Animation canceling - if (AnimateTimer.Enabled) then - FEndAnimation; - - Result := m_ChessRulesEngine.DoMove(strMove); - - if (Result) then - begin - FOnAfterMoveDone; - FAnimate(lastMove.i, lastMove.j); - end; -end; - - -procedure TChessBoard.FOnAfterMoveDone; -var - _fig: TFigure; - strLastMove: string; - i: integer; -begin - m_i0 := lastMove.i0; - m_j0 := lastMove.j0; - - _fig := Position.board[lastMove.i, lastMove.j]; - if (lastMove.prom_fig in [Q, R, B, N]) then - begin - if (_fig < ES) then - m_fig := WP - else - m_fig := BP; - end - else - m_fig := _fig; - - strLastMove := m_ChessRulesEngine.LastMoveStr; - FDoHandler(cbeMoved, @strLastMove, self); - - if (m_Mode = mAnalyse) then - m_PlayerColor := PositionColor; - - for i := 0 to m_lstLayers.Count - 1 do - TChessBoardLayerBase(m_lstLayers[i]).ROnAfterMoveDone; -end; - - -procedure TChessBoard.FAnimate(const i, j: integer); -var - x, y: integer; -begin - if (not Showing) then - exit; - - if ((m_i0 = 0) or (m_j0 = 0)) then - exit; - - if (AnimateTimer.Enabled) then - begin - m_iAnimStep := m_iAnimStepsCount; - exit; - end; - - case animation of - aNo: - m_iAnimStepsCount := 1; - aSlow: - m_iAnimStepsCount := ANIMATION_SLOW; - aQuick: - m_iAnimStepsCount := ANIMATION_QUICK; - end; - - if (_flipped) then - begin - x0 := (8 - m_i0) * m_iSquareSize + CHB_X; - y0 := (m_j0 - 1) * m_iSquareSize + CHB_Y; - x := (8 - i) * m_iSquareSize + CHB_X; - y := (j - 1) * m_iSquareSize + CHB_Y; - end - else - begin - x0 := (m_i0 - 1) * m_iSquareSize + CHB_X; - y0 := (8 - m_j0) * m_iSquareSize + CHB_Y; - x := (i - 1) * m_iSquareSize + CHB_X; - y := (8 - j) * m_iSquareSize + CHB_Y; - end; - - anim_dx := (x - x0) / m_iAnimStepsCount; - anim_dy := (y - y0) / m_iAnimStepsCount; - - m_iAnimStep := 0; - m_iPrevAnimStep := m_iAnimStep; - - // Copy image of the empty square to m_bmBuf - m_bmBuf.Width := m_iSquareSize; - m_bmBuf.Height := m_iSquareSize; - if (((m_i0 + m_j0) and 1) <> 0) then - m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize), - m_bmFigure[ES].Canvas, Bounds(0, 0, m_iSquareSize, m_iSquareSize)) - else - m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize), - m_bmFigure[ES].Canvas, Bounds(m_iSquareSize, 0, m_iSquareSize, m_iSquareSize)); - - AnimateTimer.Enabled := TRUE; -end; - - -procedure TChessBoard.ResetMoveList; -var - i: integer; -begin - m_ChessRulesEngine.ResetMoveList; - - for i := 0 to m_lstLayers.Count - 1 do - TChessBoardLayerBase(m_lstLayers[i]).ROnResetMoveList; -end; - - -function TChessBoard.SetPosition(const strPosition: string): boolean; -begin - Result := m_ChessRulesEngine.SetPosition(strPosition); - if (Result) then - begin - FCancelAnimationDragging; - FOnAfterSetPosition; - FDrawBoard; - end; -end; - - -function TChessBoard.GetPosition: string; -begin - Result := m_ChessRulesEngine.GetPosition; -end; - - -procedure TChessBoard.FOnAfterSetPosition; -var - strPosition: string; - i: integer; -begin - case m_Mode of - mAnalyse: - m_PlayerColor := PositionColor; - - mEdit: - ResetMoveList; - end; - - m_i0 := 0; - m_j0 := 0; - - strPosition := GetPosition; - FDoHandler(cbePosSet, @strPosition, self); - - for i := 0 to m_lstLayers.Count - 1 do - TChessBoardLayerBase(m_lstLayers[i]).ROnAfterSetPosition; -end; - - -procedure TChessBoard.FormCreate(Sender: TObject); -begin - // m_iDeltaWidthHeight := Width - Height; - - m_BitmapRes := TBitmapRes.Create(Size(PBoxBoard.Width, PBoxBoard.Height)); - - coord_show:= TRUE; - last_hilight:= FALSE; - m_animation := aQuick; - - m_ChessRulesEngine := TChessRulesEngine.Create(self); - m_lstLayers := TList.Create; -end; - - -procedure TChessBoard.FormDestroy(Sender: TObject); -var - _fig: TFigure; - i: integer; -begin - for i := m_lstLayers.Count - 1 downto 0 do - RemoveLayer(m_lstLayers[i]); - m_lstLayers.Free; - - m_ChessRulesEngine.Free; - - m_bmHiddenBoard.Free; - m_bmBuf.Free; - - for _fig := Low(TFigure) to High(TFigure) do - m_bmFigure[_fig].Free; - m_bmChessBoard.Free; - - m_BitmapRes.Free; -end; - - -procedure TChessBoard.PBoxBoardDragDrop(Sender, Source: TObject; X, - Y: Integer); -var - i, j: Integer; -begin - FWhatSquare(Point(X, Y), i, j); - case m_Mode of - mGame, mAnalyse: - begin - if (FDoMove(i, j)) then - m_bDraggedMoved := TRUE; - end; - - mEdit: - m_bDraggedMoved := TRUE; - end; -end; - - -procedure TChessBoard.FWhatSquare(const P: TPoint; - var i: Integer; var j: Integer); -begin - with P do - begin - i := (X - CHB_X + m_iSquareSize) div m_iSquareSize; - j := 8 - (Y - CHB_Y) div m_iSquareSize; - if (_flipped) then - begin - i := 9 - i; - j := 9 - j; - end; - end; -end; - - -function TChessBoard.FDoMove(i, j: integer; prom_fig: TFigureName = K): boolean; -begin - Result := m_ChessRulesEngine.DoMove(m_i0, m_j0, i, j, prom_fig); - if (Result) then - FOnAfterMoveDone; -end; - - -procedure TChessBoard.PBoxBoardDragOver(Sender, Source: TObject; X, - Y: Integer; State: TDragState; var Accept: Boolean); -var - rect: TRect; - i, j: integer; -begin - case State of - dsDragEnter: - m_bHilighted := FALSE; - - dsDragMove: - begin - // Repaint a fragment on m_bmHiddenBoard - m_bmHiddenBoard.Canvas.Draw(x0 - dx, y0 - dy, m_bmBuf); - // Copy new fragment to the buffer - m_bmBuf.Canvas.CopyRect(Bounds(0, 0, m_iSquareSize, m_iSquareSize), - m_bmHiddenBoard.Canvas, Bounds(X - dx, Y - dy, m_iSquareSize, m_iSquareSize)); - // Draw the dragging piece in a new position - m_bmHiddenBoard.Canvas.Draw(X - dx, Y - dy, m_bmFigure[m_fig]); - // Copy the new fragment to the screen - rect:= Bounds(Min(x0,X) - dx, Min(y0, Y) - dy, - abs(X - x0) + m_iSquareSize, abs(Y - y0) + m_iSquareSize); - PBoxBoard.Canvas.CopyRect(rect, m_bmHiddenBoard.Canvas, rect); - - x0 := X; - y0 := Y; - - FWhatSquare(Point(X,Y), i, j); - - Accept := ((i in [1..8]) and (j in [1..8])); - end; - end; -end; - - -procedure TChessBoard.PBoxBoardEndDrag(Sender, Target: TObject; X, Y: Integer); -var - i, j: integer; - bRes: boolean; -begin - case m_Mode of - mGame, mAnalyse: - begin - if (m_bHilighted) then - begin - with m_bmHiddenBoard.Canvas do - begin - Pen.Color:= HILIGHT_COLOR; - Pen.Width := HILIGHT_WIDTH; - x0:= x0 - dx; - y0:= y0 - dy; - MoveTo(x0,y0); - LineTo(x0 + m_iSquareSize - 1, y0); - LineTo(x0 + m_iSquareSize - 1, y0 + m_iSquareSize - 1); - LineTo(x0, y0 + m_iSquareSize - 1); - LineTo(x0, y0); - - PBoxBoardPaint(nil); - end; - end - else - begin - if (AnimateTimer.Enabled) then - AnimateTimer.Enabled := FALSE; - FDrawBoard; - if (m_bDraggedMoved) then - begin - HilightLastMove; - Evaluate; - m_bDraggedMoved := FALSE; - end; - end; - end; - - mEdit: - begin - if (m_bDraggedMoved) then - begin - FWhatSquare(Point(X, Y), i, j); - bRes := (((i <> m_i0) or (j <> m_j0)) and Position.SetPiece(i, j, m_fig)); - end - else - bRes := TRUE; - - if (bRes) then - begin - Position.SetPiece(m_i0, m_j0, ES); - FOnAfterSetPosition; - end; - - FDrawBoard; - end; - end; // case -end; - - -procedure TChessBoard.PBoxBoardMouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -var - i, j: Integer; - f: TFigure; -begin - if (Button <> mbLeft) then - exit; - - FWhatSquare(Point(X, Y), i, j); - if (not ((i in [1..8]) and (j in [1..8]))) then - exit; - - m_bDraggedMoved := FALSE; - - f := Position.board[i,j]; - - case m_Mode of - mGame, mAnalyse: - begin - if (m_bViewGaming) then - exit; - if ((Position.color <> m_PlayerColor) or - (((Position.color <> fcWhite) or (f >= ES)) and - ((Position.color <> fcBlack) or (f <= ES)))) then - exit; - - if ((i = m_i0) and (j = m_j0)) then - m_bHilighted := (m_bHilighted xor TRUE) - else - m_bHilighted := TRUE; - end; - - mEdit: - begin - if (f = ES) then - exit; - end; - - else - exit; - end; - - if (m_iAnimStep < m_iAnimStepsCount) then - FEndAnimation; - - m_fig := f; - m_i0 := i; - m_j0 := j; - - dx := (X - CHB_X) mod m_iSquareSize; - dy := (Y - CHB_Y) mod m_iSquareSize; - x0 := X; - y0 := Y; - - m_bDraggedMoved := TRUE; - PBoxBoard.BeginDrag(FALSE); -end; - - -procedure TChessBoard.PBoxBoardMouseMove(Sender: TObject; Shift: TShiftState; - X, Y: Integer); -var - f: TFigure; - i,j: Integer; -begin - FWhatSquare(Point(X,Y), i,j); - if (not ((i in [1..8]) and (j in [1..8]))) then - begin - PBoxBoard.Cursor:= crDefault; - exit; - end; - - f := Position.board[i,j]; - - case m_Mode of - mGame, mAnalyse: - begin - if (m_bViewGaming) then - exit; - - if (m_PlayerColor = Position.color) and - (((Position.color = fcWhite) and (f < ES)) or - ((Position.color = fcBlack) and (f > ES))) then - PBoxBoard.Cursor:= crHandPoint - else - PBoxBoard.Cursor:= crDefault; - end; - - mEdit: - begin - if (f <> ES) then - PBoxBoard.Cursor:= crHandPoint - else - PBoxBoard.Cursor:= crDefault; - end; - - else - PBoxBoard.Cursor := crDefault; - end; -end; - - -function TChessBoard.FGetPositionsList: TList; -begin - Result := m_ChessRulesEngine.PositionsList; -end; - - -function TChessBoard.FGetColorStarts: TFigureColor; -begin - Result := m_ChessRulesEngine.GetColorStarts; -end; - - -procedure TChessBoard.PBoxBoardMouseUp(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); -var - i, j: integer; -begin - case Button of - mbLeft: - begin - case m_Mode of - mGame, mAnalyse: - begin - if (not m_bHilighted) then - exit; - FWhatSquare(Point(X, Y), i, j); - if (m_bDraggedMoved) then - FDrawBoard - else - begin - m_bHilighted := FALSE; - if (FDoMove(i, j)) then - FAnimate(i, j) - else - FDrawBoard; - end; - end; - - mEdit: - begin - if (m_bDraggedMoved) then - exit; - // Assert(empty field) - FWhatSquare(Point(X, Y), i, j); - if (Position.SetPiece(i, j, m_EditPiece)) then - begin - FOnAfterSetPosition; - FDrawBoard; - end; - end; - - end; // case - end; - - mbRight: - begin - FDoHandler(cbeMenu, self); - end; - - end; -end; - - -procedure TChessBoard.PBoxBoardStartDrag(Sender: TObject; - var DragObject: TDragObject); -begin - // Copy image of an empty square to m_bmBuf - m_bmBuf.Width := m_iSquareSize; - m_bmBuf.Height:= m_iSquareSize; - if (((m_i0 + m_j0) and 1) <> 0) then - m_bmBuf.Canvas.CopyRect(Bounds(0,0, m_iSquareSize, m_iSquareSize), - m_bmFigure[ES].Canvas, Bounds(0,0, m_iSquareSize, m_iSquareSize)) - else - m_bmBuf.Canvas.CopyRect(Bounds(0,0, m_iSquareSize, m_iSquareSize), - m_bmFigure[ES].Canvas, Bounds(m_iSquareSize,0, m_iSquareSize, m_iSquareSize)); - - m_bDraggedMoved := FALSE; -end; - - -procedure TChessBoard.InitPosition; -begin - m_ChessRulesEngine.InitNewGame; - - FCancelAnimationDragging; - FOnAfterSetPosition; - - FDrawBoard; -end; - - -procedure TChessBoard.PPRandom; -begin - m_ChessRulesEngine.InitNewPPRandomGame; - - FCancelAnimationDragging; - FOnAfterSetPosition; - - FDrawBoard; -end; - - -procedure TChessBoard.TakeBack; -begin - if (m_Mode = mEdit) then - exit; - - if (not m_ChessRulesEngine.TakeBack) then - exit; - - FOnAfterSetPosition; - // TODO: animation - FDrawBoard; -end; - - -function TChessBoard.NMoveDone: integer; -begin - Result := m_ChessRulesEngine.NMovesDone; -end; - - -function TChessBoard.NPlysDone: integer; -begin - Result := m_ChessRulesEngine.NPlysDone; -end; - - -function TChessBoard.FGetMovesOffset: integer; -begin - Result := m_ChessRulesEngine.MovesOffset; -end; - - -function TChessBoard.FGetPositionColor: TFigureColor; -begin - Result := Position.color; -end; - - -procedure TChessBoard.FormCanResize(Sender: TObject; var NewWidth, - NewHeight: Integer; var Resize: Boolean); -var - NewBoardSize: TSize; -begin - if (not m_bDeltaWidthHeightFlag) then - begin - m_iDeltaWidthHeight := Width - Height; - m_bDeltaWidthHeightFlag := TRUE; - end; - - Resize := (m_ResizingType <> rtNo); - if (not Resize) then - exit; - - if (m_ResizingType = rtVert) then - NewWidth := NewHeight + m_iDeltaWidthHeight - else // rtHoriz - NewHeight := NewWidth - m_iDeltaWidthHeight; - - NewBoardSize := m_BitmapRes.GetOptimalBoardSize( - Size(PBoxBoard.Width + (NewWidth - Width), PBoxBoard.Height + (NewHeight - Height))); - - Resize := (NewBoardSize.cx > 0) and (NewBoardSize.cy > 0) and - ((NewBoardSize.cx <> PBoxBoard.Width) or (NewBoardSize.cy <> PBoxBoard.Height)); - if (Resize) then - begin - NewWidth := Width + (NewBoardSize.cx - PBoxBoard.Width); - NewHeight := Height + (NewBoardSize.cy - PBoxBoard.Height); - end; -end; - - -procedure TChessBoard.FormResize(Sender: TObject); -var - _fig: TFigure; -begin - FreeAndNil(m_bmChessBoard); - m_BitmapRes.CreateBoardBitmap(Size(PBoxBoard.Width, PBoxBoard.Height), self.Color, - m_bmChessBoard); - m_iSquareSize := m_BitmapRes.SquareSize; - - for _fig := Low(TFigure) to High(TFigure) do - begin - FreeAndNil(m_bmFigure[_fig]); - m_BitmapRes.CreateFigureBitmap(_fig, m_bmFigure[_fig]); - end; - - // Graphics initialization - if (not Assigned(m_bmHiddenBoard)) then - begin - m_bmHiddenBoard := Graphics.TBitmap.Create; - m_bmHiddenBoard.Palette := m_bmChessBoard.Palette; - m_bmHiddenBoard.Canvas.Font := PBoxBoard.Font; // Характеристики шрифта координат задаются в инспекторе - m_bmHiddenBoard.Canvas.Brush.Style := bsClear; - end; - m_bmHiddenBoard.Width := m_bmChessBoard.Width; - m_bmHiddenBoard.Height := m_bmChessBoard.Height; - - if (not Assigned(m_bmBuf)) then - begin - m_bmBuf := Graphics.TBitmap.Create; - m_bmBuf.Palette:= m_bmChessBoard.Palette; - end; - - FDrawBoard; -end; - - -procedure TChessBoard.WMSizing(var Msg: TMessage); -begin - case Msg.WParam of - WMSZ_RIGHT, WMSZ_LEFT, WMSZ_BOTTOMRIGHT, WMSZ_TOPLEFT: - m_ResizingType := rtHoriz; - WMSZ_BOTTOM, WMSZ_TOP: - m_ResizingType := rtVert; - else - begin - m_ResizingType := rtNo; - PRect(Msg.LParam).Left := Left; - PRect(Msg.LParam).Top := Top; - end; - end; // case -end; - - -procedure TChessBoard.FDoHandler(e: TChessBoardEvent; d1: pointer = nil; d2: pointer = nil); -begin - if (Assigned(FHandler)) then - FHandler(e, d1, d2); -end; - - -function TChessBoard.FGetMoveNotationFormat: TMoveNotationFormat; -begin - Result := m_ChessRulesEngine.MoveNotationFormat; -end; - - -procedure TChessBoard.FSetMoveNotationFormat(Value: TMoveNotationFormat); -begin - m_ChessRulesEngine.MoveNotationFormat := Value; -end; - - -function TChessBoard.FGetFENFormat: boolean; -begin - Result := m_ChessRulesEngine.FENFormat; -end; - - -procedure TChessBoard.FSetFENFormat(bValue: boolean); -begin - m_ChessRulesEngine.FENFormat := bValue; -end; - - -procedure TChessBoard.BeginUpdate; -begin - inc(m_iUpdateCounter); -end; - - -procedure TChessBoard.EndUpdate; -begin - if (m_iUpdateCounter > 0) then - begin - dec(m_iUpdateCounter); - if (m_iUpdateCounter = 0) then - FDrawBoard; - end; -end; - - -procedure TChessBoard.FOnDrawLayerUpdate(const ADrawLayer: TChessBoardLayerBase); -begin - if (not AnimateTimer.Enabled) then - FDrawBoard; -end; - - -procedure TChessBoard.AddLayer(const ALayer: TChessBoardLayerBase); -begin - if (m_lstLayers.IndexOf(ALayer) >= 0) then - exit; - - ALayer.ChessBoard := self; - m_lstLayers.Add(ALayer); - - FOnDrawLayerUpdate(ALayer); -end; - - -procedure TChessBoard.RemoveLayer(const ALayer: TChessBoardLayerBase); -begin - if (m_lstLayers.Remove(ALayer) >= 0) then - begin - ALayer.ChessBoard := nil; - - FOnDrawLayerUpdate(ALayer); - end; -end; - - -function TChessBoard.IsMoveAnimating: boolean; -begin - Result := AnimateTimer.Enabled; -end; - -//////////////////////////////////////////////////////////////////////////////// -// TChessBoardDrawBase - -procedure TChessBoardLayerBase.RDoUpdate; -begin - if (Assigned(m_ChessBoard)) then - m_ChessBoard.FOnDrawLayerUpdate(self); -end; - - -function TChessBoardLayerBase.FGetSquareSize: integer; -begin - if (Assigned(m_ChessBoard)) then - Result := m_ChessBoard.SquareSize - else - Result := 0; -end; - - -function TChessBoardLayerBase.FGetCanvas: TCanvas; -begin - if (Assigned(m_ChessBoard)) then - Result := m_ChessBoard.FGetHiddenBoardCanvas - else - Result := nil; -end; - - -function TChessBoardLayerBase.FGetPosition: PChessPosition; -begin - if (Assigned(m_ChessBoard)) then - Result := m_ChessBoard.Position - else - Result := nil; -end; - - -function TChessBoardLayerBase.RGetColorStarts: TFigureColor; -begin - if (Assigned(m_ChessBoard)) then - Result := m_ChessBoard.FGetColorStarts - else - Result := fcWhite; -end; - - -function TChessBoardLayerBase.FGetPositionsList: TList; -begin - if (Assigned(m_ChessBoard)) then - Result := m_ChessBoard.PositionsList - else - Result := nil; -end; - - -procedure TChessBoardLayerBase.ROnAfterMoveDone; -begin -end; - - -procedure TChessBoardLayerBase.ROnAfterSetPosition; -begin -end; - - -procedure TChessBoardLayerBase.ROnAfterModeSet(const OldValue, NewValue: TMode); -begin -end; - - -procedure TChessBoardLayerBase.ROnResetMoveList; -begin -end; - -end. -- cgit v1.2.3