diff --git a/applications/fpchess/chessdrawer.pas b/applications/fpchess/chessdrawer.pas
index 4da457dd2..9e875edb2 100644
--- a/applications/fpchess/chessdrawer.pas
+++ b/applications/fpchess/chessdrawer.pas
@@ -11,6 +11,15 @@ uses
type
+ 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)
@@ -31,6 +40,7 @@ type
AImage: TFPImageBitmap);
function GetChessTileImage(ATile: TChessTile): TPortableNetworkGraphic;
procedure LoadImages();
+ procedure SetDelegate(ADelegate: TChessDrawerDelegate);
end;
var
@@ -224,5 +234,13 @@ begin
bmpWKnight.Assign(imgBKing); }
end;
+procedure TChessDrawer.SetDelegate(ADelegate: TChessDrawerDelegate);
+begin
+ // Events
+ OnMouseMove := @ADelegate.HandleMouseMove;
+ OnMouseUp := @ADelegate.HandleMouseUp;
+ OnMouseDown := @ADelegate.HandleMouseDown;
+end;
+
end.
diff --git a/applications/fpchess/chessgame.pas b/applications/fpchess/chessgame.pas
index 841ce54a2..08e109a0e 100644
--- a/applications/fpchess/chessgame.pas
+++ b/applications/fpchess/chessgame.pas
@@ -29,6 +29,11 @@ type
ctBPawn, ctBKnight, ctBBishop, ctBRook, ctBQueen, ctBKing
);
+const
+ WhitePieces = [ctWPawn, ctWKnight, ctWBishop, ctWRook, ctWQueen, ctWKing];
+ BlackPieces = [ctBPawn, ctBKnight, ctBBishop, ctBRook, ctBQueen, ctBKing];
+
+type
{@@
The index [1][1] refers to the left-bottom corner of the table,
also known as A1.
@@ -42,8 +47,14 @@ type
TChessGame = class
public
Board: TChessBoard;
+ CurrentPlayerIsWhite: Boolean;
+ Dragging: Boolean;
+ DragStart, MouseMovePos: TPoint;
procedure StartNewGame(APlayAsWhite: Boolean); overload;
procedure StartNewGame(APlayAsWhite: Integer); overload;
+ function ClientToBoardCoords(AClientCoords: TPoint): TPoint;
+ function CheckStartMove(AFrom: TPoint): Boolean;
+ function MovePiece(AFrom, ATo: TPoint): Boolean;
end;
var
@@ -59,6 +70,8 @@ var
i: Integer;
j: Integer;
begin
+ CurrentPlayerIsWhite := True;
+
//
if APlayAsWhite then
begin
@@ -114,6 +127,45 @@ begin
StartNewGame(APlayAsWhite = 0);
end;
+{
+ Returns: If the move is valid and was executed
+}
+function TChessGame.MovePiece(AFrom, ATo: TPoint): Boolean;
+begin
+ Result := False;
+
+ if not CheckStartMove(AFrom) then Exit;
+
+ // Parameter checking
+ if (AFrom.X < 1) or (AFrom.X > 8) or (ATo.X < 1) or (ATo.X > 8) then Exit;
+ if (AFrom.Y < 1) or (AFrom.Y > 8) or (ATo.Y < 1) or (ATo.Y > 8) then Exit;
+
+ // col, row
+ Board[ATo.X][ATo.Y] := Board[AFrom.X][AFrom.Y];
+ Board[AFrom.X][AFrom.Y] := ctEmpty;
+
+ CurrentPlayerIsWhite := not CurrentPlayerIsWhite;
+
+ Result := True;
+end;
+
+function TChessGame.ClientToBoardCoords(AClientCoords: TPoint): TPoint;
+begin
+ Result.X := 1 + AClientCoords.X div INT_CHESSTILE_SIZE;
+ Result.Y := 1 + (INT_CHESSBOARD_SIZE - AClientCoords.Y) div INT_CHESSTILE_SIZE;
+end;
+
+{@@
+ AFrom - The start move position in board coordinates
+}
+function TChessGame.CheckStartMove(AFrom: TPoint): Boolean;
+begin
+ if CurrentPlayerIsWhite then
+ Result := Board[AFrom.X][AFrom.Y] in WhitePieces
+ else
+ Result := Board[AFrom.X][AFrom.Y] in BlackPieces;
+end;
+
initialization
vChessGame := TChessGame.Create;
diff --git a/applications/fpchess/fpchess.lpi b/applications/fpchess/fpchess.lpi
index cf3c18874..54b3de982 100644
--- a/applications/fpchess/fpchess.lpi
+++ b/applications/fpchess/fpchess.lpi
@@ -36,7 +36,7 @@
-
+
@@ -46,9 +46,9 @@
-
-
-
+
+
+
@@ -123,10 +123,12 @@
+
-
-
-
+
+
+
+
@@ -163,9 +165,9 @@
-
-
-
+
+
+
@@ -222,9 +224,9 @@
-
-
-
+
+
+
@@ -235,7 +237,7 @@
-
+
@@ -280,119 +282,133 @@
-
-
-
+
-
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/applications/fpchess/mainform.lfm b/applications/fpchess/mainform.lfm
index e127f5898..43c973f30 100644
--- a/applications/fpchess/mainform.lfm
+++ b/applications/fpchess/mainform.lfm
@@ -1,19 +1,19 @@
object formChess: TformChess
Left = 181
- Height = 300
+ Height = 433
Top = 209
Width = 240
Caption = 'FP Chess 0.1'
- ClientHeight = 300
+ ClientHeight = 433
ClientWidth = 240
OnCreate = FormCreate
LCLVersion = '0.9.29'
object notebookMain: TUntabbedNotebook
Left = 0
- Height = 300
+ Height = 433
Top = 0
Width = 240
- PageIndex = 0
+ PageIndex = 3
Align = alClient
TabOrder = 0
TabStop = True
@@ -111,8 +111,8 @@ object formChess: TformChess
end
end
object pageConfigConnection: TUNBPage
- ClientWidth = 240
- ClientHeight = 300
+ ClientWidth = 480
+ ClientHeight = 600
object Label3: TLabel
Left = 0
Height = 32
@@ -176,8 +176,8 @@ object formChess: TformChess
end
end
object pageConnecting: TUNBPage
- ClientWidth = 240
- ClientHeight = 300
+ ClientWidth = 480
+ ClientHeight = 600
object Label4: TLabel
Left = 0
Height = 32
@@ -200,7 +200,7 @@ object formChess: TformChess
end
object pageGame: TUNBPage
ClientWidth = 240
- ClientHeight = 300
+ ClientHeight = 433
object Label5: TLabel
Left = 0
Height = 32
@@ -213,6 +213,14 @@ object formChess: TformChess
ParentColor = False
ParentFont = False
end
+ object labelPos: TLabel
+ Left = 8
+ Height = 14
+ Top = 392
+ Width = 40
+ Caption = 'labelPos'
+ ParentColor = False
+ end
end
end
end
diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas
index 4cbcf13c0..54b09c157 100644
--- a/applications/fpchess/mainform.pas
+++ b/applications/fpchess/mainform.pas
@@ -5,13 +5,24 @@ unit mainform;
interface
uses
- Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
- ComCtrls, StdCtrls, Buttons,
+ Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
+ ExtCtrls, ComCtrls, StdCtrls, Buttons,
//
chessdrawer, chessgame, chessconfig;
type
+ { TFormDrawerDelegate }
+
+ TFormDrawerDelegate = class(TChessDrawerDelegate)
+ public
+ procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); override;
+ procedure HandleMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer); override;
+ procedure HandleMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer); override;
+ end;
+
{ TformChess }
TformChess = class(TForm)
@@ -26,6 +37,7 @@ type
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
+ labelPos: TLabel;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
editPlayerName: TLabeledEdit;
@@ -41,10 +53,12 @@ type
{ private declarations }
public
{ public declarations }
+ procedure UpdateCaptions;
end;
var
formChess: TformChess;
+ vFormDrawerDelegate: TFormDrawerDelegate;
implementation
@@ -62,6 +76,17 @@ begin
else if Sender = btnDirectComm then notebookMain.PageIndex := 1;
end;
+procedure TformChess.UpdateCaptions;
+var
+ CurPlayerStr: string;
+begin
+ if vChessGame.CurrentPlayerIsWhite then CurPlayerStr := 'White playing'
+ else CurPlayerStr := 'Black playing';
+
+ formChess.labelPos.Caption := Format(CurPlayerStr + ' X: %d Y: %d',
+ [vChessGame.MouseMovePos.X, vChessGame.MouseMovePos.Y]);
+end;
+
procedure TformChess.FormCreate(Sender: TObject);
begin
// Creation of internal components
@@ -71,10 +96,56 @@ begin
vChessDrawer.Left := 20;
vChessDrawer.Height := INT_CHESSBOARD_SIZE;
vChessDrawer.Width := INT_CHESSBOARD_SIZE;
+ vChessDrawer.SetDelegate(vFormDrawerDelegate);
// Loading of resources
vChessDrawer.LoadImages();
end;
+{ TFormDrawerDelegate }
+
+procedure TFormDrawerDelegate.HandleMouseMove(Sender: TObject;
+ Shift: TShiftState; X, Y: Integer);
+begin
+ vChessGame.MouseMovePos := vChessGame.ClientToBoardCoords(Point(X, Y));
+ formChess.UpdateCaptions;
+end;
+
+procedure TFormDrawerDelegate.HandleMouseUp(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+var
+ lCoords: TPoint;
+begin
+ vChessGame.Dragging := False;
+
+ lCoords := vChessGame.ClientToBoardCoords(Point(X, Y));
+ if not vChessGame.MovePiece(vChessGame.DragStart, lCoords) then Exit;
+
+ vChessDrawer.Invalidate;
+ formChess.UpdateCaptions;
+end;
+
+procedure TFormDrawerDelegate.HandleMouseDown(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+var
+ lCoords: TPoint;
+begin
+ lCoords := vChessGame.ClientToBoardCoords(Point(X, Y));
+ if not vChessGame.CheckStartMove(lCoords) then Exit;
+
+ vChessGame.Dragging := True;
+ vChessGame.DragStart := lCoords;
+ vChessDrawer.Invalidate;
+ formChess.UpdateCaptions;
+end;
+
+initialization
+
+ vFormDrawerDelegate := TFormDrawerDelegate.Create;
+
+finalization
+
+ vFormDrawerDelegate.Free;
+
end.
diff --git a/applications/fpchess/skins/classic/base.png b/applications/fpchess/skins/classic/base.png
index 3d11fe471..11a7c2464 100644
Binary files a/applications/fpchess/skins/classic/base.png and b/applications/fpchess/skins/classic/base.png differ