Changeset 2 for trunk

Timestamp:

Dec 11, 2020, 11:42:27 PM (4 years ago)

Author:

chronos

Message:

• Added: Token movement animation.

Location:

trunk

Files:

• . (modified) (1 prop)
• Games/UClovece.pas (modified) (11 diffs)
• Packages/Common (modified) (1 prop)
• UFormMain.pas (modified) (4 diffs)

trunk/Games/UClovece.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Controls, UGame, fgl, UGraphics, UCanvas;
+  Classes, SysUtils, Controls, Forms, UGame, fgl, UGraphics, UCanvas;
 
 type
@@ -70 +70 @@
     NextTile: TTile;
     NextTileHome: TTile;
+    AnimateToken: TToken;
     function GetNext(Steps: Integer; Player: TPlayer): TTile;
+    procedure GetNextSteps(Steps: Integer; Player: TPlayer; Tiles: TTiles);
     procedure Paint(Canvas: TCanvas);
     property Owner: TPlayer read FOwner write SetOwner;
@@ -101 +103 @@
   private
     MetaCanvas: TMetaCanvas;
+    Processing: Boolean;
+    procedure AnimateTokenMovement(Token: TToken; NewTile: TTile);
   public
     Board: TBoard;
@@ -195 +199 @@
     end;
   end else Result := Self;
+end;
+
+procedure TTile.GetNextSteps(Steps: Integer; Player: TPlayer; Tiles: TTiles);
+begin
+  if Steps > 0 then begin
+    Tiles.Add(Self);
+    if Assigned(NextTileHome) and (NextTileHome.Owner = Player) then begin
+      NextTileHome.GetNextSteps(Steps - 1, Player, Tiles)
+    end else begin
+      if Assigned(NextTile) then NextTile.GetNextSteps(Steps - 1, Player, Tiles);
+    end;
+  end;
 end;
 
@@ -218 +234 @@
     );
   end;
+  if Assigned(AnimateToken) then begin
+    Canvas.Pen.Width := 5;
+    Canvas.Brush.Color := AnimateToken.Player.Color;
+    Canvas.Ellipse(
+      Position.X - TokenSize div 2,
+      Position.Y - TokenSize div 2,
+      Position.X + TokenSize div 2,
+      Position.Y + TokenSize div 2
+    );
+  end;
 end;
 
@@ -441 +467 @@
 
 { TClovece }
+
+procedure TClovece.AnimateTokenMovement(Token: TToken; NewTile: TTile);
+var
+  I: Integer;
+  Steps: TTiles;
+begin
+  Steps := TTiles.Create(False);
+  Token.Tile.GetNextSteps(DiceValue, CurrentPlayer, Steps);
+  Token.Tile := nil;
+  for I := 0 to Steps.Count - 1 do begin
+    Steps[I].AnimateToken := Token;
+    Repaint;
+    Application.ProcessMessages;
+    Sleep(200);
+    Steps[I].AnimateToken := nil;
+  end;
+  Steps.Free;
+  Token.Tile := NewTile;
+end;
 
 procedure TClovece.ThrowDice;
@@ -479 +524 @@
           // Move opponents token back to its yard
           NewTile.Token.Tile := NewTile.Token.Player.YardTiles.GetTileWithoutToken;
-          Token.Tile := NewTile;
+          AnimateTokenMovement(Token, NewTile);
           TurnDone := True;
           Break;
@@ -485 +530 @@
       end else begin
         // Normal token move
-        Token.Tile := NewTile;
+        AnimateTokenMovement(Token, NewTile);
         TurnDone := True;
         Break;
@@ -506 +551 @@
 procedure TClovece.MouseUp(Button: TMouseButton; Position: TPoint);
 begin
-  if State = gsRunning then
+  if (State = gsRunning) and not Processing then begin
+    Processing := True;
     ThrowDice;
+    Processing := False;
+  end;
 end;
 
@@ -551 +599 @@
 begin
   with Canvas do begin
+    Pen.Color := clBlack;
     Brush.Opacity := $ff;
     Brush.Color := clGray;
@@ -572 +621 @@
     Brush.Opacity := 0;
     Pen.Color := clBlack;
+    Brush.Style := bsSolid;
+    Brush.Color := CurrentPlayer.Color;
     TextOut(Point(0, 0), 'Player: ' + CurrentPlayer.Name);
+    Brush.Style := bsClear;
     TextOut(Point(0, 30), 'Dice: ' + IntToStr(DiceValue) + ' ' + IntToStr(LastDiceValue));
     TextOut(Point(0, 60), 'Throw: ' + IntToStr(DiceThrow));

trunk/UFormMain.pas

@@ -68 +68 @@
 procedure TGameCanvas.TextOut(const Pos: TPoint; Text: string);
 begin
-  if Brush.Opacity = 0 then Canvas.Brush.Style := Graphics.bsClear
+  if Brush.Style = bsClear then Canvas.Brush.Style := Graphics.bsClear
     else Canvas.Brush.Style := Graphics.bsSolid;
   Canvas.Brush.Color := Brush.Color;
@@ -77 +77 @@
 procedure TGameCanvas.Rectangle(const Rect: TRect);
 begin
-  //Canvas.Brush.Style := Brush.Style;
+  if Brush.Style = bsClear then Canvas.Brush.Style := Graphics.bsClear
+    else Canvas.Brush.Style := Graphics.bsSolid;
   Canvas.Brush.Color := Brush.Color;
-  //Canvas.Pen.Style := Pen.Style;
+  if Brush.Style = bsClear then Canvas.Pen.Style := Graphics.psClear
+    else Canvas.Pen.Style := Graphics.psSolid;
   Canvas.Pen.Color := Pen.Color;
   Canvas.FillRect(Rect);
@@ -86 +88 @@
 procedure TGameCanvas.Line(const P1, P2: TPoint);
 begin
+  if Brush.Style = bsClear then Canvas.Brush.Style := Graphics.bsClear
+    else Canvas.Brush.Style := Graphics.bsSolid;
+  Canvas.Brush.Color := Brush.Color;
+  if Brush.Style = bsClear then Canvas.Pen.Style := Graphics.psClear
+    else Canvas.Pen.Style := Graphics.psSolid;
+  Canvas.Pen.Color := Pen.Color;
   Canvas.Pen.Width := Pen.Width;
   Canvas.Line(P1, P2);
@@ -92 +100 @@
 procedure TGameCanvas.Ellipse(const Bounds: TRect);
 begin
+  if Brush.Style = bsClear then Canvas.Brush.Style := Graphics.bsClear
+    else Canvas.Brush.Style := Graphics.bsSolid;
+  Canvas.Brush.Color := Brush.Color;
+  if Brush.Style = bsClear then Canvas.Pen.Style := Graphics.psClear
+    else Canvas.Pen.Style := Graphics.psSolid;
+  Canvas.Pen.Color := Pen.Color;
   Canvas.Pen.Width := Pen.Width;
-  Canvas.Brush.Color := Brush.Color;
   Canvas.Ellipse(Bounds);
 end;