Changes in / [1:3]

Location:

/trunk

Files:

• . (modified) (1 prop)
• Game2048.lpi (modified) (3 diffs)
• Game2048.lpr (modified) (2 diffs)
• Game2048.res (modified) ( previous)
• UFormMain.lfm (modified) (1 diff)
• UFormMain.pas (modified) (5 diffs)
• UFormNew.lfm (added)
• UFormNew.pas (added)
• UGame.pas (modified) (4 diffs)

/trunk/Game2048.lpi ¶

@@ -9 +9 @@
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
       <Icon Value="0"/>
     </General>
@@ -27 +30 @@
       </Item1>
     </RequiredPackages>
-    <Units Count="3">
+    <Units Count="4">
       <Unit0>
         <Filename Value="Game2048.lpr"/>
@@ -43 +46 @@
         <IsPartOfProject Value="True"/>
       </Unit2>
+      <Unit3>
+        <Filename Value="UFormNew.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="FormNew"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit3>
     </Units>
   </ProjectOptions>

/trunk/Game2048.lpr ¶

@@ -8 +8 @@
   {$ENDIF}{$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, UFormMain, UGame
+  Forms, UFormMain, UGame, UFormNew
   { you can add units after this };
 
@@ -17 +17 @@
   Application.Initialize;
   Application.CreateForm(TFormMain, FormMain);
+  Application.CreateForm(TFormNew, FormNew);
   Application.Run;
 end.

/trunk/UFormMain.lfm ¶

@@ -6 +6 @@
   Caption = '2048 game'
   DesignTimePPI = 144
+  Menu = MainMenu1
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
   OnKeyUp = FormKeyUp
   OnPaint = FormPaint
   OnShow = FormShow
   LCLVersion = '1.8.4.0'
+  object MainMenu1: TMainMenu
+    left = 325
+    top = 152
+    object MenuItemGame: TMenuItem
+      Caption = 'Game'
+      object MenuItem1: TMenuItem
+        Action = AGameNew
+      end
+    end
+  end
+  object ActionList1: TActionList
+    left = 144
+    top = 155
+    object AGameNew: TAction
+      Caption = 'New...'
+      OnExecute = AGameNewExecute
+    end
+  end
 end

/trunk/UFormMain.pas ¶

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, UGame;
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
+  ActnList, UGame;
 
 type
@@ -13 +14 @@
 
   TFormMain = class(TForm)
+    AGameNew: TAction;
+    ActionList1: TActionList;
+    MainMenu1: TMainMenu;
+    MenuItem1: TMenuItem;
+    MenuItemGame: TMenuItem;
+    procedure AGameNewExecute(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure FormDestroy(Sender: TObject);
     procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure FormPaint(Sender: TObject);
@@ -29 +38 @@
 
 {$R *.lfm}
+
+uses
+  UFormNew;
 
 { TFormMain }
@@ -50 +62 @@
 end;
 
+procedure TFormMain.AGameNewExecute(Sender: TObject);
+begin
+  FormNew.Load(Game);
+  if FormNew.ShowModal = mrOk then begin
+    FormNew.Save(Game);
+    Game.New;
+  end;
+end;
+
+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;
+
 procedure TFormMain.FormPaint(Sender: TObject);
 begin
@@ -57 +91 @@
 procedure TFormMain.FormShow(Sender: TObject);
 begin
-  Randomize;
-  Game := TGame.Create;
-  Game.Size := Point(3, 3);
-  Game.OnChange := GameChange;
   Game.New;
-
   {
   Game.Cells[0, 0].Value := 1;

/trunk/UGame.pas ¶

@@ -30 +30 @@
     FRunning: Boolean;
     FSize: TPoint;
+    function GetCellColor(Value: Integer): TColor;
     procedure SetSize(AValue: TPoint);
     procedure GetEmptyCells(EmptyCells: TCells);
@@ -47 +48 @@
     procedure MoveCell(SourceCell, TargetCell: TCell);
     function IsValidPos(Pos: TPoint): Boolean;
+    constructor Create;
     property Size: TPoint read FSize write SetSize;
     property Running: Boolean read FRunning write FRunning;
@@ -204 +206 @@
   Canvas.Font.Height := Trunc(CellSize.Y * 0.7);
   for Y := 0 to Size.Y - 1 do
-    for X := 0 to Size.X - 1 do
-    if Cells[Y, X].Value <> 0 then begin
-      ValueStr := IntToStr(Cells[Y, X].Value);
-      Canvas.TextOut(X * CellSize.X + CellSize.X div 2 -
-        Canvas.TextWidth(ValueStr) div 2, Y * CellSize.Y, ValueStr);
+    for X := 0 to Size.X - 1 do begin
+      Canvas.Brush.Color := GetCellColor(Cells[Y, X].Value);
+      Canvas.Brush.Style := bsSolid;
+      Canvas.FillRect(Rect(X * CellSize.X, Y * CellSize.Y,
+        (X + 1) * CellSize.X, (Y + 1) * CellSize.Y));
+      if Cells[Y, X].Value <> 0 then begin
+        ValueStr := IntToStr(Cells[Y, X].Value);
+        Canvas.TextOut(X * CellSize.X + CellSize.X div 2 -
+          Canvas.TextWidth(ValueStr) div 2, Y * CellSize.Y, ValueStr);
+      end;
     end;
 
@@ -305 +312 @@
 end;
 
+constructor TGame.Create;
+begin
+end;
+
+function TGame.GetCellColor(Value: Integer): TColor;
+begin
+  case Value of
+    0: Result := $f2f6f9;
+    2: Result := $dae4ee;
+    4: Result := $c8e0ed;
+    8: Result := $79b1f2;
+    16: Result := $6395f5;
+    32: Result := $5f7cf6;
+    64: Result := $3b5ef6;
+    128: Result := $72cfed;
+    256: Result := $61cced;
+    512: Result := $50c8ed;
+    1024: Result := $3fc5ed;
+    2048: Result := $2ec2ed;
+    else Result := $323a3c;
+  end;
+end;
+
 end.