Changeset 5

Timestamp:

Sep 24, 2019, 10:09:45 PM (5 years ago)

Author:

chronos

Message:

• Added: Show game score.
• Fixed: Make cell font smaller if text is too width.

Location:

trunk

Files:

• . (modified) (1 prop)
• Game2048.lpr (modified) (2 diffs)
• UFormMain.lfm (modified) (4 diffs)
• UFormMain.pas (modified) (5 diffs)
• UGame.pas (modified) (6 diffs)

trunk

@@ -1 +1 @@
 Game2048
 Game2048.lps
+Game2048.dbg
 lib
+heaptrclog.trc

@@ -1 +1 @@
 Game2048
 Game2048.lps
+Game2048.dbg
 lib
+heaptrclog.trc

trunk/Game2048.lpr

@@ -7 +7 @@
   cthreads,
   {$ENDIF}{$ENDIF}
-  Interfaces, // this includes the LCL widgetset
+  Interfaces, SysUtils,// this includes the LCL widgetset
   Forms, UFormMain, UGame, UFormNew
   { you can add units after this };
@@ -13 +13 @@
 {$R *.res}
 
+{$if declared(UseHeapTrace)}
+const
+  HeapTraceLog = 'heaptrclog.trc';
+{$ENDIF}
+
+
 begin
+  {$if declared(UseHeapTrace)}
+  DeleteFile(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
+  SetHeapTraceOutput(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
+  {$ENDIF}
   RequireDerivedFormResource:=True;
   Application.Initialize;

trunk/UFormMain.lfm

@@ -1 +1 @@
 object FormMain: TFormMain
   Left = 684
-  Height = 360
-  Top = 391
-  Width = 480
+  Height = 521
+  Top = 307
+  Width = 580
   Caption = '2048 game'
   DesignTimePPI = 144
@@ -12 +12 @@
   OnPaint = FormPaint
   OnShow = FormShow
-  LCLVersion = '1.8.4.0'
+  LCLVersion = '2.0.2.0'
   object MainMenu1: TMainMenu
     left = 325
@@ -20 +20 @@
       object MenuItem1: TMenuItem
         Action = AGameNew
+      end
+      object MenuItem2: TMenuItem
+        Action = AExit
       end
     end
@@ -30 +33 @@
       OnExecute = AGameNewExecute
     end
+    object AExit: TAction
+      Caption = 'Exit'
+      OnExecute = AExitExecute
+    end
   end
 end

trunk/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
-  ActnList, UGame;
+  ActnList, ExtCtrls, StdCtrls, UGame;
 
 type
@@ -14 +14 @@
 
   TFormMain = class(TForm)
+    AExit: TAction;
     AGameNew: TAction;
     ActionList1: TActionList;
     MainMenu1: TMainMenu;
     MenuItem1: TMenuItem;
+    MenuItem2: TMenuItem;
     MenuItemGame: TMenuItem;
+    procedure AExitExecute(Sender: TObject);
     procedure AGameNewExecute(Sender: TObject);
     procedure FormCreate(Sender: TObject);
@@ -62 +65 @@
 end;
 
+procedure TFormMain.FormPaint(Sender: TObject);
+begin
+  Game.Render(Canvas);
+end;
+
 procedure TFormMain.AGameNewExecute(Sender: TObject);
 begin
@@ -69 +77 @@
     Game.New;
   end;
+end;
+
+procedure TFormMain.AExitExecute(Sender: TObject);
+begin
+  Close;
 end;
 
@@ -82 +95 @@
 begin
   Game.Free;
-end;
-
-procedure TFormMain.FormPaint(Sender: TObject);
-begin
-  Game.Render(Canvas);
 end;
 

trunk/UGame.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Dialogs, fgl, Graphics;
+  Classes, SysUtils, Dialogs, fgl, Graphics, Types;
 
 type
@@ -35 +35 @@
     procedure DoChange;
     procedure ClearMerged;
+    function GetScore: Integer;
   public
     Cells: array of array of TCell;
@@ -49 +50 @@
     function IsValidPos(Pos: TPoint): Boolean;
     constructor Create;
+    destructor Destroy; override;
+    property Score: Integer read GetScore;
     property Size: TPoint read FSize write SetSize;
     property Running: Boolean read FRunning write FRunning;
@@ -201 +204 @@
   ValueStr: string;
   Frame: TRect;
-begin
-  CellSize := Point(Canvas.Width div Size.X, Canvas.Height div Size.Y);
+  TextSize: TSize;
+const
+  TopBarHeight = 32;
+begin
+  Canvas.Brush.Style := bsSolid;
+  Canvas.Brush.Color := clBlack;
+  Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height);
+
+  Canvas.Font.Color := clWhite;
+  Canvas.Font.Height := 20;
+  Canvas.TextOut(16, 4, 'Score: ' + IntToStr(Score));
+
+  Frame := Rect(0, TopBarHeight, Canvas.Width, Canvas.Height);
+  CellSize := Point(Frame.Width div Size.X, Frame.Height div Size.Y);
   if CellSize.X < CellSize.Y then CellSize.Y := CellSize.X;
   if CellSize.Y < CellSize.X then CellSize.X := CellSize.Y;
-  Frame := Rect(Canvas.Width div 2 - (Size.X * CellSize.X) div 2,
-    Canvas.Height div 2 - (Size.Y * CellSize.Y) div 2,
-    Canvas.Width div 2 + (Size.X * CellSize.X) div 2,
-    Canvas.Height div 2 + (Size.Y * CellSize.Y) div 2);
-
-  Canvas.FillRect(0, 0, Canvas.Width, Canvas.Height);
+  Frame := Rect(Frame.Width div 2 - (Size.X * CellSize.X) div 2,
+    Frame.Top + Frame.Height div 2 - (Size.Y * CellSize.Y) div 2,
+    Frame.Width div 2 + (Size.X * CellSize.X) div 2,
+    Frame.Top + Frame.Height div 2 + (Size.Y * CellSize.Y) div 2);
+
   Canvas.Font.Color := clBlack;
-  Canvas.Font.Height := Trunc(CellSize.Y * 0.7);
   for Y := 0 to Size.Y - 1 do
     for X := 0 to Size.X - 1 do begin
@@ -221 +234 @@
       if Cells[Y, X].Value <> 0 then begin
         ValueStr := IntToStr(Cells[Y, X].Value);
+        Canvas.Brush.Style := bsClear;
+        Canvas.Font.Height := Trunc(CellSize.Y * 0.7); // * (CellSize.X * 0.7) / Canvas.TextWidth(ValueStr));
+        TextSize := Canvas.TextExtent(ValueStr);
+        if TextSize.Width > CellSize.X then
+          Canvas.Font.Height := Trunc(Canvas.Font.Height / TextSize.Width * CellSize.X);
+        TextSize := Canvas.TextExtent(ValueStr);
         Canvas.TextOut(Frame.Left + X * CellSize.X + CellSize.X div 2 -
-          Canvas.TextWidth(ValueStr) div 2,
-          Frame.Top + Y * CellSize.Y, ValueStr);
+          TextSize.Width div 2,
+          Frame.Top + Y * CellSize.Y + CellSize.Y div 2 - TextSize.Height div 2, ValueStr);
       end;
     end;
@@ -323 +342 @@
 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;
+
 constructor TGame.Create;
 begin
+end;
+
+destructor TGame.Destroy;
+begin
+  Size := Point(0, 0);
+  inherited;
 end;
 

@@ -1 +1 @@
 Game2048
 Game2048.lps
+Game2048.dbg
 lib
+heaptrclog.trc