diff --git a/applications/fpchess/chessgame.pas b/applications/fpchess/chessgame.pas index 84563df85..47693382a 100644 --- a/applications/fpchess/chessgame.pas +++ b/applications/fpchess/chessgame.pas @@ -66,6 +66,7 @@ type end; TOnMoveCallback = procedure (AFrom, ATo: TPoint); + TPawnPromotionCallback = function (APawn: TChessTile): TChessTile of object; { TChessGame } @@ -86,6 +87,7 @@ type var AEnpassantSquare, AEnpassantSquareToClear: TPoint) : boolean; function ValidatePawnSimpleCapture(AFrom,ATo: TPoint): Boolean; function IsSquareOccupied(ASquare: TPoint): Boolean; + procedure doPromotion(Position: TPoint); public Board: TChessBoard; msg : String; @@ -108,6 +110,7 @@ type // Callbacks OnAfterMove: TOnMoveCallback; // For the modules OnBeforeMove: TOnMoveCallback; // For the UI + OnPawnPromotion: TPawnPromotionCallback; // constructor Create; procedure StartNewGame(APlayAsWhite: Boolean; AUseTimer: Boolean; APlayerTime: Integer); overload; @@ -261,6 +264,8 @@ begin DoMovePiece(AFrom, ATo, LEnpassantToClear); if Castle then DoCastle(); + if ((Board[ATo.X][Ato.Y]=ctWPawn) and (Ato.Y=8)) or ((Board[ATo.X][Ato.Y]=ctBPawn) and (ATo.Y=1)) then //If a pawn will be promoted + doPromotion(Ato); // UpdateTimes(); @@ -286,6 +291,17 @@ begin Board[AEnpassantToClear.X][AEnpassantToClear.Y] := ctEmpty; end; +procedure TChessGame.doPromotion(Position: TPoint); +var + lNewPiece: TChessTile; +begin + if Assigned(OnPawnPromotion) then + begin + lNewPiece := OnPawnPromotion(Board[position.X][position.Y]); + Board[position.X][position.Y] := lNewPiece; + end; +end; + procedure TChessGame.DoCastle(); begin if CastleCord.X=8 then diff --git a/applications/fpchess/fpchess.lpi b/applications/fpchess/fpchess.lpi index ee1af9e78..b3d73e057 100644 --- a/applications/fpchess/fpchess.lpi +++ b/applications/fpchess/fpchess.lpi @@ -68,7 +68,7 @@ - + @@ -144,6 +144,13 @@ + + + + + + + diff --git a/applications/fpchess/fpchess.lpr b/applications/fpchess/fpchess.lpr index 35732d8b3..3ce2b72c2 100644 --- a/applications/fpchess/fpchess.lpr +++ b/applications/fpchess/fpchess.lpr @@ -8,7 +8,8 @@ uses {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset Forms, lnetbase, mainform, chessdrawer, chessgame, chessconfig, - chesstcputils, chessmodules, mod_samecomputer, mod_fics, mod_kcchess + chesstcputils, chessmodules, mod_samecomputer, mod_fics, mod_kcchess, +selectPromotionPiece {$ifdef FPCHESS_WEBSERVICES} ,IDelphiChess_Intf {$endif}; @@ -18,6 +19,7 @@ uses begin Application.Initialize; Application.CreateForm(TformChess, formChess); + Application.CreateForm(TformPromotion, formPromotion); Application.Run; end. diff --git a/applications/fpchess/mainform.lfm b/applications/fpchess/mainform.lfm index 2867190ec..1c06dd46b 100644 --- a/applications/fpchess/mainform.lfm +++ b/applications/fpchess/mainform.lfm @@ -14,7 +14,7 @@ object formChess: TformChess Height = 500 Top = 0 Width = 360 - PageIndex = 1 + PageIndex = 0 Align = alClient TabOrder = 0 TabStop = True @@ -45,17 +45,17 @@ object formChess: TformChess end object Label6: TLabel Left = 28 - Height = 18 + Height = 17 Top = 128 - Width = 56 + Width = 52 Caption = 'Start as:' ParentColor = False end object Label7: TLabel Left = 80 - Height = 18 + Height = 17 Top = 175 - Width = 152 + Width = 150 Caption = 'minutes for each player' ParentColor = False end @@ -70,7 +70,7 @@ object formChess: TformChess end object editPlayerName: TLabeledEdit Left = 88 - Height = 25 + Height = 22 Top = 104 Width = 120 EditLabel.AnchorSideLeft.Control = editPlayerName @@ -78,10 +78,10 @@ object formChess: TformChess EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = editPlayerName EditLabel.AnchorSideBottom.Control = editPlayerName - EditLabel.Left = 2 - EditLabel.Height = 18 + EditLabel.Left = 6 + EditLabel.Height = 17 EditLabel.Top = 107 - EditLabel.Width = 83 + EditLabel.Width = 79 EditLabel.Caption = 'Player Name' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -89,7 +89,7 @@ object formChess: TformChess end object comboStartColor: TComboBox Left = 88 - Height = 27 + Height = 21 Top = 128 Width = 120 ItemHeight = 0 @@ -103,9 +103,9 @@ object formChess: TformChess end object checkTimer: TCheckBox Left = 24 - Height = 21 + Height = 18 Top = 152 - Width = 220 + Width = 212 Caption = 'Set a time limit for each Player' Checked = True State = cbChecked @@ -113,7 +113,7 @@ object formChess: TformChess end object spinPlayerTime: TSpinEdit Left = 21 - Height = 25 + Height = 16 Top = 176 Width = 50 TabOrder = 4 @@ -121,7 +121,7 @@ object formChess: TformChess end object comboGameMode: TComboBox Left = 8 - Height = 27 + Height = 21 Top = 74 Width = 346 ItemHeight = 0 @@ -140,7 +140,7 @@ object formChess: TformChess end object editLocalIP: TLabeledEdit Left = 120 - Height = 25 + Height = 22 Top = 200 Width = 120 EditLabel.AnchorSideLeft.Control = editLocalIP @@ -148,10 +148,10 @@ object formChess: TformChess EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = editLocalIP EditLabel.AnchorSideBottom.Control = editLocalIP - EditLabel.Left = 15 - EditLabel.Height = 18 + EditLabel.Left = 12 + EditLabel.Height = 17 EditLabel.Top = 203 - EditLabel.Width = 102 + EditLabel.Width = 105 EditLabel.Caption = 'Your IP Address:' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -169,8 +169,8 @@ object formChess: TformChess end end object pageGame: TPage - ClientWidth = 360 - ClientHeight = 500 + ClientWidth = 1440 + ClientHeight = 2000 object labelPos: TLabel Left = 8 Height = 18 @@ -238,8 +238,8 @@ object formChess: TformChess end end object pageWebservice: TPage - ClientWidth = 5760 - ClientHeight = 6928 + ClientWidth = 11520 + ClientHeight = 13856 object Label8: TLabel Left = 0 Height = 32 diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas index 986c53dd6..150b28ae3 100644 --- a/applications/fpchess/mainform.pas +++ b/applications/fpchess/mainform.pas @@ -1,3 +1,5 @@ +{ +} unit mainform; {$mode objfpc}{$H+} @@ -9,7 +11,7 @@ uses ExtCtrls, ComCtrls, StdCtrls, Buttons, Spin, // fpchess chessdrawer, chessgame, chessconfig, chesstcputils, - chessmodules; + chessmodules, selectpromotionpiece; type @@ -68,6 +70,7 @@ type { private declarations } function FormatTime(ATimeInMiliseconds: Integer): string; procedure UpdateChessModulesUI(ANewIndex: Integer); + function HandlePawnPromotion(APiece: TChessTile): TChessTile; public { public declarations } procedure UpdateCaptions; @@ -133,6 +136,19 @@ begin GetChessModule(ANewIndex).ShowUserInterface(panelModules); end; +function TformChess.HandlePawnPromotion(APiece: TChessTile): TChessTile; +var + dlgPromotion: TformPromotion; +begin + dlgPromotion := TformPromotion.Create(vChessGame.IsWhitePlayerTurn); + try + dlgPromotion.ShowModal; + finally + dlgPromotion.Free; + Result := selectPromotionPiece.pieceChosen; + end; +end; + procedure HandleOnMove(AFrom, ATo: TPoint); var lStr: String; @@ -196,8 +212,9 @@ begin end; gChessModulesDebugOutputDestiny := memoDebug; - // Prepare the move callback + // Prepare the callbacks vChessGame.OnBeforeMove := @HandleOnMove; + vChessGame.OnPawnPromotion := @HandlePawnPromotion; end; procedure TformChess.btnQuitClick(Sender: TObject);