Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormMain.pas
r8 r10 35 35 private 36 36 public 37 Game: TGame;38 procedure GameChange(Sender: TObject);39 37 end; 40 38 … … 55 53 MovedCount: Integer; 56 54 begin 57 if Game.Running then begin55 if Core.Game.Running then begin 58 56 MovedCount := 0; 59 57 case Key of 60 37: MovedCount := Game.MoveAll(drLeft);61 38: MovedCount := Game.MoveAll(drUp);62 39: MovedCount := Game.MoveAll(drRight);63 40: MovedCount := Game.MoveAll(drDown);58 37: MovedCount := Core.Game.MoveAll(drLeft); 59 38: MovedCount := Core.Game.MoveAll(drUp); 60 39: MovedCount := Core.Game.MoveAll(drRight); 61 40: MovedCount := Core.Game.MoveAll(drDown); 64 62 end; 65 if MovedCount > 0 then Game.FillRandomCell;66 if not Game.CanMove and (Game.GetEmptyCellsCount = 0) then67 Game.GameOver;63 if MovedCount > 0 then Core.Game.FillRandomCell; 64 if not Core.Game.CanMove and (Core.Game.GetEmptyCellsCount = 0) then 65 Core.Game.GameOver; 68 66 end; 69 67 end; … … 71 69 procedure TFormMain.FormPaint(Sender: TObject); 72 70 begin 73 Game.Render(Canvas, Point(Width, Height - MainMenu1.Height));71 Core.Game.Render(Canvas, Point(Width, Height - MainMenu1.Height)); 74 72 end; 75 73 … … 78 76 FormNew := TFormNew.Create(nil); 79 77 try 80 FormNew.Load( Game);78 FormNew.Load(Core.Game); 81 79 if FormNew.ShowModal = mrOk then begin 82 FormNew.Save( Game);83 Game.New;80 FormNew.Save(Core.Game); 81 Core.Game.New; 84 82 end; 85 83 finally … … 111 109 procedure TFormMain.FormCreate(Sender: TObject); 112 110 begin 113 Randomize;114 Game := TGame.Create;115 Game.Size := Point(4, 4);116 Game.OnChange := GameChange;117 111 end; 118 112 119 113 procedure TFormMain.FormDestroy(Sender: TObject); 120 114 begin 121 Game.Free;122 115 end; 123 116 … … 126 119 Core.PersistentForm1.RegistryContext := Core.ApplicationInfo1.GetRegistryContext; 127 120 Core.PersistentForm1.Load(Self); 128 Game.New; 129 { 130 Game.Cells[0, 0].Value := 1; 131 Game.Cells[0, 1].Value := 2; 132 Game.Cells[0, 2].Value := 3; 133 Game.Cells[1, 0].Value := 4; 134 Game.Cells[1, 1].Value := 5; 135 Game.Cells[1, 2].Value := 6; 136 Game.Cells[2, 0].Value := 7; 137 Game.Cells[2, 1].Value := 8; 138 Game.Cells[2, 2].Value := 9; 139 } 140 end; 141 142 procedure TFormMain.GameChange(Sender: TObject); 143 begin 144 Repaint; 121 Core.Game.New; 145 122 end; 146 123 -
trunk/UCore.lfm
r8 r10 1 1 object Core: TCore 2 OnCreate = DataModuleCreate 3 OnDestroy = DataModuleDestroy 2 4 OldCreateOrder = False 3 5 Height = 534 -
trunk/UCore.pas
r8 r10 6 6 7 7 uses 8 Classes, SysUtils, UTheme, UPersistentForm, UApplicationInfo, UTranslator; 8 Classes, SysUtils, UTheme, UPersistentForm, UApplicationInfo, UTranslator, 9 URegistry, UGame; 9 10 10 11 type … … 17 18 ThemeManager1: TThemeManager; 18 19 Translator1: TTranslator; 20 procedure DataModuleCreate(Sender: TObject); 21 procedure DataModuleDestroy(Sender: TObject); 19 22 private 20 23 procedure GameChange(Sender: TObject); 21 24 public 22 25 Game: TGame; 26 procedure LoadConfig; 27 procedure SaveConfig; 23 28 end; 24 29 … … 30 35 {$R *.lfm} 31 36 37 uses 38 UFormMain; 39 40 { TCore } 41 42 procedure TCore.DataModuleCreate(Sender: TObject); 43 begin 44 Randomize; 45 Game := TGame.Create; 46 Game.Size := Point(4, 4); 47 Game.OnChange := GameChange; 48 LoadConfig; 49 end; 50 51 procedure TCore.DataModuleDestroy(Sender: TObject); 52 begin 53 SaveConfig; 54 FreeAndNil(Game); 55 end; 56 57 procedure TCore.GameChange(Sender: TObject); 58 begin 59 FormMain.Repaint; 60 end; 61 62 procedure TCore.LoadConfig; 63 begin 64 with TRegistryEx.Create do 65 try 66 CurrentContext := ApplicationInfo1.GetRegistryContext; 67 68 Game.TopScore := ReadIntegerWithDefault('TopScore', 0); 69 finally 70 Free; 71 end; 72 end; 73 74 procedure TCore.SaveConfig; 75 begin 76 with TRegistryEx.Create do 77 try 78 CurrentContext := ApplicationInfo1.GetRegistryContext; 79 80 WriteInteger('TopScore', Game.TopScore); 81 finally 82 Free; 83 end; 84 end; 85 32 86 end. 33 87 -
trunk/UGame.pas
r9 r10 32 32 FOnChange: TNotifyEvent; 33 33 FRunning: Boolean; 34 FScore: Integer; 34 35 FSize: TPoint; 35 36 function GetCellColor(Value: Integer): TColor; 37 procedure SetScore(AValue: Integer); 36 38 procedure SetSize(AValue: TPoint); 37 39 procedure GetEmptyCells(EmptyCells: TCells); 38 40 procedure DoChange; 39 41 procedure ClearMerged; 40 function GetScore: Integer;41 42 public 42 43 Cells: array of array of TCell; 44 TopScore: Integer; 43 45 procedure GameOver; 44 46 function FillRandomCell: Integer; … … 54 56 constructor Create; 55 57 destructor Destroy; override; 56 property Score: Integer read GetScore;58 property Score: Integer read FScore write SetScore; 57 59 property Size: TPoint read FSize write SetSize; 58 60 property Running: Boolean read FRunning write FRunning; … … 187 189 begin 188 190 Clear; 191 Score := 0; 189 192 Running := True; 190 193 for I := 0 to 1 do FillRandomCell; … … 222 225 Canvas.Font.Height := Trunc(TopBarHeight * 0.7); 223 226 Canvas.TextOut(ScaleY(16, 96), (TopBarHeight - Canvas.TextHeight(ValueStr)) div 2, ValueStr); 227 228 ValueStr := 'Top score: ' + IntToStr(TopScore); 229 Canvas.Font.Color := clWhite; 230 Canvas.Font.Height := Trunc(TopBarHeight * 0.7); 231 Canvas.TextOut(ScaleY(106, 96), (TopBarHeight - Canvas.TextHeight(ValueStr)) div 2, ValueStr); 224 232 225 233 // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows. … … 377 385 Cells[P.Y, P.X].Merged := False; 378 386 Inc(MovedCount); 387 Score := Score + Cells[PNew.Y, PNew.X].NewValue; 379 388 end; 380 389 end; … … 421 430 Result := (Pos.X >= 0) and (Pos.X < FSize.X) and 422 431 (Pos.Y >= 0) and (Pos.Y < FSize.Y); 423 end;424 425 function TGame.GetScore: Integer;426 var427 X, Y: Integer;428 begin429 Result := 0;430 for Y := 0 to Size.Y - 1 do431 for X := 0 to Size.X - 1 do432 Result := Result + Cells[Y, X].Value;433 432 end; 434 433 … … 462 461 end; 463 462 463 procedure TGame.SetScore(AValue: Integer); 464 begin 465 if FScore = AValue then Exit; 466 FScore := AValue; 467 if FScore > TopScore then TopScore := FScore; 468 end; 469 464 470 end. 465 471
Note:
See TracChangeset
for help on using the changeset viewer.
