paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpchess is now playable in hotseat mode

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1327 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat 2010-09-23 15:40:21 +00:00
parent 5898609891
commit 7fad6b83aa
4 changed files with 192 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
applications/fpchess/chessgame.pas
View File

@ -5,7 +5,7 @@ unit chessgame;
interface
uses
Classes, SysUtils, fpimage;
Classes, SysUtils, fpimage, dateutils;
const
colA = 1;
@ -50,11 +50,17 @@ type
CurrentPlayerIsWhite: Boolean;
Dragging: Boolean;
DragStart, MouseMovePos: TPoint;
procedure StartNewGame(APlayAsWhite: Boolean); overload;
procedure StartNewGame(APlayAsWhite: Integer); overload;
UseTimer: Boolean;
WhitePlayerTime: Integer; // milisseconds
BlackPlayerTime: Integer; // milisseconds
MoveStartTime: TDateTime;
constructor Create;
procedure StartNewGame(APlayAsWhite: Boolean; AUseTimer: Boolean; APlayerTime: Integer); overload;
procedure StartNewGame(APlayAsWhite: Integer; AUseTimer: Boolean; APlayerTime: Integer); overload;
function ClientToBoardCoords(AClientCoords: TPoint): TPoint;
function CheckStartMove(AFrom: TPoint): Boolean;
function MovePiece(AFrom, ATo: TPoint): Boolean;
procedure UpdateTimes();
end;
var
@ -64,13 +70,24 @@ implementation
{ TChessGame }
procedure TChessGame.StartNewGame(APlayAsWhite: Boolean);
constructor TChessGame.Create;
begin
inherited Create;
end;
procedure TChessGame.StartNewGame(APlayAsWhite: Boolean; AUseTimer: Boolean; APlayerTime: Integer);
var
lWPawnRow, lWMainRow, lBPawnRow, lBMainRow: Byte;
i: Integer;
j: Integer;
begin
UseTimer := AUseTimer;
CurrentPlayerIsWhite := True;
WhitePlayerTime := APlayerTime * 60 * 1000; // minutes to milisseconds
BlackPlayerTime := APlayerTime * 60 * 1000; // minutes to milisseconds
MoveStartTime := Now;
//
if APlayAsWhite then
@ -122,9 +139,9 @@ begin
Board[8][lBMainRow] := ctBRook;
end;
procedure TChessGame.StartNewGame(APlayAsWhite: Integer);
procedure TChessGame.StartNewGame(APlayAsWhite: Integer; AUseTimer: Boolean; APlayerTime: Integer);
begin
StartNewGame(APlayAsWhite = 0);
StartNewGame(APlayAsWhite = 0, AUseTimer, APlayerTime);
end;
{
@ -144,11 +161,26 @@ begin
Board[ATo.X][ATo.Y] := Board[AFrom.X][AFrom.Y];
Board[AFrom.X][AFrom.Y] := ctEmpty;
UpdateTimes();
CurrentPlayerIsWhite := not CurrentPlayerIsWhite;
Result := True;
end;
procedure TChessGame.UpdateTimes();
var
lNow: TDateTime;
lTimeDelta: Integer;
begin
lNow := Now;
lTimeDelta := MilliSecondsBetween(lNow, MoveStartTime);
MoveStartTime := lNow;
if CurrentPlayerIsWhite then WhitePlayerTime := WhitePlayerTime - lTimeDelta
else BlackPlayerTime := BlackPlayerTime - lTimeDelta;
end;
function TChessGame.ClientToBoardCoords(AClientCoords: TPoint): TPoint;
begin
Result.X := 1 + AClientCoords.X div INT_CHESSTILE_SIZE;

114
applications/fpchess/fpchess.lpi
View File

@ -36,7 +36,7 @@
<Filename Value="fpchess.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fpchess"/>
<UsageCount Value="37"/>
<UsageCount Value="38"/>
</Unit0>
<Unit1>
<Filename Value="mainform.pas"/>
@ -44,11 +44,12 @@
<ComponentName Value="formChess"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mainform"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="108"/>
<CursorPos X="26" Y="122"/>
<UsageCount Value="37"/>
<TopLine Value="92"/>
<CursorPos X="61" Y="104"/>
<UsageCount Value="38"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
@ -127,7 +128,7 @@
<WindowIndex Value="0"/>
<TopLine Value="305"/>
<CursorPos X="61" Y="320"/>
<UsageCount Value="18"/>
<UsageCount Value="19"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
@ -165,9 +166,9 @@
<UnitName Value="chessdrawer"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="17"/>
<TopLine Value="1"/>
<CursorPos X="3" Y="25"/>
<UsageCount Value="35"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit16>
<Unit17>
@ -221,12 +222,11 @@
<Filename Value="chessgame.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="chessgame"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="130"/>
<CursorPos X="42" Y="137"/>
<UsageCount Value="27"/>
<TopLine Value="1"/>
<CursorPos X="40" Y="8"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
</Unit23>
<Unit24>
@ -237,7 +237,7 @@
<WindowIndex Value="0"/>
<TopLine Value="18"/>
<CursorPos X="13" Y="39"/>
<UsageCount Value="27"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
</Unit24>
<Unit25>
@ -290,124 +290,124 @@
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="chessdrawer.pas"/>
<Caret Line="237" Column="8" TopLine="212"/>
<Filename Value="mainform.pas"/>
<Caret Line="112" Column="1" TopLine="103"/>
</Position1>
<Position2>
<Filename Value="..\..\..\lazarussvn\lcl\controls.pp"/>
<Caret Line="1232" Column="30" TopLine="1218"/>
<Filename Value="mainform.pas"/>
<Caret Line="122" Column="1" TopLine="103"/>
</Position2>
<Position3>
<Filename Value="chessdrawer.pas"/>
<Caret Line="238" Column="44" TopLine="212"/>
<Filename Value="mainform.pas"/>
<Caret Line="123" Column="1" TopLine="103"/>
</Position3>
<Position4>
<Filename Value="mainform.pas"/>
<Caret Line="21" Column="71" TopLine="5"/>
<Caret Line="121" Column="43" TopLine="104"/>
</Position4>
<Position5>
<Filename Value="chessgame.pas"/>
<Caret Line="49" Column="40" TopLine="34"/>
<Filename Value="mainform.pas"/>
<Caret Line="123" Column="1" TopLine="104"/>
</Position5>
<Position6>
<Filename Value="chessgame.pas"/>
<Caret Line="151" Column="1" TopLine="135"/>
<Caret Line="157" Column="15" TopLine="143"/>
</Position6>
<Position7>
<Filename Value="chessgame.pas"/>
<Caret Line="54" Column="15" TopLine="39"/>
<Filename Value="mainform.pas"/>
<Caret Line="56" Column="29" TopLine="33"/>
</Position7>
<Position8>
<Filename Value="mainform.pas"/>
<Caret Line="127" Column="1" TopLine="111"/>
<Caret Line="85" Column="1" TopLine="82"/>
</Position8>
<Position9>
<Filename Value="mainform.pas"/>
<Caret Line="109" Column="14" TopLine="95"/>
<Caret Line="87" Column="57" TopLine="72"/>
</Position9>
<Position10>
<Filename Value="mainform.pas"/>
<Caret Line="114" Column="14" TopLine="100"/>
<Caret Line="56" Column="29" TopLine="47"/>
</Position10>
<Position11>
<Filename Value="chessdrawer.pas"/>
<Caret Line="47" Column="21" TopLine="33"/>
<Filename Value="mainform.pas"/>
<Caret Line="79" Column="36" TopLine="79"/>
</Position11>
<Position12>
<Filename Value="mainform.pas"/>
<Caret Line="114" Column="14" TopLine="100"/>
<Caret Line="111" Column="3" TopLine="97"/>
</Position12>
<Position13>
<Filename Value="mainform.pas"/>
<Caret Line="117" Column="43" TopLine="100"/>
<Caret Line="122" Column="26" TopLine="108"/>
</Position13>
<Position14>
<Filename Value="mainform.pas"/>
<Caret Line="111" Column="1" TopLine="100"/>
<Caret Line="123" Column="26" TopLine="109"/>
</Position14>
<Position15>
<Filename Value="mainform.pas"/>
<Caret Line="112" Column="1" TopLine="100"/>
<Caret Line="124" Column="26" TopLine="110"/>
</Position15>
<Position16>
<Filename Value="chessgame.pas"/>
<Caret Line="133" Column="1" TopLine="119"/>
<Filename Value="mainform.pas"/>
<Caret Line="122" Column="29" TopLine="111"/>
</Position16>
<Position17>
<Filename Value="chessgame.pas"/>
<Caret Line="136" Column="1" TopLine="119"/>
<Filename Value="mainform.pas"/>
<Caret Line="77" Column="24" TopLine="72"/>
</Position17>
<Position18>
<Filename Value="mainform.pas"/>
<Caret Line="112" Column="1" TopLine="103"/>
<Filename Value="chessgame.pas"/>
<Caret Line="53" Column="16" TopLine="41"/>
</Position18>
<Position19>
<Filename Value="mainform.pas"/>
<Caret Line="122" Column="1" TopLine="103"/>
<Filename Value="chessgame.pas"/>
<Caret Line="125" Column="49" TopLine="125"/>
</Position19>
<Position20>
<Filename Value="mainform.pas"/>
<Caret Line="123" Column="1" TopLine="103"/>
<Filename Value="chessgame.pas"/>
<Caret Line="54" Column="15" TopLine="53"/>
</Position20>
<Position21>
<Filename Value="mainform.pas"/>
<Caret Line="121" Column="43" TopLine="104"/>
<Caret Line="77" Column="24" TopLine="72"/>
</Position21>
<Position22>
<Filename Value="mainform.pas"/>
<Caret Line="123" Column="1" TopLine="104"/>
<Caret Line="78" Column="22" TopLine="73"/>
</Position22>
<Position23>
<Filename Value="chessgame.pas"/>
<Caret Line="157" Column="15" TopLine="143"/>
<Caret Line="56" Column="24" TopLine="42"/>
</Position23>
<Position24>
<Filename Value="mainform.pas"/>
<Caret Line="56" Column="29" TopLine="33"/>
<Filename Value="chessgame.pas"/>
<Caret Line="63" Column="14" TopLine="43"/>
</Position24>
<Position25>
<Filename Value="mainform.pas"/>
<Caret Line="85" Column="1" TopLine="82"/>
<Caret Line="78" Column="22" TopLine="73"/>
</Position25>
<Position26>
<Filename Value="mainform.pas"/>
<Caret Line="87" Column="57" TopLine="72"/>
<Caret Line="80" Column="22" TopLine="75"/>
</Position26>
<Position27>
<Filename Value="mainform.pas"/>
<Caret Line="56" Column="29" TopLine="47"/>
<Filename Value="chessgame.pas"/>
<Caret Line="175" Column="3" TopLine="32"/>
</Position27>
<Position28>
<Filename Value="mainform.pas"/>
<Caret Line="79" Column="36" TopLine="79"/>
<Filename Value="chessgame.pas"/>
<Caret Line="172" Column="14" TopLine="158"/>
</Position28>
<Position29>
<Filename Value="mainform.pas"/>
<Caret Line="111" Column="3" TopLine="97"/>
<Filename Value="chessgame.pas"/>
<Caret Line="178" Column="14" TopLine="163"/>
</Position29>
<Position30>
<Filename Value="mainform.pas"/>
<Caret Line="122" Column="26" TopLine="108"/>
<Caret Line="107" Column="60" TopLine="90"/>
</Position30>
</JumpHistory>
</ProjectOptions>

97
applications/fpchess/mainform.lfm
View File

@ -2,29 +2,29 @@ object formChess: TformChess
Left = 181
Height = 433
Top = 209
Width = 240
Width = 360
Caption = 'FP Chess 0.1'
ClientHeight = 433
ClientWidth = 240
ClientWidth = 360
OnCreate = FormCreate
LCLVersion = '0.9.29'
object notebookMain: TUntabbedNotebook
Left = 0
Height = 433
Top = 0
Width = 240
PageIndex = 3
Width = 360
PageIndex = 0
Align = alClient
TabOrder = 0
TabStop = True
object pageStart: TUNBPage
ClientWidth = 240
ClientHeight = 300
ClientWidth = 360
ClientHeight = 433
object Label1: TLabel
Left = 0
Height = 32
Top = 8
Width = 240
Width = 360
Alignment = taCenter
AutoSize = False
Caption = 'Welcome to FP Chess 0.1'
@ -36,51 +36,52 @@ object formChess: TformChess
Left = 8
Height = 30
Top = 40
Width = 224
Width = 352
AutoSize = False
Caption = 'Please choose what kind of game you would like to play:'
ParentColor = False
WordWrap = True
end
object btnSinglePlayer: TBitBtn
Left = 8
Left = 64
Height = 30
Top = 152
Top = 200
Width = 224
Caption = 'Play Against the Computer'
Enabled = False
OnClick = HandleMainScreenButton
TabOrder = 0
end
object btnDirectComm: TBitBtn
Left = 8
Left = 62
Height = 30
Top = 184
Top = 288
Width = 226
Caption = 'Play with a friend through a direct connection'
OnClick = HandleMainScreenButton
TabOrder = 1
end
object BitBtn3: TBitBtn
Left = 8
Left = 64
Height = 30
Top = 232
Top = 336
Width = 224
Caption = 'Quit'
TabOrder = 2
end
object editPlayerName: TLabeledEdit
Left = 104
Left = 88
Height = 21
Top = 80
Top = 72
Width = 120
EditLabel.AnchorSideLeft.Control = editPlayerName
EditLabel.AnchorSideTop.Control = editPlayerName
EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = editPlayerName
EditLabel.AnchorSideBottom.Control = editPlayerName
EditLabel.Left = 40
EditLabel.Left = 24
EditLabel.Height = 14
EditLabel.Top = 83
EditLabel.Top = 75
EditLabel.Width = 61
EditLabel.Caption = 'Player Name'
EditLabel.ParentColor = False
@ -88,17 +89,17 @@ object formChess: TformChess
TabOrder = 3
end
object Label6: TLabel
Left = 21
Left = 28
Height = 14
Top = 112
Top = 104
Width = 43
Caption = 'Start as:'
ParentColor = False
end
object comboStartColor: TComboBox
Left = 104
Left = 88
Height = 21
Top = 111
Top = 104
Width = 120
ItemHeight = 13
ItemIndex = 0
@ -109,10 +110,45 @@ object formChess: TformChess
TabOrder = 4
Text = 'White'
end
object checkTimer: TCheckBox
Left = 24
Height = 17
Top = 136
Width = 163
Caption = 'Set a time limit for each Player'
Checked = True
State = cbChecked
TabOrder = 5
end
object spinPlayerTime: TSpinEdit
Left = 21
Height = 21
Top = 160
Width = 50
TabOrder = 6
Value = 30
end
object Label7: TLabel
Left = 80
Height = 14
Top = 163
Width = 114
Caption = 'minutes for each player'
ParentColor = False
end
object btnHotSeat: TBitBtn
Left = 64
Height = 30
Top = 240
Width = 224
Caption = 'Play with a friend in the same Computer'
OnClick = HandleMainScreenButton
TabOrder = 7
end
end
object pageConfigConnection: TUNBPage
ClientWidth = 480
ClientHeight = 600
ClientWidth = 960
ClientHeight = 1200
object Label3: TLabel
Left = 0
Height = 32
@ -176,8 +212,8 @@ object formChess: TformChess
end
end
object pageConnecting: TUNBPage
ClientWidth = 480
ClientHeight = 600
ClientWidth = 960
ClientHeight = 1200
object Label4: TLabel
Left = 0
Height = 32
@ -199,8 +235,8 @@ object formChess: TformChess
end
end
object pageGame: TUNBPage
ClientWidth = 240
ClientHeight = 433
ClientWidth = 480
ClientHeight = 866
object Label5: TLabel
Left = 0
Height = 32
@ -223,4 +259,9 @@ object formChess: TformChess
end
end
end
object timerChessTimer: TTimer
OnTimer = timerChessTimerTimer
left = 296
top = 152
end
end

34
applications/fpchess/mainform.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
ExtCtrls, ComCtrls, StdCtrls, Buttons,
ExtCtrls, ComCtrls, StdCtrls, Buttons, Spin,
//
chessdrawer, chessgame, chessconfig;
@ -30,6 +30,8 @@ type
btnSinglePlayer: TBitBtn;
btnDirectComm: TBitBtn;
BitBtn3: TBitBtn;
btnHotSeat: TBitBtn;
checkTimer: TCheckBox;
comboStartColor: TComboBox;
Label1: TLabel;
Label2: TLabel;
@ -37,6 +39,7 @@ type
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
labelPos: TLabel;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
@ -47,8 +50,11 @@ type
pageConnecting: TUNBPage;
ProgressBar1: TProgressBar;
pageGame: TUNBPage;
spinPlayerTime: TSpinEdit;
timerChessTimer: TTimer;
procedure FormCreate(Sender: TObject);
procedure HandleMainScreenButton(Sender: TObject);
procedure timerChessTimerTimer(Sender: TObject);
private
{ private declarations }
public
@ -71,20 +77,36 @@ begin
if Sender = btnSinglePlayer then
begin
notebookMain.PageIndex := 3;
vChessGame.StartNewGame(comboStartColor.ItemIndex);
vChessGame.StartNewGame(comboStartColor.ItemIndex, checkTimer.Checked, spinPlayerTime.Value);
end
else if Sender = btnHotSeat then
begin
notebookMain.PageIndex := 3;
vChessGame.StartNewGame(comboStartColor.ItemIndex, checkTimer.Checked, spinPlayerTime.Value);
end
else if Sender = btnDirectComm then notebookMain.PageIndex := 1;
end;
procedure TformChess.timerChessTimerTimer(Sender: TObject);
begin
vChessGame.UpdateTimes();
UpdateCaptions();
end;
procedure TformChess.UpdateCaptions;
var
CurPlayerStr: string;
lStr: string;
begin
if vChessGame.CurrentPlayerIsWhite then CurPlayerStr := 'White playing'
else CurPlayerStr := 'Black playing';
if vChessGame.CurrentPlayerIsWhite then lStr := 'White playing'
else lStr := 'Black playing';
formChess.labelPos.Caption := Format(CurPlayerStr + ' X: %d Y: %d',
lStr := lStr + Format(' X: %d Y: %d',
[vChessGame.MouseMovePos.X, vChessGame.MouseMovePos.Y]);
lStr := lStr + Format(' White time: %d Black time: %d',
[vChessGame.WhitePlayerTime, vChessGame.BlackPlayerTime]);
formChess.labelPos.Caption := lStr;
end;
procedure TformChess.FormCreate(Sender: TObject);