You've already forked lazarus-ccr
fpchess: Implements animations for the computer moves
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1897 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -11,6 +11,34 @@ uses
|
|||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
|
{
|
||||||
|
dsIdle - Accepts user input
|
||||||
|
dsDragging - During an user input
|
||||||
|
dsRunningAnimation - Does not accept user input because it is running an animation
|
||||||
|
}
|
||||||
|
TDrawerState = (dsIdle, dsDragging, dsRunningAnimation);
|
||||||
|
|
||||||
|
{ TChessAnimation }
|
||||||
|
|
||||||
|
TChessAnimation = class
|
||||||
|
CurrentStep: Integer;
|
||||||
|
FinalStep: Integer;
|
||||||
|
constructor Create;
|
||||||
|
procedure DrawToIntfImg(AIntfImg: TLazIntfImage); virtual; abstract;
|
||||||
|
procedure ExecuteFinal; virtual; abstract;
|
||||||
|
function SkipDrawingPiece(col, row: Integer): Boolean; virtual; abstract;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TChessMoveAnimation }
|
||||||
|
|
||||||
|
TChessMoveAnimation = class(TChessAnimation)
|
||||||
|
public
|
||||||
|
AFrom, ATo: TPoint;
|
||||||
|
procedure DrawToIntfImg(AIntfImg: TLazIntfImage); override;
|
||||||
|
procedure ExecuteFinal; override;
|
||||||
|
function SkipDrawingPiece(col, row: Integer): Boolean; override;
|
||||||
|
end;
|
||||||
|
|
||||||
TChessDrawerDelegate = class
|
TChessDrawerDelegate = class
|
||||||
public
|
public
|
||||||
procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual; abstract;
|
procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual; abstract;
|
||||||
@ -30,6 +58,9 @@ type
|
|||||||
{ bmpBoard, bmpWPawn, bmpWKnight, bmpWBishop, bmpWRook, bmpWQueen,
|
{ bmpBoard, bmpWPawn, bmpWKnight, bmpWBishop, bmpWRook, bmpWQueen,
|
||||||
bmpWKing, bmpBPawn, bmpBKnight, bmpBBishop, bmpBRook, bmpBQueen,
|
bmpWKing, bmpBPawn, bmpBKnight, bmpBBishop, bmpBRook, bmpBQueen,
|
||||||
bmpBKing: TBitmap;}
|
bmpBKing: TBitmap;}
|
||||||
|
FDrawerState: TDrawerState;
|
||||||
|
FDelegate: TChessDrawerDelegate;
|
||||||
|
FAnimation: TChessAnimation;
|
||||||
public
|
public
|
||||||
constructor Create(AOwner: TComponent); override;
|
constructor Create(AOwner: TComponent); override;
|
||||||
procedure EraseBackground(DC: HDC); override;
|
procedure EraseBackground(DC: HDC); override;
|
||||||
@ -41,6 +72,13 @@ type
|
|||||||
function GetChessTileImage(ATile: TChessTile): TPortableNetworkGraphic;
|
function GetChessTileImage(ATile: TChessTile): TPortableNetworkGraphic;
|
||||||
procedure LoadImages();
|
procedure LoadImages();
|
||||||
procedure SetDelegate(ADelegate: TChessDrawerDelegate);
|
procedure SetDelegate(ADelegate: TChessDrawerDelegate);
|
||||||
|
procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
||||||
|
procedure HandleMouseUp(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
procedure HandleMouseDown(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
procedure HandleOnTimer(Sender: TObject);
|
||||||
|
procedure AddAnimation(AAnimation: TChessAnimation);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -48,6 +86,50 @@ var
|
|||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
{ TChessMoveAnimation }
|
||||||
|
|
||||||
|
procedure TChessMoveAnimation.DrawToIntfImg(AIntfImg: TLazIntfImage);
|
||||||
|
var
|
||||||
|
lTileBmp: TPortableNetworkGraphic;
|
||||||
|
X, Y, SourceX, SourceY, DestX, DestY: integer;
|
||||||
|
dx, dy: Integer;
|
||||||
|
t: Double;
|
||||||
|
begin
|
||||||
|
// Draw the moving tile
|
||||||
|
lTileBmp := vChessDrawer.GetChessTileImage(vChessGame.Board[AFrom.X][AFrom.Y]);
|
||||||
|
if lTileBmp = nil then Exit;
|
||||||
|
|
||||||
|
SourceX := (AFrom.X - 1) * INT_CHESSTILE_SIZE;
|
||||||
|
SourceY := (8 - AFrom.Y) * INT_CHESSTILE_SIZE;
|
||||||
|
DestX := (ATo.X - 1) * INT_CHESSTILE_SIZE;
|
||||||
|
DestY := (8 - ATo.Y) * INT_CHESSTILE_SIZE;
|
||||||
|
t := CurrentStep / FinalStep;
|
||||||
|
X := Round(t * DestX + (1-t) * SourceX);
|
||||||
|
Y := Round(t * DestY + (1-t) * SourceY);
|
||||||
|
|
||||||
|
vChessDrawer.DrawImageWithTransparentColor(AIntfImg, X, Y, FPCOLOR_TRANSPARENT_TILE, lTileBmp);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChessMoveAnimation.ExecuteFinal;
|
||||||
|
begin
|
||||||
|
vChessGame.MovePiece(AFrom, ATo);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TChessMoveAnimation.SkipDrawingPiece(col, row: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
Result := (col = AFrom.X) and (row = AFrom.Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TChessAnimation }
|
||||||
|
|
||||||
|
constructor TChessAnimation.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
CurrentStep := 0;
|
||||||
|
FinalStep := 20;
|
||||||
|
end;
|
||||||
|
|
||||||
constructor TChessDrawer.Create(AOwner: TComponent);
|
constructor TChessDrawer.Create(AOwner: TComponent);
|
||||||
begin
|
begin
|
||||||
inherited Create(AOwner);
|
inherited Create(AOwner);
|
||||||
@ -79,6 +161,11 @@ begin
|
|||||||
bmpBRook := TBitmap.Create;
|
bmpBRook := TBitmap.Create;
|
||||||
bmpBQueen := TBitmap.Create;
|
bmpBQueen := TBitmap.Create;
|
||||||
bmpBKing := TBitmap.Create; }
|
bmpBKing := TBitmap.Create; }
|
||||||
|
|
||||||
|
// Events
|
||||||
|
OnMouseMove := @HandleMouseMove;
|
||||||
|
OnMouseUp := @HandleMouseUp;
|
||||||
|
OnMouseDown := @HandleMouseDown;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TChessDrawer.EraseBackground(DC: HDC);
|
procedure TChessDrawer.EraseBackground(DC: HDC);
|
||||||
@ -126,6 +213,9 @@ begin
|
|||||||
for col := 1 to 8 do
|
for col := 1 to 8 do
|
||||||
for row := 1 to 8 do
|
for row := 1 to 8 do
|
||||||
begin
|
begin
|
||||||
|
// Check if the animation wants us to skip drawing this piece
|
||||||
|
if Assigned(FAnimation) and FAnimation.SkipDrawingPiece(col, row) then Continue;
|
||||||
|
|
||||||
lTileBmp := GetChessTileImage(vChessGame.Board[col][row]);
|
lTileBmp := GetChessTileImage(vChessGame.Board[col][row]);
|
||||||
if lTileBmp = nil then Continue;
|
if lTileBmp = nil then Continue;
|
||||||
|
|
||||||
@ -135,6 +225,9 @@ begin
|
|||||||
DrawImageWithTransparentColor(lIntfImage, X, Y, FPCOLOR_TRANSPARENT_TILE, lTileBmp);
|
DrawImageWithTransparentColor(lIntfImage, X, Y, FPCOLOR_TRANSPARENT_TILE, lTileBmp);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
// Now animations
|
||||||
|
if Assigned(FAnimation) then FAnimation.DrawToIntfImg(lIntfImage);
|
||||||
|
|
||||||
lTmpBmp.LoadFromIntfImage(lIntfImage);
|
lTmpBmp.LoadFromIntfImage(lIntfImage);
|
||||||
ACanvas.Draw(0, 0, lTmpBmp);
|
ACanvas.Draw(0, 0, lTmpBmp);
|
||||||
finally
|
finally
|
||||||
@ -236,10 +329,50 @@ end;
|
|||||||
|
|
||||||
procedure TChessDrawer.SetDelegate(ADelegate: TChessDrawerDelegate);
|
procedure TChessDrawer.SetDelegate(ADelegate: TChessDrawerDelegate);
|
||||||
begin
|
begin
|
||||||
// Events
|
FDelegate := ADelegate;
|
||||||
OnMouseMove := @ADelegate.HandleMouseMove;
|
end;
|
||||||
OnMouseUp := @ADelegate.HandleMouseUp;
|
|
||||||
OnMouseDown := @ADelegate.HandleMouseDown;
|
procedure TChessDrawer.HandleMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||||
|
Y: Integer);
|
||||||
|
begin
|
||||||
|
if Assigned(FDelegate) and (FDrawerState in [dsIdle, dsDragging]) then
|
||||||
|
FDelegate.HandleMouseMove(Sender, Shift, X, Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChessDrawer.HandleMouseUp(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
begin
|
||||||
|
if Assigned(FDelegate) and (FDrawerState in [dsIdle, dsDragging]) then
|
||||||
|
FDelegate.HandleMouseUp(Sender, Button, Shift, X, Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChessDrawer.HandleMouseDown(Sender: TObject; Button: TMouseButton;
|
||||||
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
begin
|
||||||
|
if Assigned(FDelegate) and (FDrawerState in [dsIdle, dsDragging]) then
|
||||||
|
FDelegate.HandleMouseDown(Sender, Button, Shift, X, Y);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChessDrawer.HandleOnTimer(Sender: TObject);
|
||||||
|
begin
|
||||||
|
if FDrawerState = dsRunningAnimation then
|
||||||
|
begin
|
||||||
|
Inc(FAnimation.CurrentStep);
|
||||||
|
if FAnimation.CurrentStep >= FAnimation.FinalStep then
|
||||||
|
begin
|
||||||
|
FAnimation.ExecuteFinal;
|
||||||
|
FAnimation.Free;
|
||||||
|
FAnimation := nil;
|
||||||
|
FDrawerState := dsIdle;
|
||||||
|
end;
|
||||||
|
Invalidate();
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TChessDrawer.AddAnimation(AAnimation: TChessAnimation);
|
||||||
|
begin
|
||||||
|
FDrawerState := dsRunningAnimation;
|
||||||
|
FAnimation := AAnimation;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -12,7 +12,7 @@ interface
|
|||||||
uses
|
uses
|
||||||
Classes, SysUtils,
|
Classes, SysUtils,
|
||||||
StdCtrls, Forms, Controls,
|
StdCtrls, Forms, Controls,
|
||||||
chessgame, chessmodules;
|
chessgame, chessmodules, chessdrawer;
|
||||||
|
|
||||||
const HIGH = 52; WIDE = 52; SINGLE_IMAGE_SIZE = 1500;
|
const HIGH = 52; WIDE = 52; SINGLE_IMAGE_SIZE = 1500;
|
||||||
BOARD_SIZE = 8; ROW_NAMES = '12345678'; COL_NAMES = 'ABCDEFGH';
|
BOARD_SIZE = 8; ROW_NAMES = '12345678'; COL_NAMES = 'ABCDEFGH';
|
||||||
@ -282,6 +282,7 @@ var
|
|||||||
Escape: boolean;
|
Escape: boolean;
|
||||||
Score: Integer;
|
Score: Integer;
|
||||||
lMoved: Boolean;
|
lMoved: Boolean;
|
||||||
|
lAnimation: TChessMoveAnimation;
|
||||||
begin
|
begin
|
||||||
// initialization
|
// initialization
|
||||||
Escape := False;
|
Escape := False;
|
||||||
@ -310,12 +311,17 @@ begin
|
|||||||
|
|
||||||
{ And write it to our board }
|
{ And write it to our board }
|
||||||
|
|
||||||
lMoved := vChessGame.MovePiece(
|
lAnimation := TChessMoveAnimation.Create;
|
||||||
|
lAnimation.AFrom := Point(AIMovement.FromCol, AIMovement.FromRow);
|
||||||
|
lAnimation.ATo := Point(AIMovement.ToCol, AIMovement.ToRow);
|
||||||
|
vChessDrawer.AddAnimation(lAnimation);
|
||||||
|
|
||||||
|
{ lMoved := vChessGame.MovePiece(
|
||||||
Point(AIMovement.FromCol, AIMovement.FromRow),
|
Point(AIMovement.FromCol, AIMovement.FromRow),
|
||||||
Point(AIMovement.ToCol, AIMovement.ToRow));
|
Point(AIMovement.ToCol, AIMovement.ToRow));
|
||||||
|
|
||||||
if not lMoved then raise Exception.Create(Format('Moving failed from %s to %s',
|
if not lMoved then raise Exception.Create(Format('Moving failed from %s to %s',
|
||||||
[vChessGame.BoardPosToChessCoords(AFrom), vChessGame.BoardPosToChessCoords(ATo)]));
|
[vChessGame.BoardPosToChessCoords(AFrom), vChessGame.BoardPosToChessCoords(ATo)]));}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
|
@ -169,8 +169,8 @@ object formChess: TformChess
|
|||||||
end
|
end
|
||||||
end
|
end
|
||||||
object pageGame: TPage
|
object pageGame: TPage
|
||||||
ClientWidth = 1440
|
ClientWidth = 720
|
||||||
ClientHeight = 2000
|
ClientHeight = 1000
|
||||||
object labelPos: TLabel
|
object labelPos: TLabel
|
||||||
Left = 8
|
Left = 8
|
||||||
Height = 18
|
Height = 18
|
||||||
@ -313,6 +313,7 @@ object formChess: TformChess
|
|||||||
end
|
end
|
||||||
object timerChessTimer: TTimer
|
object timerChessTimer: TTimer
|
||||||
Enabled = False
|
Enabled = False
|
||||||
|
Interval = 50
|
||||||
OnTimer = timerChessTimerTimer
|
OnTimer = timerChessTimerTimer
|
||||||
left = 296
|
left = 296
|
||||||
top = 152
|
top = 152
|
||||||
|
@ -98,6 +98,7 @@ procedure TformChess.timerChessTimerTimer(Sender: TObject);
|
|||||||
begin
|
begin
|
||||||
vChessGame.UpdateTimes();
|
vChessGame.UpdateTimes();
|
||||||
UpdateCaptions();
|
UpdateCaptions();
|
||||||
|
vChessDrawer.HandleOnTimer(Sender);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TformChess.FormatTime(ATimeInMiliseconds: Integer): string;
|
function TformChess.FormatTime(ATimeInMiliseconds: Integer): string;
|
||||||
|
Reference in New Issue
Block a user