Changeset 12

Timestamp:

Oct 5, 2019, 12:48:02 AM (5 years ago)

Author:

chronos

Message:

• Added: Show wing dialog message if player gets cell with value 2048.

Location:

trunk

Files:

• Forms/UFormMain.pas (modified) (1 diff)
• Languages/Game2048.cs.po (modified) (1 diff)
• Languages/Game2048.po (modified) (1 diff)
• UCore.lfm (modified) (1 diff)
• UGame.pas (modified) (11 diffs)

trunk/Forms/UFormMain.pas

@@ -62 +62 @@
     if not Core.Game.CanMove and (Core.Game.GetEmptyCellsCount = 0) then
       Core.Game.GameOver;
+    if (not Core.Game.Won) and (Core.Game.GetHighestCellValue >= 2048) then
+      Core.Game.Win;
   end;
 end;

trunk/Languages/Game2048.cs.po

@@ -120 +120 @@
 msgstr "Verze"
 
-#: ugame.sgameover
-msgid "Game over"
-msgstr "Konec hry"
+#: ugame.sgameovercaption
+msgid "Lost"
+msgstr ""
 
+#: ugame.sgameovermessage
+msgid "Game over!"
+msgstr ""
+
+#: ugame.swincaption
+msgid "Win"
+msgstr ""
+
+#: ugame.swinmessage
+msgid "You won! Do you want to continue to play?"
+msgstr ""
+

trunk/Languages/Game2048.po

@@ -104 +104 @@
 msgstr ""
 
-#: ugame.sgameover
-msgid "Game over"
+#: ugame.sgameovercaption
+msgid "Lost"
 msgstr ""
 
+#: ugame.sgameovermessage
+msgid "Game over!"
+msgstr ""
+
+#: ugame.swincaption
+msgid "Win"
+msgstr ""
+
+#: ugame.swinmessage
+msgid "You won! Do you want to continue to play?"
+msgstr ""
+

trunk/UCore.lfm

@@ -28 +28 @@
     AppName = '2048'
     Description = 'Classic 2048 game.'
-    ReleaseDate = 43733
+    ReleaseDate = 43742
     RegistryKey = '\Software\Chronosoft\2048'
     RegistryRoot = rrKeyCurrentUser

trunk/UGame.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Dialogs, fgl, Graphics, Types, Forms, Math, DateUtils;
+  Classes, SysUtils, Dialogs, fgl, Graphics, Types, Forms, Math, DateUtils,
+  Controls;
 
 type
@@ -45 +46 @@
     TopScore: Integer;
     AnimationDuration: Integer;
+    Won: Boolean;
     procedure GameOver;
+    procedure Win;
     function FillRandomCell: Integer;
     function CanMove: Boolean;
     function GetEmptyCellsCount: Integer;
+    function GetHighestCellValue: Integer;
     procedure Assign(Source: TGame);
     procedure New;
@@ -71 +75 @@
 
 resourcestring
-  SGameOver = 'Game over';
+  SGameOverCaption = 'Lost';
+  SGameOverMessage = 'Game over!';
+  SWinCaption = 'Win';
+  SWinMessage = 'You won! Do you want to continue to play?';
 
 
@@ -128 +135 @@
 procedure TGame.GameOver;
 begin
+  if Running then MessageDlg(SGameOverCaption, SGameOverMessage, mtInformation, [mbOK], 0);
   Running := False;
-  ShowMessage(SGameOver);
+end;
+
+procedure TGame.Win;
+begin
+  if not Won then begin
+    Won := True;
+    if MessageDlg(SWinCaption, SWinMessage, mtConfirmation,
+    mbYesNo, 0) = mrNo then begin
+      Running := False;
+    end;
+  end;
 end;
 
@@ -154 +172 @@
   try
     TempGame.Assign(Self);
+    TempGame.AnimationDuration := 0;
     Result := TempGame.MoveAll(drDown) > 0;
     if Result then Exit;
@@ -177 +196 @@
 end;
 
+function TGame.GetHighestCellValue: Integer;
+var
+  X, Y: Integer;
+begin
+  Result := 0;
+  for Y := 0 to Size.Y - 1 do
+    for X := 0 to Size.X - 1 do
+      if Result < Cells[Y, X].Value then Result := Cells[Y, X].Value;
+end;
+
 procedure TGame.Assign(Source: TGame);
 var
   X, Y: Integer;
 begin
+  FScore := Source.FScore;
+  TopScore := Source.TopScore;
+  AnimationDuration := Source.AnimationDuration;
+  Won := Source.Won;
   Size := Source.Size;
   for Y := 0 to Size.Y - 1 do
@@ -193 +226 @@
   Clear;
   Score := 0;
+  Won := False;
   Running := True;
   for I := 0 to 1 do FillRandomCell;
@@ -232 +266 @@
   Canvas.Font.Color := clWhite;
   Canvas.Font.Height := Trunc(TopBarHeight * 0.7);
-  Canvas.TextOut(ScaleY(106, 96), (TopBarHeight - Canvas.TextHeight(ValueStr)) div 2, ValueStr);
+  Canvas.TextOut(ScaleY(136, 96), (TopBarHeight - Canvas.TextHeight(ValueStr)) div 2, ValueStr);
 
   // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows.
@@ -409 +443 @@
       Time := Now;
       Part := (Time - StartTime) / (EndTime - StartTime);
+      if Part > 1 then Part := 1;
       for Y := 0 to Size.Y - 1 do
         for X := 0 to Size.X - 1 do begin
@@ -417 +452 @@
       DoChange;
       Application.ProcessMessages;
-      Sleep(10);
+      Sleep(1);
     until Time > EndTime;
 
@@ -423 +458 @@
     for Y := 0 to Size.Y - 1 do
       for X := 0 to Size.X - 1 do begin
+        Cells[Y, X].Shift := Point(0, 0);
+        Cells[Y, X].Moving := False;
         Cells[Y, X].Value := Cells[Y, X].NewValue;
-        Cells[Y, X].Shift := Point(0, 0);
       end;
     DoChange;