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);