- Timestamp:
- Dec 10, 2024, 12:06:43 AM (5 weeks ago)
- Location:
- trunk
- Files:
-
- 8 added
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Core.lfm
r95 r108 2133 2133 Caption = 'Moves history' 2134 2134 OnExecute = AHistoryExecute 2135 ShortCut = 117 2135 2136 end 2136 2137 object ARestart: TAction … … 2138 2139 OnExecute = ARestartExecute 2139 2140 ShortCut = 16466 2141 end 2142 object AScore: TAction 2143 Caption = 'Score' 2144 OnExecute = AScoreExecute 2145 ShortCut = 116 2140 2146 end 2141 2147 end -
trunk/Core.lrj
r107 r108 9 9 {"hash":1113,"name":"tcore.acomputer.caption","sourcebytes":[65,73],"value":"AI"}, 10 10 {"hash":191263657,"name":"tcore.ahistory.caption","sourcebytes":[77,111,118,101,115,32,104,105,115,116,111,114,121],"value":"Moves history"}, 11 {"hash":147499204,"name":"tcore.arestart.caption","sourcebytes":[82,101,115,116,97,114,116],"value":"Restart"} 11 {"hash":147499204,"name":"tcore.arestart.caption","sourcebytes":[82,101,115,116,97,114,116],"value":"Restart"}, 12 {"hash":5875333,"name":"tcore.ascore.caption","sourcebytes":[83,99,111,114,101],"value":"Score"} 12 13 ]} -
trunk/Core.pas
r107 r108 5 5 uses 6 6 Classes, SysUtils, Theme, PersistentForm, ApplicationInfo, Translator, 7 RegistryEx, ScaleDPI, Game, ActnList, Forms, Controls, Dialogs ;7 RegistryEx, ScaleDPI, Game, ActnList, Forms, Controls, Dialogs, Score; 8 8 9 9 type … … 14 14 AAbout: TAction; 15 15 AComputer: TAction; 16 AScore: TAction; 16 17 ARestart: TAction; 17 18 AHistory: TAction; … … 34 35 procedure ANewExecute(Sender: TObject); 35 36 procedure ARestartExecute(Sender: TObject); 37 procedure AScoreExecute(Sender: TObject); 36 38 procedure ASettingsExecute(Sender: TObject); 37 39 procedure AUndoExecute(Sender: TObject); … … 46 48 procedure GameOver(Sender: TObject); 47 49 procedure GameOverSync; 50 procedure UpdateScores; 48 51 public 49 52 Game: TGame; 53 Scores: TScores; 50 54 procedure UpdateInterface; 51 55 procedure LoadConfig; … … 63 67 uses 64 68 FormMain, FormSettings, FormNew, FormHelp, FormComputer, FormAbout, FormEx, 65 FormHistory ;69 FormHistory, FormScore; 66 70 67 71 resourcestring … … 89 93 90 94 Randomize; 95 Scores := TScores.Create; 96 91 97 Game := TGame.Create; 92 98 Game.Board.Size := Point(4, 4); … … 182 188 FormNew: TFormNew; 183 189 begin 190 UpdateScores; 184 191 FormNew := TFormNew.Create(nil); 185 192 try … … 198 205 procedure TCore.ARestartExecute(Sender: TObject); 199 206 begin 207 UpdateScores; 200 208 Game.Restart; 201 209 UpdateInterface; … … 203 211 end; 204 212 213 procedure TCore.AScoreExecute(Sender: TObject); 214 var 215 FormScore: TFormScore; 216 begin 217 UpdateScores; 218 FormScore := TFormScore.Create(nil); 219 try 220 FormScore.Scores := Scores; 221 if FormScore.ShowModal = mrOk then begin 222 end; 223 finally 224 FreeAndNil(FormScore); 225 end; 226 end; 227 205 228 procedure TCore.DataModuleDestroy(Sender: TObject); 206 229 begin 230 UpdateScores; 207 231 SaveConfig; 208 232 FreeAndNil(Game); 233 FreeAndNil(Scores); 209 234 end; 210 235 … … 232 257 begin 233 258 MessageDlg(SWinCaption, Format(SWinMessage, [Game.GetTileSkinValue(Game.WinTileValue)]), mtInformation, [mbOk], 0); 259 UpdateScores; 234 260 end; 235 261 … … 242 268 begin 243 269 MessageDlg(SGameOverCaption, SGameOverMessage, mtInformation, [mbOK], 0); 270 UpdateScores; 271 end; 272 273 procedure TCore.UpdateScores; 274 var 275 Score: TScore; 276 begin 277 Score := Scores.SearchByTime(Game.StartTime); 278 if not Assigned(Score) then Score := Scores.AddNew; 279 Score.StartTime := Game.StartTime; 280 Score.Score := Game.Score; 281 Score.Moves := Game.Moves; 282 Score.UsedUndos := Game.UsedUndos; 283 Score.BoardSize := IntToStr(Game.Board.Size.X) + 'x' + IntToStr(Game.Board.Size.Y); 244 284 end; 245 285 … … 258 298 259 299 procedure TCore.LoadConfig; 260 begin 261 with TRegistryEx.Create do 300 var 301 Reg: TRegistryEx; 302 RegContext: TRegistryContext; 303 begin 304 Reg := TRegistryEx.Create; 305 with Reg do 262 306 try 263 307 CurrentContext := ApplicationInfo1.GetRegistryContext; … … 267 311 else Translator1.Language := Translator1.Languages.SearchByCode(''); 268 312 ThemeManager1.Theme := ThemeManager1.Themes.FindByName(ReadStringWithDefault('Theme', 'System')); 269 finally 270 Free; 271 end; 272 Game.LoadFromRegistry(ApplicationInfo1.GetRegistryContext); 313 314 RegContext := ApplicationInfo1.GetRegistryContext; 315 Game.LoadFromRegistry(Reg, RegContext); 316 Scores.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Scores')); 317 finally 318 Reg.Free; 319 end; 273 320 end; 274 321 275 322 procedure TCore.SaveConfig; 276 begin 277 with TRegistryEx.Create do 323 var 324 Reg: TRegistryEx; 325 RegContext: TRegistryContext; 326 begin 327 Reg := TRegistryEx.Create; 328 with Reg do 278 329 try 279 330 CurrentContext := ApplicationInfo1.GetRegistryContext; … … 283 334 else DeleteValue('LanguageCode'); 284 335 WriteString('Theme', ThemeManager1.Theme.Name); 285 finally 286 Free; 287 end; 288 Game.SaveToRegistry(ApplicationInfo1.GetRegistryContext); 336 337 RegContext := ApplicationInfo1.GetRegistryContext; 338 Game.SaveToRegistry(Reg, RegContext); 339 Scores.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Scores')); 340 finally 341 Reg.Free; 342 end; 289 343 end; 290 344 -
trunk/Forms/FormMain.lfm
r103 r108 1 1 object FormMain: TFormMain 2 2 Left = 534 3 Height = 10273 Height = 993 4 4 Top = 223 5 5 Width = 1491 … … 54 54 Action = Core.ASettings 55 55 end 56 object MenuItem 4: TMenuItem57 Action = Core.A Computer56 object MenuItem7: TMenuItem 57 Action = Core.AScore 58 58 end 59 59 object MenuItemMovesHistory: TMenuItem 60 60 Action = Core.AHistory 61 end 62 object MenuItem4: TMenuItem 63 Action = Core.AComputer 61 64 end 62 65 end -
trunk/Forms/FormMain.pas
r104 r108 28 28 MenuItem5: TMenuItem; 29 29 MenuItem6: TMenuItem; 30 MenuItem7: TMenuItem; 30 31 MenuItemColorPalette: TMenuItem; 31 32 MenuItemTileSkin: TMenuItem; -
trunk/Game.pas
r107 r108 27 27 TGame = class 28 28 private 29 FMoves: Integer; 29 30 FMoving: Boolean; 30 31 FUnmergeableTilesCount: Integer; … … 41 42 FSkin: TTileSkin; 42 43 FDisabledTilesCount: Integer; 44 FUsedUndos: Integer; 43 45 function GetTileColor(Value: Integer): TColor; 44 46 procedure SetRecordHistory(AValue: Boolean); … … 72 74 BackgroundColor: TColor; 73 75 Value2Chance: Double; 76 StartTime: TDateTime; 74 77 procedure Replay(History: THistory; Step: Integer); 75 78 function CanUndo: Boolean; … … 87 90 procedure MoveTile(SourceTile, TargetTile: TTile); 88 91 function IsValidPos(Pos: TPoint): Boolean; 89 procedure SaveToRegistry(Reg Context: TRegistryContext);90 procedure LoadFromRegistry(Reg Context: TRegistryContext);92 procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext); 93 procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext); 91 94 function GetTileSkinValue(Value: Integer): string; 92 95 function GetTileSkinScore(Value: Integer): Integer; … … 94 97 destructor Destroy; override; 95 98 property Score: Integer read FScore write SetScore; 99 property Moves: Integer read FMoves; 100 property UsedUndos: Integer read FUsedUndos; 96 101 property Running: Boolean read FRunning write FRunning; 97 property OnChange: TNotifyEvent read FOnChange write FOnChange;98 property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;99 property OnWin: TNotifyEvent read FOnWin write FOnWin;100 property OnGameOver: TNotifyEvent read FOnGameOver write FOnGameOver;101 102 property Moving: Boolean read FMoving; 102 103 property RecordHistory: Boolean read FRecordHistory write SetRecordHistory; … … 105 106 property DisabledTilesCount: Integer read FDisabledTilesCount write FDisabledTilesCount; 106 107 property UnmergeableTilesCount: Integer read FUnmergeableTilesCount write FUnmergeableTilesCount; 108 property OnChange: TNotifyEvent read FOnChange write FOnChange; 109 property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; 110 property OnWin: TNotifyEvent read FOnWin write FOnWin; 111 property OnGameOver: TNotifyEvent read FOnGameOver write FOnGameOver; 107 112 end; 108 113 … … 317 322 Difficulty = 0.7; 318 323 begin 324 FUsedUndos := 0; 325 FMoves := 0; 319 326 FCanUndo := False; 320 327 Board.Clear; … … 359 366 end; 360 367 InitialBoard.Assign(Board); 368 StartTime := Now; 361 369 AnimateTiles; 362 370 DoChange; … … 368 376 Reset; 369 377 Board.Assign(InitialBoard); 378 StartTime := Now; 370 379 AnimateTiles; 371 380 DoChange; … … 531 540 TileMoved: Boolean; 532 541 begin 542 Inc(FMoves); 533 543 if Animation then begin 534 544 MoveAllAnimate(Direction); … … 664 674 Board.Assign(FBoardUndo); 665 675 FCanUndo := False; 676 Inc(FUsedUndos); 666 677 FRunning := CanMove; 667 678 if RecordHistory then History.Moves.Delete(History.Moves.Count - 1); … … 1033 1044 end; 1034 1045 1035 procedure TGame.SaveToRegistry(RegContext: TRegistryContext); 1036 var 1037 Reg: TRegistryEx; 1038 begin 1039 Reg := TRegistryEx.Create; 1040 with Reg do 1041 try 1046 procedure TGame.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext); 1047 begin 1048 with Reg do begin 1042 1049 CurrentContext := RegContext; 1043 1050 … … 1053 1060 WriteInteger('DisabledTilesCount', DisabledTilesCount); 1054 1061 WriteInteger('UnmergeableTilesCount', UnmergeableTilesCount); 1062 WriteInteger('Moves', FMoves); 1063 WriteInteger('UsedUndos', FUsedUndos); 1064 WriteDateTime('StartTime', StartTime); 1055 1065 FBoardUndo.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo')); 1056 1066 Board.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board')); 1057 1067 InitialBoard.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialBoard')); 1058 1068 History.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History')); 1059 finally 1060 Free; 1061 end; 1062 end; 1063 1064 procedure TGame.LoadFromRegistry(RegContext: TRegistryContext); 1065 var 1066 Reg: TRegistryEx; 1067 begin 1068 Reg := TRegistryEx.Create; 1069 with Reg do 1070 try 1069 end; 1070 end; 1071 1072 procedure TGame.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext 1073 ); 1074 begin 1075 with Reg do begin 1071 1076 CurrentContext := RegContext; 1072 1077 AnimationDuration := ReadIntegerWithDefault('AnimationDuration', 30); … … 1081 1086 DisabledTilesCount := ReadIntegerWithDefault('DisabledTilesCount', DisabledTilesCount); 1082 1087 UnmergeableTilesCount := ReadIntegerWithDefault('UnmergeableTilesCount', UnmergeableTilesCount); 1088 FMoves := ReadIntegerWithDefault('Moves', FMoves); 1089 FUsedUndos := ReadIntegerWithDefault('UsedUndos', FUsedUndos); 1090 StartTime := ReadDateTimeWithDefault('StartTime', StartTime); 1083 1091 FBoardUndo.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo')); 1084 1092 Board.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board')); 1085 1093 InitialBoard.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialBoard')); 1086 1094 History.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History')); 1087 finally1088 Free;1089 1095 end; 1090 1096 DoChange; -
trunk/Game2048.lpi
r104 r108 91 91 </Item2> 92 92 </RequiredPackages> 93 <Units Count="1 2">93 <Units Count="14"> 94 94 <Unit0> 95 95 <Filename Value="Game2048.lpr"/> … … 161 161 <IsPartOfProject Value="True"/> 162 162 </Unit11> 163 <Unit12> 164 <Filename Value="Score.pas"/> 165 <IsPartOfProject Value="True"/> 166 </Unit12> 167 <Unit13> 168 <Filename Value="Forms/FormScore.pas"/> 169 <IsPartOfProject Value="True"/> 170 <ComponentName Value="FormScore"/> 171 <ResourceBaseClass Value="Form"/> 172 </Unit13> 163 173 </Units> 164 174 </ProjectOptions> -
trunk/Game2048.lpr
r104 r108 8 8 {$ENDIF} 9 9 Interfaces, SysUtils,// this includes the LCL widgetset 10 Forms, Game, Common, FormMain, Core, Tile, Board, History 10 Forms, Game, Common, FormMain, Core, Tile, Board, History, Score 11 11 { you can add units after this }; 12 12 -
trunk/Languages/Game2048.cs.po
r106 r108 58 58 msgstr "Můžete vrátit zpět jeden pohyb, pokud je akce vrátit zpět povolena." 59 59 60 #: formscore.sclearcaption 61 msgid "Clear score" 62 msgstr "Vymazat skóre" 63 64 #: formscore.sclearquery 65 msgid "Do you really want to clear score history?" 66 msgstr "Opravdu chcete vymazat historie skóre?" 67 60 68 #: formsettings.slanguagechangemessage 61 69 msgctxt "formsettings.slanguagechangemessage" … … 170 178 msgstr "Restart" 171 179 180 #: tcore.ascore.caption 181 msgctxt "tcore.ascore.caption" 182 msgid "Score" 183 msgstr "Skóre" 184 172 185 #: tcore.asettings.caption 173 186 msgctxt "tcore.asettings.caption" … … 290 303 msgstr "Neslučitelné dlaždice:" 291 304 305 #: tformscore.buttonclear.caption 306 msgid "Clear" 307 msgstr "Vymazat" 308 309 #: tformscore.buttonclose.caption 310 msgctxt "tformscore.buttonclose.caption" 311 msgid "Close" 312 msgstr "Zavřít" 313 314 #: tformscore.caption 315 msgctxt "tformscore.caption" 316 msgid "Score" 317 msgstr "Skóre" 318 319 #: tformscore.listview1.columns[0].caption 320 msgid "Time" 321 msgstr "Čas" 322 323 #: tformscore.listview1.columns[1].caption 324 msgctxt "tformscore.listview1.columns[1].caption" 325 msgid "Score" 326 msgstr "Skóre" 327 328 #: tformscore.listview1.columns[2].caption 329 msgid "Moves" 330 msgstr "Pohyby" 331 332 #: tformscore.listview1.columns[3].caption 333 msgid "Undos" 334 msgstr "Vrácení" 335 336 #: tformscore.listview1.columns[4].caption 337 msgid "Board size" 338 msgstr "Velikost desky" 339 292 340 #: tformsettings.buttoncancel.caption 293 341 msgctxt "tformsettings.buttoncancel.caption" -
trunk/Packages/Common/Common.pas
r102 r108 190 190 I: Integer; 191 191 begin 192 Result := Default(TStringArray); 192 193 SetLength(Result, GetEnvironmentVariableCount); 193 194 for I := 0 to GetEnvironmentVariableCount - 1 do -
trunk/Packages/Common/RegistryEx.pas
r89 r108 36 36 function ReadFloatWithDefault(const Name: string; 37 37 DefaultValue: Double): Double; 38 function ReadDateTimeWithDefault(const Name: string; DefaultValue: TDateTime): TDateTime; 38 39 function DeleteKeyRecursive(const Key: string): Boolean; 39 40 function OpenKey(const Key: string; CanCreate: Boolean): Boolean; … … 110 111 end; 111 112 113 function TRegistryEx.ReadDateTimeWithDefault(const Name: string; 114 DefaultValue: TDateTime): TDateTime; 115 begin 116 if ValueExists(Name) then Result := ReadDateTime(Name) 117 else begin 118 WriteDateTime(Name, DefaultValue); 119 Result := DefaultValue; 120 end; 121 end; 122 112 123 function TRegistryEx.DeleteKeyRecursive(const Key: string): Boolean; 113 124 var
Note:
See TracChangeset
for help on using the changeset viewer.