unit chessdrawer; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Controls, Graphics, LCLType, IntfGraphics, fpimage, Math, chessgame, chessconfig; 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 public procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual; abstract; procedure HandleMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual; abstract; procedure HandleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual; abstract; end; { TChessDrawer } TChessDrawer = class(TCustomControl) private imgBoard, imgWPawn, imgWKnight, imgWBishop, imgWRook, imgWQueen, imgWKing, imgBPawn, imgBKnight, imgBBishop, imgBRook, imgBQueen, imgBKing: TPortableNetworkGraphic; { bmpBoard, bmpWPawn, bmpWKnight, bmpWBishop, bmpWRook, bmpWQueen, bmpWKing, bmpBPawn, bmpBKnight, bmpBBishop, bmpBRook, bmpBQueen, bmpBKing: TBitmap;} FDrawerState: TDrawerState; FDelegate: TChessDrawerDelegate; FAnimation: TChessAnimation; public constructor Create(AOwner: TComponent); override; procedure EraseBackground(DC: HDC); override; procedure Paint; override; procedure DrawToCanvas(ACanvas: TCanvas); procedure DrawImageWithTransparentColor( ADest: TLazIntfImage; const ADestX, ADestY: Integer; AColor: TFPColor; AImage: TFPImageBitmap); function GetChessTileImage(ATile: TChessTile): TPortableNetworkGraphic; procedure LoadImages(); 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; var vChessDrawer: TChessDrawer; implementation { TChessMoveAnimation } procedure TChessMoveAnimation.DrawToIntfImg(AIntfImg: TLazIntfImage); var lTileBmp: TPortableNetworkGraphic; X, Y, SourceX, SourceY, DestX, DestY: integer; dx, dy: Integer; t: Double; lTile: TChessTile; begin // Draw the moving tile //WriteLn(Format('[TChessMoveAnimation.DrawToIntfImg] Afrom=%d,%d', [AFrom.X, AFrom.Y])); lTile := vChessGame.Board[AFrom.X][AFrom.Y]; lTileBmp := vChessDrawer.GetChessTileImage(lTile); 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); begin inherited Create(AOwner); imgBoard := TPortableNetworkGraphic.Create; imgWPawn := TPortableNetworkGraphic.Create; imgWKnight := TPortableNetworkGraphic.Create; imgWBishop := TPortableNetworkGraphic.Create; imgWRook := TPortableNetworkGraphic.Create; imgWQueen := TPortableNetworkGraphic.Create; imgWKing := TPortableNetworkGraphic.Create; imgBPawn := TPortableNetworkGraphic.Create; imgBKnight := TPortableNetworkGraphic.Create; imgBBishop := TPortableNetworkGraphic.Create; imgBRook := TPortableNetworkGraphic.Create; imgBQueen := TPortableNetworkGraphic.Create; imgBKing := TPortableNetworkGraphic.Create; { bmpBoard := TBitmap.Create; bmpWPawn := TBitmap.Create; bmpWKnight := TBitmap.Create; bmpWBishop := TBitmap.Create; bmpWRook := TBitmap.Create; bmpWQueen := TBitmap.Create; bmpWKing := TBitmap.Create; bmpBPawn := TBitmap.Create; bmpBKnight := TBitmap.Create; bmpBBishop := TBitmap.Create; bmpBRook := TBitmap.Create; bmpBQueen := TBitmap.Create; bmpBKing := TBitmap.Create; } // Events OnMouseMove := @HandleMouseMove; OnMouseUp := @HandleMouseUp; OnMouseDown := @HandleMouseDown; end; procedure TChessDrawer.EraseBackground(DC: HDC); begin // Uncomment this to enable default background erasing //inherited EraseBackground(DC); end; procedure TChessDrawer.Paint; var x, y: integer; Bitmap: TBitmap; begin Bitmap := TBitmap.Create; try // Initializes the Bitmap Size Bitmap.Height := Height; Bitmap.Width := Width; DrawToCanvas(Bitmap.Canvas); Canvas.Draw(0, 0, Bitmap); finally Bitmap.Free; end; // inherited Paint; end; procedure TChessDrawer.DrawToCanvas(ACanvas: TCanvas); var col, row: integer; lIntfImage: TLazIntfImage; lTmpBmp: TBitmap; lTileBmp: TPortableNetworkGraphic; X, Y: integer; begin lIntfImage := TLazIntfImage.Create(0, 0); lTmpBmp := TBitmap.Create; try // First draw the board lIntfImage.LoadFromBitmap(imgBoard.Handle, 0{bmpBoard.MaskHandle}); // Now all pieces for col := 1 to 8 do for row := 1 to 8 do 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]); if lTileBmp = nil then Continue; X := (col - 1) * INT_CHESSTILE_SIZE; Y := (8 - row) * INT_CHESSTILE_SIZE; DrawImageWithTransparentColor(lIntfImage, X, Y, FPCOLOR_TRANSPARENT_TILE, lTileBmp); end; // Now animations if Assigned(FAnimation) then FAnimation.DrawToIntfImg(lIntfImage); lTmpBmp.LoadFromIntfImage(lIntfImage); ACanvas.Draw(0, 0, lTmpBmp); finally lTmpBmp.Free; lIntfImage.Free; end; end; procedure TChessDrawer.DrawImageWithTransparentColor(ADest: TLazIntfImage; const ADestX, ADestY: Integer; AColor: TFPColor; AImage: TFPImageBitmap); var x, y, CurX, CurY: Integer; IntfImage: TLazIntfImage; lDrawWidth, lDrawHeight: Integer; CurColor: TFPColor; lCurColorDiv, lTranspColorDiv: Byte; begin IntfImage := TLazIntfImage.Create(0,0); try IntfImage.LoadFromBitmap(AImage.Handle, AImage.MaskHandle); // Take care not to draw outside the destination area lDrawWidth := Min(ADest.Width - ADestX, AImage.Width); lDrawHeight := Min(ADest.Height - ADestY, AImage.Height); for y := 0 to lDrawHeight - 1 do begin for x := 0 to lDrawWidth - 1 do begin CurX := ADestX + x; CurY := ADestY + y; // Never draw outside the destination if (CurX < 0) or (CurY < 0) then Continue; CurColor := IntfImage.Colors[x, y]; // Good for debugging lCurColorDiv := CurColor.Green div $FF; lTranspColorDiv := AColor.Green div $FF; if lCurColorDiv <> lTranspColorDiv then ADest.Colors[CurX, CurY] := IntfImage.Colors[x, y]; end; end; finally IntfImage.Free; end; end; function TChessDrawer.GetChessTileImage(ATile: TChessTile): TPortableNetworkGraphic; begin case ATile of ctWPawn: Result := imgWPawn; ctWKnight: Result := imgWKnight; ctWBishop: Result := imgWBishop; ctWRook: Result := imgWRook; ctWQueen: Result := imgWQueen; ctWKing: Result := imgWKing; ctBPawn: Result := imgBPawn; ctBKnight: Result := imgBKnight; ctBBishop: Result := imgBBishop; ctBRook: Result := imgBRook; ctBQueen: Result := imgBQueen; ctBKing: Result := imgBKing; else Result := nil; end; end; procedure TChessDrawer.LoadImages(); var lDir: string; begin lDir := vChessConfig.GetCurrentSkinDir(); imgBoard.LoadFromFile(lDir + 'base.png'); imgWPawn.LoadFromFile(lDir + 'wpawn.png'); imgWKnight.LoadFromFile(lDir + 'wknight.png'); imgWBishop.LoadFromFile(lDir + 'wbishop.png'); imgWRook.LoadFromFile(lDir + 'wrook.png'); imgWQueen.LoadFromFile(lDir + 'wqueen.png'); imgWKing.LoadFromFile(lDir + 'wking.png'); imgBPawn.LoadFromFile(lDir + 'bpawn.png'); imgBKnight.LoadFromFile(lDir + 'bknight.png'); imgBBishop.LoadFromFile(lDir + 'bbishop.png'); imgBRook.LoadFromFile(lDir + 'brook.png'); imgBQueen.LoadFromFile(lDir + 'bqueen.png'); imgBKing.LoadFromFile(lDir + 'bking.png'); { bmpWKnight.Assign(imgWKnight); bmpWKnight.Assign(imgWBishop); bmpWKnight.Assign(imgWRook); bmpWKnight.Assign(imgWQueen); bmpWKnight.Assign(imgWKing); bmpWKnight.Assign(imgBPawn); bmpWKnight.Assign(imgBKnight); bmpWKnight.Assign(imgBBishop); bmpWKnight.Assign(imgBRook); bmpWKnight.Assign(imgBQueen); bmpWKnight.Assign(imgBKing); } end; procedure TChessDrawer.SetDelegate(ADelegate: TChessDrawerDelegate); begin FDelegate := ADelegate; end; 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.