Changeset 108 for trunk


Ignore:
Timestamp:
Dec 10, 2024, 12:06:43 AM (5 weeks ago)
Author:
chronos
Message:
  • Added: Tools - Score menu action to show history of previously played games with score information.
Location:
trunk
Files:
8 added
11 edited

Legend:

Unmodified
Added
Removed
  • trunk/Core.lfm

    r95 r108  
    21332133      Caption = 'Moves history'
    21342134      OnExecute = AHistoryExecute
     2135      ShortCut = 117
    21352136    end
    21362137    object ARestart: TAction
     
    21382139      OnExecute = ARestartExecute
    21392140      ShortCut = 16466
     2141    end
     2142    object AScore: TAction
     2143      Caption = 'Score'
     2144      OnExecute = AScoreExecute
     2145      ShortCut = 116
    21402146    end
    21412147  end
  • trunk/Core.lrj

    r107 r108  
    99{"hash":1113,"name":"tcore.acomputer.caption","sourcebytes":[65,73],"value":"AI"},
    1010{"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"}
    1213]}
  • trunk/Core.pas

    r107 r108  
    55uses
    66  Classes, SysUtils, Theme, PersistentForm, ApplicationInfo, Translator,
    7   RegistryEx, ScaleDPI, Game, ActnList, Forms, Controls, Dialogs;
     7  RegistryEx, ScaleDPI, Game, ActnList, Forms, Controls, Dialogs, Score;
    88
    99type
     
    1414    AAbout: TAction;
    1515    AComputer: TAction;
     16    AScore: TAction;
    1617    ARestart: TAction;
    1718    AHistory: TAction;
     
    3435    procedure ANewExecute(Sender: TObject);
    3536    procedure ARestartExecute(Sender: TObject);
     37    procedure AScoreExecute(Sender: TObject);
    3638    procedure ASettingsExecute(Sender: TObject);
    3739    procedure AUndoExecute(Sender: TObject);
     
    4648    procedure GameOver(Sender: TObject);
    4749    procedure GameOverSync;
     50    procedure UpdateScores;
    4851  public
    4952    Game: TGame;
     53    Scores: TScores;
    5054    procedure UpdateInterface;
    5155    procedure LoadConfig;
     
    6367uses
    6468  FormMain, FormSettings, FormNew, FormHelp, FormComputer, FormAbout, FormEx,
    65   FormHistory;
     69  FormHistory, FormScore;
    6670
    6771resourcestring
     
    8993
    9094  Randomize;
     95  Scores := TScores.Create;
     96
    9197  Game := TGame.Create;
    9298  Game.Board.Size := Point(4, 4);
     
    182188  FormNew: TFormNew;
    183189begin
     190  UpdateScores;
    184191  FormNew := TFormNew.Create(nil);
    185192  try
     
    198205procedure TCore.ARestartExecute(Sender: TObject);
    199206begin
     207  UpdateScores;
    200208  Game.Restart;
    201209  UpdateInterface;
     
    203211end;
    204212
     213procedure TCore.AScoreExecute(Sender: TObject);
     214var
     215  FormScore: TFormScore;
     216begin
     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;
     226end;
     227
    205228procedure TCore.DataModuleDestroy(Sender: TObject);
    206229begin
     230  UpdateScores;
    207231  SaveConfig;
    208232  FreeAndNil(Game);
     233  FreeAndNil(Scores);
    209234end;
    210235
     
    232257begin
    233258  MessageDlg(SWinCaption, Format(SWinMessage, [Game.GetTileSkinValue(Game.WinTileValue)]), mtInformation, [mbOk], 0);
     259  UpdateScores;
    234260end;
    235261
     
    242268begin
    243269  MessageDlg(SGameOverCaption, SGameOverMessage, mtInformation, [mbOK], 0);
     270  UpdateScores;
     271end;
     272
     273procedure TCore.UpdateScores;
     274var
     275  Score: TScore;
     276begin
     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);
    244284end;
    245285
     
    258298
    259299procedure TCore.LoadConfig;
    260 begin
    261   with TRegistryEx.Create do
     300var
     301  Reg: TRegistryEx;
     302  RegContext: TRegistryContext;
     303begin
     304  Reg := TRegistryEx.Create;
     305  with Reg do
    262306  try
    263307    CurrentContext := ApplicationInfo1.GetRegistryContext;
     
    267311      else Translator1.Language := Translator1.Languages.SearchByCode('');
    268312    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;
    273320end;
    274321
    275322procedure TCore.SaveConfig;
    276 begin
    277   with TRegistryEx.Create do
     323var
     324  Reg: TRegistryEx;
     325  RegContext: TRegistryContext;
     326begin
     327  Reg := TRegistryEx.Create;
     328  with Reg do
    278329  try
    279330    CurrentContext := ApplicationInfo1.GetRegistryContext;
     
    283334      else DeleteValue('LanguageCode');
    284335    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;
    289343end;
    290344
  • trunk/Forms/FormMain.lfm

    r103 r108  
    11object FormMain: TFormMain
    22  Left = 534
    3   Height = 1027
     3  Height = 993
    44  Top = 223
    55  Width = 1491
     
    5454        Action = Core.ASettings
    5555      end
    56       object MenuItem4: TMenuItem
    57         Action = Core.AComputer
     56      object MenuItem7: TMenuItem
     57        Action = Core.AScore
    5858      end
    5959      object MenuItemMovesHistory: TMenuItem
    6060        Action = Core.AHistory
     61      end
     62      object MenuItem4: TMenuItem
     63        Action = Core.AComputer
    6164      end
    6265    end
  • trunk/Forms/FormMain.pas

    r104 r108  
    2828    MenuItem5: TMenuItem;
    2929    MenuItem6: TMenuItem;
     30    MenuItem7: TMenuItem;
    3031    MenuItemColorPalette: TMenuItem;
    3132    MenuItemTileSkin: TMenuItem;
  • trunk/Game.pas

    r107 r108  
    2727  TGame = class
    2828  private
     29    FMoves: Integer;
    2930    FMoving: Boolean;
    3031    FUnmergeableTilesCount: Integer;
     
    4142    FSkin: TTileSkin;
    4243    FDisabledTilesCount: Integer;
     44    FUsedUndos: Integer;
    4345    function GetTileColor(Value: Integer): TColor;
    4446    procedure SetRecordHistory(AValue: Boolean);
     
    7274    BackgroundColor: TColor;
    7375    Value2Chance: Double;
     76    StartTime: TDateTime;
    7477    procedure Replay(History: THistory; Step: Integer);
    7578    function CanUndo: Boolean;
     
    8790    procedure MoveTile(SourceTile, TargetTile: TTile);
    8891    function IsValidPos(Pos: TPoint): Boolean;
    89     procedure SaveToRegistry(RegContext: TRegistryContext);
    90     procedure LoadFromRegistry(RegContext: TRegistryContext);
     92    procedure SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
     93    procedure LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
    9194    function GetTileSkinValue(Value: Integer): string;
    9295    function GetTileSkinScore(Value: Integer): Integer;
     
    9497    destructor Destroy; override;
    9598    property Score: Integer read FScore write SetScore;
     99    property Moves: Integer read FMoves;
     100    property UsedUndos: Integer read FUsedUndos;
    96101    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;
    101102    property Moving: Boolean read FMoving;
    102103    property RecordHistory: Boolean read FRecordHistory write SetRecordHistory;
     
    105106    property DisabledTilesCount: Integer read FDisabledTilesCount write FDisabledTilesCount;
    106107    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;
    107112  end;
    108113
     
    317322  Difficulty = 0.7;
    318323begin
     324  FUsedUndos := 0;
     325  FMoves := 0;
    319326  FCanUndo := False;
    320327  Board.Clear;
     
    359366  end;
    360367  InitialBoard.Assign(Board);
     368  StartTime := Now;
    361369  AnimateTiles;
    362370  DoChange;
     
    368376  Reset;
    369377  Board.Assign(InitialBoard);
     378  StartTime := Now;
    370379  AnimateTiles;
    371380  DoChange;
     
    531540  TileMoved: Boolean;
    532541begin
     542  Inc(FMoves);
    533543  if Animation then begin
    534544    MoveAllAnimate(Direction);
     
    664674    Board.Assign(FBoardUndo);
    665675    FCanUndo := False;
     676    Inc(FUsedUndos);
    666677    FRunning := CanMove;
    667678    if RecordHistory then History.Moves.Delete(History.Moves.Count - 1);
     
    10331044end;
    10341045
    1035 procedure TGame.SaveToRegistry(RegContext: TRegistryContext);
    1036 var
    1037   Reg: TRegistryEx;
    1038 begin
    1039   Reg := TRegistryEx.Create;
    1040   with Reg do
    1041   try
     1046procedure TGame.SaveToRegistry(Reg: TRegistryEx; RegContext: TRegistryContext);
     1047begin
     1048  with Reg do begin
    10421049    CurrentContext := RegContext;
    10431050
     
    10531060    WriteInteger('DisabledTilesCount', DisabledTilesCount);
    10541061    WriteInteger('UnmergeableTilesCount', UnmergeableTilesCount);
     1062    WriteInteger('Moves', FMoves);
     1063    WriteInteger('UsedUndos', FUsedUndos);
     1064    WriteDateTime('StartTime', StartTime);
    10551065    FBoardUndo.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
    10561066    Board.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
    10571067    InitialBoard.SaveToRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialBoard'));
    10581068    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;
     1070end;
     1071
     1072procedure TGame.LoadFromRegistry(Reg: TRegistryEx; RegContext: TRegistryContext
     1073  );
     1074begin
     1075  with Reg do begin
    10711076    CurrentContext := RegContext;
    10721077    AnimationDuration := ReadIntegerWithDefault('AnimationDuration', 30);
     
    10811086    DisabledTilesCount := ReadIntegerWithDefault('DisabledTilesCount', DisabledTilesCount);
    10821087    UnmergeableTilesCount := ReadIntegerWithDefault('UnmergeableTilesCount', UnmergeableTilesCount);
     1088    FMoves := ReadIntegerWithDefault('Moves', FMoves);
     1089    FUsedUndos := ReadIntegerWithDefault('UsedUndos', FUsedUndos);
     1090    StartTime := ReadDateTimeWithDefault('StartTime', StartTime);
    10831091    FBoardUndo.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
    10841092    Board.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
    10851093    InitialBoard.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialBoard'));
    10861094    History.LoadFromRegistry(Reg, TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
    1087   finally
    1088     Free;
    10891095  end;
    10901096  DoChange;
  • trunk/Game2048.lpi

    r104 r108  
    9191      </Item2>
    9292    </RequiredPackages>
    93     <Units Count="12">
     93    <Units Count="14">
    9494      <Unit0>
    9595        <Filename Value="Game2048.lpr"/>
     
    161161        <IsPartOfProject Value="True"/>
    162162      </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>
    163173    </Units>
    164174  </ProjectOptions>
  • trunk/Game2048.lpr

    r104 r108  
    88  {$ENDIF}
    99  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
    1111  { you can add units after this };
    1212
  • trunk/Languages/Game2048.cs.po

    r106 r108  
    5858msgstr "Můžete vrátit zpět jeden pohyb, pokud je akce vrátit zpět povolena."
    5959
     60#: formscore.sclearcaption
     61msgid "Clear score"
     62msgstr "Vymazat skóre"
     63
     64#: formscore.sclearquery
     65msgid "Do you really want to clear score history?"
     66msgstr "Opravdu chcete vymazat historie skóre?"
     67
    6068#: formsettings.slanguagechangemessage
    6169msgctxt "formsettings.slanguagechangemessage"
     
    170178msgstr "Restart"
    171179
     180#: tcore.ascore.caption
     181msgctxt "tcore.ascore.caption"
     182msgid "Score"
     183msgstr "Skóre"
     184
    172185#: tcore.asettings.caption
    173186msgctxt "tcore.asettings.caption"
     
    290303msgstr "Neslučitelné dlaždice:"
    291304
     305#: tformscore.buttonclear.caption
     306msgid "Clear"
     307msgstr "Vymazat"
     308
     309#: tformscore.buttonclose.caption
     310msgctxt "tformscore.buttonclose.caption"
     311msgid "Close"
     312msgstr "Zavřít"
     313
     314#: tformscore.caption
     315msgctxt "tformscore.caption"
     316msgid "Score"
     317msgstr "Skóre"
     318
     319#: tformscore.listview1.columns[0].caption
     320msgid "Time"
     321msgstr "Čas"
     322
     323#: tformscore.listview1.columns[1].caption
     324msgctxt "tformscore.listview1.columns[1].caption"
     325msgid "Score"
     326msgstr "Skóre"
     327
     328#: tformscore.listview1.columns[2].caption
     329msgid "Moves"
     330msgstr "Pohyby"
     331
     332#: tformscore.listview1.columns[3].caption
     333msgid "Undos"
     334msgstr "Vrácení"
     335
     336#: tformscore.listview1.columns[4].caption
     337msgid "Board size"
     338msgstr "Velikost desky"
     339
    292340#: tformsettings.buttoncancel.caption
    293341msgctxt "tformsettings.buttoncancel.caption"
  • trunk/Packages/Common/Common.pas

    r102 r108  
    190190  I: Integer;
    191191begin
     192  Result := Default(TStringArray);
    192193  SetLength(Result, GetEnvironmentVariableCount);
    193194  for I := 0 to GetEnvironmentVariableCount - 1 do
  • trunk/Packages/Common/RegistryEx.pas

    r89 r108  
    3636    function ReadFloatWithDefault(const Name: string;
    3737      DefaultValue: Double): Double;
     38    function ReadDateTimeWithDefault(const Name: string; DefaultValue: TDateTime): TDateTime;
    3839    function DeleteKeyRecursive(const Key: string): Boolean;
    3940    function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
     
    110111end;
    111112
     113function TRegistryEx.ReadDateTimeWithDefault(const Name: string;
     114  DefaultValue: TDateTime): TDateTime;
     115begin
     116  if ValueExists(Name) then Result := ReadDateTime(Name)
     117    else begin
     118      WriteDateTime(Name, DefaultValue);
     119      Result := DefaultValue;
     120    end;
     121end;
     122
    112123function TRegistryEx.DeleteKeyRecursive(const Key: string): Boolean;
    113124var
Note: See TracChangeset for help on using the changeset viewer.