Changeset 10

Timestamp:

Oct 4, 2019, 11:05:35 PM (5 years ago)

Author:

chronos

Message:

• Added: Show Top score and remember it after application restart.

Location:

trunk

Files:

• Forms/UFormMain.pas (modified) (6 diffs)
• UCore.lfm (modified) (1 diff)
• UCore.pas (modified) (3 diffs)
• UGame.pas (modified) (7 diffs)

trunk/Forms/UFormMain.pas

@@ -35 +35 @@
   private
   public
-    Game: TGame;
-    procedure GameChange(Sender: TObject);
   end;
 
@@ -55 +53 @@
   MovedCount: Integer;
 begin
-  if Game.Running then begin
+  if Core.Game.Running then begin
     MovedCount := 0;
     case Key of
-      37: MovedCount := Game.MoveAll(drLeft);
-      38: MovedCount := Game.MoveAll(drUp);
-      39: MovedCount := Game.MoveAll(drRight);
-      40: MovedCount := Game.MoveAll(drDown);
+      37: MovedCount := Core.Game.MoveAll(drLeft);
+      38: MovedCount := Core.Game.MoveAll(drUp);
+      39: MovedCount := Core.Game.MoveAll(drRight);
+      40: MovedCount := Core.Game.MoveAll(drDown);
     end;
-    if MovedCount > 0 then Game.FillRandomCell;
-    if not Game.CanMove and (Game.GetEmptyCellsCount = 0) then
-      Game.GameOver;
+    if MovedCount > 0 then Core.Game.FillRandomCell;
+    if not Core.Game.CanMove and (Core.Game.GetEmptyCellsCount = 0) then
+      Core.Game.GameOver;
   end;
 end;
@@ -71 +69 @@
 procedure TFormMain.FormPaint(Sender: TObject);
 begin
-  Game.Render(Canvas, Point(Width, Height - MainMenu1.Height));
+  Core.Game.Render(Canvas, Point(Width, Height - MainMenu1.Height));
 end;
 
@@ -78 +76 @@
   FormNew := TFormNew.Create(nil);
   try
-    FormNew.Load(Game);
+    FormNew.Load(Core.Game);
     if FormNew.ShowModal = mrOk then begin
-      FormNew.Save(Game);
-      Game.New;
+      FormNew.Save(Core.Game);
+      Core.Game.New;
     end;
   finally
@@ -111 +109 @@
 procedure TFormMain.FormCreate(Sender: TObject);
 begin
-  Randomize;
-  Game := TGame.Create;
-  Game.Size := Point(4, 4);
-  Game.OnChange := GameChange;
 end;
 
 procedure TFormMain.FormDestroy(Sender: TObject);
 begin
-  Game.Free;
 end;
 
@@ -126 +119 @@
   Core.PersistentForm1.RegistryContext := Core.ApplicationInfo1.GetRegistryContext;
   Core.PersistentForm1.Load(Self);
-  Game.New;
-  {
-  Game.Cells[0, 0].Value := 1;
-  Game.Cells[0, 1].Value := 2;
-  Game.Cells[0, 2].Value := 3;
-  Game.Cells[1, 0].Value := 4;
-  Game.Cells[1, 1].Value := 5;
-  Game.Cells[1, 2].Value := 6;
-  Game.Cells[2, 0].Value := 7;
-  Game.Cells[2, 1].Value := 8;
-  Game.Cells[2, 2].Value := 9;
-  }
-end;
-
-procedure TFormMain.GameChange(Sender: TObject);
-begin
-  Repaint;
+  Core.Game.New;
 end;
 

trunk/UCore.lfm

@@ -1 +1 @@
 object Core: TCore
+  OnCreate = DataModuleCreate
+  OnDestroy = DataModuleDestroy
   OldCreateOrder = False
   Height = 534

trunk/UCore.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UTheme, UPersistentForm, UApplicationInfo, UTranslator;
+  Classes, SysUtils, UTheme, UPersistentForm, UApplicationInfo, UTranslator,
+  URegistry, UGame;
 
 type
@@ -17 +18 @@
     ThemeManager1: TThemeManager;
     Translator1: TTranslator;
+    procedure DataModuleCreate(Sender: TObject);
+    procedure DataModuleDestroy(Sender: TObject);
   private
-
+    procedure GameChange(Sender: TObject);
   public
-
+    Game: TGame;
+    procedure LoadConfig;
+    procedure SaveConfig;
   end;
 
@@ -30 +35 @@
 {$R *.lfm}
 
+uses
+  UFormMain;
+
+{ TCore }
+
+procedure TCore.DataModuleCreate(Sender: TObject);
+begin
+  Randomize;
+  Game := TGame.Create;
+  Game.Size := Point(4, 4);
+  Game.OnChange := GameChange;
+  LoadConfig;
+end;
+
+procedure TCore.DataModuleDestroy(Sender: TObject);
+begin
+  SaveConfig;
+  FreeAndNil(Game);
+end;
+
+procedure TCore.GameChange(Sender: TObject);
+begin
+  FormMain.Repaint;
+end;
+
+procedure TCore.LoadConfig;
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := ApplicationInfo1.GetRegistryContext;
+
+    Game.TopScore := ReadIntegerWithDefault('TopScore', 0);
+  finally
+    Free;
+  end;
+end;
+
+procedure TCore.SaveConfig;
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := ApplicationInfo1.GetRegistryContext;
+
+    WriteInteger('TopScore', Game.TopScore);
+  finally
+    Free;
+  end;
+end;
+
 end.
 

trunk/UGame.pas

@@ -32 +32 @@
     FOnChange: TNotifyEvent;
     FRunning: Boolean;
+    FScore: Integer;
     FSize: TPoint;
     function GetCellColor(Value: Integer): TColor;
+    procedure SetScore(AValue: Integer);
     procedure SetSize(AValue: TPoint);
     procedure GetEmptyCells(EmptyCells: TCells);
     procedure DoChange;
     procedure ClearMerged;
-    function GetScore: Integer;
   public
     Cells: array of array of TCell;
+    TopScore: Integer;
     procedure GameOver;
     function FillRandomCell: Integer;
@@ -54 +56 @@
     constructor Create;
     destructor Destroy; override;
-    property Score: Integer read GetScore;
+    property Score: Integer read FScore write SetScore;
     property Size: TPoint read FSize write SetSize;
     property Running: Boolean read FRunning write FRunning;
@@ -187 +189 @@
 begin
   Clear;
+  Score := 0;
   Running := True;
   for I := 0 to 1 do FillRandomCell;
@@ -222 +225 @@
   Canvas.Font.Height := Trunc(TopBarHeight * 0.7);
   Canvas.TextOut(ScaleY(16, 96), (TopBarHeight - Canvas.TextHeight(ValueStr)) div 2, ValueStr);
+
+  ValueStr := 'Top score: ' + IntToStr(TopScore);
+  Canvas.Font.Color := clWhite;
+  Canvas.Font.Height := Trunc(TopBarHeight * 0.7);
+  Canvas.TextOut(ScaleY(106, 96), (TopBarHeight - Canvas.TextHeight(ValueStr)) div 2, ValueStr);
 
   // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows.
@@ -377 +385 @@
               Cells[P.Y, P.X].Merged := False;
               Inc(MovedCount);
+              Score := Score + Cells[PNew.Y, PNew.X].NewValue;
             end;
           end;
@@ -421 +430 @@
   Result := (Pos.X >= 0) and (Pos.X < FSize.X) and
     (Pos.Y >= 0) and (Pos.Y < FSize.Y);
-end;
-
-function TGame.GetScore: Integer;
-var
-  X, Y: Integer;
-begin
-  Result := 0;
-  for Y := 0 to Size.Y - 1 do
-    for X := 0 to Size.X - 1 do
-      Result := Result + Cells[Y, X].Value;
 end;
 
@@ -462 +461 @@
 end;
 
+procedure TGame.SetScore(AValue: Integer);
+begin
+  if FScore = AValue then Exit;
+  FScore := AValue;
+  if FScore > TopScore then TopScore := FScore;
+end;
+
 end.