fpchess: Improves the timer

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1554 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2011-04-07 06:57:02 +00:00
parent 27ae008cc6
commit 54c7e64160
4 changed files with 84 additions and 40 deletions
--- a/applications/fpchess/chessgame.pas
+++ b/applications/fpchess/chessgame.pas
@ -27,7 +27,7 @@ const
 type

  TPacketKind = (pkConnect, pkStartGameClientAsWhite, pkStartGameClientAsBlack, pkMove);
-  BitBoard = array[1..8] of array [1..8] of boolean;
+  BitBoard = array[1..8] of array [1..8] of boolean;// Map of attacked squares

  { TPacket }

@ -371,16 +371,18 @@ ShowMessage(mensagem);}
 end;
 function TChessGame.ValidateKnightMove(AFrom, ATo: TPoint): Boolean;
 begin
-result:=true;
+  Result := True;
 end;
+
 function TChessGame.ValidateBishopMove(AFrom, ATo: TPoint): Boolean;
-var AttackedSquares : BitBoard;
-    i,j : Integer;
-    x,y : integer;
-    haveCaptured: boolean = false; //already have captured a piece
-    willBeACapture : boolean = false;// the movement will be a capture
-    validMove : boolean = false; //if the piece in the 'to' square is not of the same color of the player
-    mensagem : String;
+var
+  AttackedSquares : BitBoard;
+  i,j : Integer;
+  x,y : integer;
+  haveCaptured: boolean = false; //already have captured a piece
+  willBeACapture : boolean = false;// the movement will be a capture
+  validMove : boolean = false; //if the piece in the 'to' square is not of the same color of the player
+  mensagem : String;
 begin
  for i:=1 to 8 do  // initialize the bitboard of attacked pieces.
    for j:=1 to 8 do
--- a/applications/fpchess/fpchess.lpi
+++ b/applications/fpchess/fpchess.lpi
@ -30,16 +30,20 @@
        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
      </local>
    </RunParams>
-    <RequiredPackages Count="3">
+    <RequiredPackages Count="4">
      <Item1>
-        <PackageName Value="laz_synapse"/>
+        <PackageName Value="LCLBase"/>
+        <MinVersion Major="1" Release="1" Valid="True"/>
      </Item1>
      <Item2>
-        <PackageName Value="wst_synapse"/>
+        <PackageName Value="laz_synapse"/>
      </Item2>
      <Item3>
-        <PackageName Value="LCL"/>
+        <PackageName Value="wst_synapse"/>
      </Item3>
+      <Item4>
+        <PackageName Value="LCL"/>
+      </Item4>
    </RequiredPackages>
    <Units Count="11">
      <Unit0>
--- a/applications/fpchess/mainform.lfm
+++ b/applications/fpchess/mainform.lfm
@ -14,7 +14,7 @@ object formChess: TformChess
    Height = 433
    Top = 0
    Width = 360
-    PageIndex = 0
+    PageIndex = 3
    Align = alClient
    TabOrder = 0
    TabStop = True
@ -45,17 +45,17 @@ object formChess: TformChess
      end
      object Label6: TLabel
        Left = 28
-        Height = 18
+        Height = 17
        Top = 104
-        Width = 56
+        Width = 52
        Caption = 'Start as:'
        ParentColor = False
      end
      object Label7: TLabel
        Left = 80
-        Height = 18
+        Height = 17
        Top = 163
-        Width = 152
+        Width = 150
        Caption = 'minutes for each player'
        ParentColor = False
      end
@ -89,7 +89,7 @@ object formChess: TformChess
      end
      object editPlayerName: TLabeledEdit
        Left = 88
-        Height = 25
+        Height = 22
        Top = 72
        Width = 120
        EditLabel.AnchorSideLeft.Control = editPlayerName
@ -97,10 +97,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 = 75
-        EditLabel.Width = 83
+        EditLabel.Width = 79
        EditLabel.Caption = 'Player Name'
        EditLabel.ParentColor = False
        LabelPosition = lpLeft
@ -108,7 +108,7 @@ object formChess: TformChess
      end
      object comboStartColor: TComboBox
        Left = 88
-        Height = 27
+        Height = 21
        Top = 104
        Width = 120
        ItemHeight = 0
@ -122,9 +122,9 @@ object formChess: TformChess
      end
      object checkTimer: TCheckBox
        Left = 24
-        Height = 21
+        Height = 18
        Top = 136
-        Width = 220
+        Width = 212
        Caption = 'Set a time limit for each Player'
        Checked = True
        State = cbChecked
@ -132,7 +132,7 @@ object formChess: TformChess
      end
      object spinPlayerTime: TSpinEdit
        Left = 21
-        Height = 25
+        Height = 16
        Top = 160
        Width = 50
        TabOrder = 6
@ -158,8 +158,8 @@ object formChess: TformChess
      end
    end
    object pageConfigConnection: TPage
-      ClientWidth = 712
-      ClientHeight = 810
+      ClientWidth = 1424
+      ClientHeight = 1620
      object Label3: TLabel
        Left = 0
        Height = 32
@ -222,8 +222,8 @@ object formChess: TformChess
      end
    end
    object pageConnecting: TPage
-      ClientWidth = 712
-      ClientHeight = 810
+      ClientWidth = 1424
+      ClientHeight = 1620
      object Label4: TLabel
        Left = 0
        Height = 32
@ -245,8 +245,8 @@ object formChess: TformChess
      end
    end
    object pageGame: TPage
-      ClientWidth = 712
-      ClientHeight = 810
+      ClientWidth = 360
+      ClientHeight = 433
      object Label5: TLabel
        Left = 0
        Height = 32
@ -261,16 +261,24 @@ object formChess: TformChess
      end
      object labelPos: TLabel
        Left = 8
-        Height = 14
+        Height = 17
        Top = 392
-        Width = 40
+        Width = 53
        Caption = 'labelPos'
        ParentColor = False
      end
+      object labelTime: TLabel
+        Left = 8
+        Height = 17
+        Top = 408
+        Width = 62
+        Caption = 'labelTime'
+        ParentColor = False
+      end
    end
    object pageWebservice: TPage
-      ClientWidth = 712
-      ClientHeight = 810
+      ClientWidth = 1424
+      ClientHeight = 1620
      object Label8: TLabel
        Left = 0
        Height = 32
@ -300,7 +308,7 @@ object formChess: TformChess
        EditLabel.Caption = 'Player Name'
        EditLabel.ParentColor = False
        LabelPosition = lpLeft
-        TabOrder = 0
+        TabOrder = 2
        Text = 'http://www.bobswart.nl/cgi-bin/ChessISAPIServer.dll/wsdl/IDelphiChess'
      end
      object btnPlayAgainstAI: TButton
--- a/applications/fpchess/mainform.pas
+++ b/applications/fpchess/mainform.pas
@ -37,7 +37,9 @@ type
    btnPlayAgainstAI: TButton;
    checkTimer: TCheckBox;
    comboStartColor: TComboBox;
+    editWebserviceURL: TLabeledEdit;
    Label1: TLabel;
+    labelTime: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
@ -68,6 +70,7 @@ type
    procedure timerChessTimerTimer(Sender: TObject);
  private
    { private declarations }
+    function FormatTime(ATimeInMiliseconds: Integer): string;
  public
    { public declarations }
    procedure UpdateCaptions;
@ -121,6 +124,31 @@ begin
  UpdateCaptions();
 end;

+function TformChess.FormatTime(ATimeInMiliseconds: Integer): string;
+var
+  lTimePart: Integer;
+begin
+  Result := '';
+
+  // Hours
+  lTimePart := ATimeInMiliseconds div (60*60*1000);
+  if lTimePart > 0 then
+    Result := IntToStr(lTimePart) + 'h';
+
+  // Minutes
+  lTimePart := (ATimeInMiliseconds div (60*1000)) mod 60;
+  if (lTimePart > 0) or (Result <> '') then
+    Result := Result + IntToStr(lTimePart) + 'm';
+
+  // Seconds
+  lTimePart := (ATimeInMiliseconds div (1000)) mod 60;
+  Result := Result + IntToStr(lTimePart) + 's';
+
+  // Miliseconds
+  lTimePart := ATimeInMiliseconds mod (1000);
+  Result := Result + IntToStr(lTimePart);
+end;
+
 procedure TformChess.UpdateCaptions;
 var
  lStr: string;
@ -131,10 +159,12 @@ begin
  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;
+
+  lStr := Format('White time: %s Black time: %s',
+    [FormatTime(vChessGame.WhitePlayerTime), FormatTime(vChessGame.BlackPlayerTime)]);
+
+  formChess.labelTime.Caption := lStr;
 end;

 procedure TformChess.InitializeGameModel;