Changeset 11 for trunk


Ignore:
Timestamp:
Oct 4, 2019, 11:57:05 PM (5 years ago)
Author:
chronos
Message:
  • Added: Configurable speed of animations.
Location:
trunk
Files:
1 added
11 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r8 r11  
    2020      Caption = 'Game'
    2121      object MenuItemNew: TMenuItem
    22         Action = AGameNew
     22        Action = Core.AGameNew
     23      end
     24      object MenuItem1: TMenuItem
     25        Action = Core.ASettings
    2326      end
    2427      object MenuItemExit: TMenuItem
    25         Action = AExit
     28        Action = Core.AExit
    2629      end
    2730    end
    … …  
    2932      Caption = 'Help'
    3033      object MenuItemAbout: TMenuItem
    31         Action = AAbout
     34        Action = Core.AAbout
    3235      end
    3336    end
    3437  end
    35   object ActionList1: TActionList
    36     left = 144
     38  object TimerDraw: TTimer
     39    Interval = 20
     40    OnTimer = TimerDrawTimer
     41    left = 138
    3742    top = 152
    38     object AGameNew: TAction
    39       Caption = 'New...'
    40       OnExecute = AGameNewExecute
    41     end
    42     object AExit: TAction
    43       Caption = 'Exit'
    44       OnExecute = AExitExecute
    45     end
    46     object AAbout: TAction
    47       Caption = 'About'
    48       OnExecute = AAboutExecute
    49     end
    5043  end
    5144end

  • trunk/Forms/UFormMain.lrj

    r8 r11  
    22{"hash":128377605,"name":"tformmain.caption","sourcebytes":[50,48,52,56,32,103,97,109,101],"value":"2048 game"},
    33{"hash":317493,"name":"tformmain.menuitemgame.caption","sourcebytes":[71,97,109,101],"value":"Game"},
    4 {"hash":322608,"name":"tformmain.menuitemhelp.caption","sourcebytes":[72,101,108,112],"value":"Help"},
    5 {"hash":88908046,"name":"tformmain.agamenew.caption","sourcebytes":[78,101,119,46,46,46],"value":"New..."},
    6 {"hash":315140,"name":"tformmain.aexit.caption","sourcebytes":[69,120,105,116],"value":"Exit"},
    7 {"hash":4691652,"name":"tformmain.aabout.caption","sourcebytes":[65,98,111,117,116],"value":"About"}
     4{"hash":322608,"name":"tformmain.menuitemhelp.caption","sourcebytes":[72,101,108,112],"value":"Help"}
    85]}

  • trunk/Forms/UFormMain.pas

    r10 r11  
    1414
    1515  TFormMain = class(TForm)
    16     AAbout: TAction;
    17     AExit: TAction;
    18     AGameNew: TAction;
    19     ActionList1: TActionList;
    2016    MainMenu1: TMainMenu;
     17    MenuItem1: TMenuItem;
    2118    MenuItemNew: TMenuItem;
    2219    MenuItemExit: TMenuItem;
    … …  
    2421    MenuItemAbout: TMenuItem;
    2522    MenuItemGame: TMenuItem;
    26     procedure AAboutExecute(Sender: TObject);
    27     procedure AExitExecute(Sender: TObject);
    28     procedure AGameNewExecute(Sender: TObject);
     23    TimerDraw: TTimer;
    2924    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    3025    procedure FormCreate(Sender: TObject);
    … …  
    3328    procedure FormPaint(Sender: TObject);
    3429    procedure FormShow(Sender: TObject);
     30    procedure TimerDrawTimer(Sender: TObject);
    3531  private
     32    RedrawPending: Boolean;
    3633  public
     34    procedure Redraw;
    3735  end;
    3836
    … …  
    4543
    4644uses
    47   UCore, UFormNew, UFormAbout;
     45  UCore;
    4846
    4947{ TFormMain }
    … …  
    5351  MovedCount: Integer;
    5452begin
    55   if Core.Game.Running then begin
     53  if Core.Game.Running and not Core.Game.Moving then begin
    5654    MovedCount := 0;
    5755    case Key of
    … …  
    7270end;
    7371
    74 procedure TFormMain.AGameNewExecute(Sender: TObject);
    75 begin
    76   FormNew := TFormNew.Create(nil);
    77   try
    78     FormNew.Load(Core.Game);
    79     if FormNew.ShowModal = mrOk then begin
    80       FormNew.Save(Core.Game);
    81       Core.Game.New;
    82     end;
    83   finally
    84     FreeAndNil(FormNew);
    85   end;
    86 end;
    87 
    8872procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
    8973begin
    9074  Core.PersistentForm1.Save(Self);
    91 end;
    92 
    93 procedure TFormMain.AExitExecute(Sender: TObject);
    94 begin
    95   Close;
    96 end;
    97 
    98 procedure TFormMain.AAboutExecute(Sender: TObject);
    99 begin
    100   FormAbout := TFormAbout.Create(nil);
    101   try
    102     FormAbout.ApplicationInfo := Core.ApplicationInfo1;
    103     FormAbout.ShowModal;
    104   finally
    105     FreeAndNil(FormAbout);
    106   end;
    10775end;
    10876
    … …  
    12290end;
    12391
     92procedure TFormMain.TimerDrawTimer(Sender: TObject);
     93begin
     94  if RedrawPending then begin
     95    RedrawPending := False;
     96    Repaint;
     97  end;
     98end;
     99
     100procedure TFormMain.Redraw;
     101begin
     102  RedrawPending := True;
     103end;
     104
    124105end.
    125106

  • trunk/Forms/UFormSettings.lfm

    r8 r11  
    55  Width = 480
    66  Caption = 'Settings'
     7  ClientHeight = 360
     8  ClientWidth = 480
    79  DesignTimePPI = 144
     10  OnShow = FormShow
    811  LCLVersion = '2.0.2.0'
     12  object Label1: TLabel
     13    Left = 19
     14    Height = 26
     15    Top = 24
     16    Width = 150
     17    Caption = 'Animation speed:'
     18    ParentColor = False
     19  end
     20  object TrackBar1: TTrackBar
     21    Left = 208
     22    Height = 58
     23    Top = 16
     24    Width = 240
     25    Max = 100
     26    Position = 0
     27    Anchors = [akTop, akLeft, akRight]
     28    TabOrder = 0
     29  end
     30  object ButtonOk: TButton
     31    Left = 112
     32    Height = 38
     33    Top = 291
     34    Width = 113
     35    Anchors = [akLeft, akBottom]
     36    Caption = 'OK'
     37    OnClick = ButtonOkClick
     38    TabOrder = 1
     39  end
     40  object ButtonCancel: TButton
     41    Left = 256
     42    Height = 38
     43    Top = 288
     44    Width = 113
     45    Anchors = [akLeft, akBottom]
     46    Caption = 'Cancel'
     47    OnClick = ButtonCancelClick
     48    TabOrder = 2
     49  end
    950end

  • trunk/Forms/UFormSettings.lrj

    r8 r11  
    11{"version":1,"strings":[
    2 {"hash":213582195,"name":"tformsettings.caption","sourcebytes":[83,101,116,116,105,110,103,115],"value":"Settings"}
     2{"hash":213582195,"name":"tformsettings.caption","sourcebytes":[83,101,116,116,105,110,103,115],"value":"Settings"},
     3{"hash":69745274,"name":"tformsettings.label1.caption","sourcebytes":[65,110,105,109,97,116,105,111,110,32,115,112,101,101,100,58],"value":"Animation speed:"},
     4{"hash":1339,"name":"tformsettings.buttonok.caption","sourcebytes":[79,75],"value":"OK"},
     5{"hash":77089212,"name":"tformsettings.buttoncancel.caption","sourcebytes":[67,97,110,99,101,108],"value":"Cancel"}
    36]}

  • trunk/Forms/UFormSettings.pas

    r8 r11  
    66
    77uses
    8   Classes, SysUtils, Forms, Controls, Graphics, Dialogs;
     8  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls;
    99
    1010type
     11
     12  { TFormSettings }
     13
    1114  TFormSettings = class(TForm)
     15    ButtonOk: TButton;
     16    ButtonCancel: TButton;
     17    Label1: TLabel;
     18    TrackBar1: TTrackBar;
     19    procedure ButtonCancelClick(Sender: TObject);
     20    procedure ButtonOkClick(Sender: TObject);
     21    procedure FormShow(Sender: TObject);
    1222  private
    1323
    … …  
    2333{$R *.lfm}
    2434
     35uses
     36  UCore;
     37
     38{ TFormSettings }
     39
     40procedure TFormSettings.ButtonCancelClick(Sender: TObject);
     41begin
     42  Close;
     43end;
     44
     45procedure TFormSettings.ButtonOkClick(Sender: TObject);
     46begin
     47  Core.Game.AnimationDuration := TrackBar1.Position;
     48  Close;
     49end;
     50
     51procedure TFormSettings.FormShow(Sender: TObject);
     52begin
     53  TrackBar1.Position := Core.Game.AnimationDuration;
     54end;
     55
    2556end.
    2657

  • trunk/Languages/Game2048.cs.po

    r8 r11  
    1111"Language: cs\n"
    1212"X-Generator: Poedit 2.2.1\n"
     13
     14#: tcore.aabout.caption
     15#, fuzzy
     16msgctxt "tcore.aabout.caption"
     17msgid "About"
     18msgstr "O aplikaci"
     19
     20#: tcore.aexit.caption
     21#, fuzzy
     22msgctxt "tcore.aexit.caption"
     23msgid "Exit"
     24msgstr "Ukončít"
     25
     26#: tcore.agamenew.caption
     27#, fuzzy
     28msgctxt "tcore.agamenew.caption"
     29msgid "New..."
     30msgstr "Nová..."
     31
     32#: tcore.asettings.caption
     33#, fuzzy
     34msgctxt "tcore.asettings.caption"
     35msgid "Settings"
     36msgstr "Nastavení"
    1337
    1438#: tformabout.buttonclose.caption
    … …  
    3357msgstr "   "
    3458
    35 #: tformmain.aabout.caption
    36 msgctxt "tformmain.aabout.caption"
    37 msgid "About"
    38 msgstr "O aplikaci"
    39 
    40 #: tformmain.aexit.caption
    41 msgid "Exit"
    42 msgstr "Ukončít"
    43 
    44 #: tformmain.agamenew.caption
    45 msgid "New..."
    46 msgstr "Nová..."
    47 
    4859#: tformmain.caption
    4960msgid "2048 game"
    … …  
    5970
    6071#: tformnew.buttoncancel.caption
     72msgctxt "tformnew.buttoncancel.caption"
    6173msgid "Cancel"
    6274msgstr "Zrušit"
    6375
    6476#: tformnew.buttonok.caption
     77msgctxt "tformnew.buttonok.caption"
    6578msgid "OK"
    6679msgstr "OK"
    … …  
    7487msgstr "Velikost desky:"
    7588
     89#: tformsettings.buttoncancel.caption
     90#, fuzzy
     91msgctxt "tformsettings.buttoncancel.caption"
     92msgid "Cancel"
     93msgstr "Zrušit"
     94
     95#: tformsettings.buttonok.caption
     96#, fuzzy
     97msgctxt "tformsettings.buttonok.caption"
     98msgid "OK"
     99msgstr "OK"
     100
    76101#: tformsettings.caption
     102msgctxt "tformsettings.caption"
    77103msgid "Settings"
    78104msgstr "Nastavení"
     105
     106#: tformsettings.label1.caption
     107msgid "Animation speed:"
     108msgstr ""
    79109
    80110#: uformabout.slicense
    … …  
    93123msgid "Game over"
    94124msgstr "Konec hry"
     125

  • trunk/Languages/Game2048.po

    r8 r11  
    11msgid ""
    22msgstr "Content-Type: text/plain; charset=UTF-8"
     3
     4#: tcore.aabout.caption
     5msgctxt "tcore.aabout.caption"
     6msgid "About"
     7msgstr ""
     8
     9#: tcore.aexit.caption
     10msgctxt "tcore.aexit.caption"
     11msgid "Exit"
     12msgstr ""
     13
     14#: tcore.agamenew.caption
     15msgctxt "tcore.agamenew.caption"
     16msgid "New..."
     17msgstr ""
     18
     19#: tcore.asettings.caption
     20msgctxt "tcore.asettings.caption"
     21msgid "Settings"
     22msgstr ""
    323
    424#: tformabout.buttonclose.caption
    … …  
    2343msgstr ""
    2444
    25 #: tformmain.aabout.caption
    26 msgctxt "tformmain.aabout.caption"
    27 msgid "About"
    28 msgstr ""
    29 
    30 #: tformmain.aexit.caption
    31 msgid "Exit"
    32 msgstr ""
    33 
    34 #: tformmain.agamenew.caption
    35 msgid "New..."
    36 msgstr ""
    37 
    3845#: tformmain.caption
    3946msgid "2048 game"
    … …  
    4956
    5057#: tformnew.buttoncancel.caption
     58msgctxt "tformnew.buttoncancel.caption"
    5159msgid "Cancel"
    5260msgstr ""
    5361
    5462#: tformnew.buttonok.caption
     63msgctxt "tformnew.buttonok.caption"
    5564msgid "OK"
    5665msgstr ""
    … …  
    6473msgstr ""
    6574
     75#: tformsettings.buttoncancel.caption
     76msgctxt "tformsettings.buttoncancel.caption"
     77msgid "Cancel"
     78msgstr ""
     79
     80#: tformsettings.buttonok.caption
     81msgctxt "tformsettings.buttonok.caption"
     82msgid "OK"
     83msgstr ""
     84
    6685#: tformsettings.caption
     86msgctxt "tformsettings.caption"
    6787msgid "Settings"
     88msgstr ""
     89
     90#: tformsettings.label1.caption
     91msgid "Animation speed:"
    6892msgstr ""
    6993

  • trunk/UCore.lfm

    r10 r11  
    4040    top = 295
    4141  end
     42  object ActionList1: TActionList
     43    left = 420
     44    top = 184
     45    object AGameNew: TAction
     46      Caption = 'New...'
     47      OnExecute = AGameNewExecute
     48    end
     49    object AExit: TAction
     50      Caption = 'Exit'
     51      OnExecute = AExitExecute
     52    end
     53    object AAbout: TAction
     54      Caption = 'About'
     55      OnExecute = AAboutExecute
     56    end
     57    object ASettings: TAction
     58      Caption = 'Settings'
     59      OnExecute = ASettingsExecute
     60    end
     61  end
    4262end

  • trunk/UCore.pas

    r10 r11  
    77uses
    88  Classes, SysUtils, UTheme, UPersistentForm, UApplicationInfo, UTranslator,
    9   URegistry, UGame;
     9  URegistry, UGame, ActnList, Forms, Controls;
    1010
    1111type
    … …  
    1414
    1515  TCore = class(TDataModule)
     16    AAbout: TAction;
     17    ASettings: TAction;
     18    ActionList1: TActionList;
     19    AExit: TAction;
     20    AGameNew: TAction;
    1621    ApplicationInfo1: TApplicationInfo;
    1722    PersistentForm1: TPersistentForm;
    1823    ThemeManager1: TThemeManager;
    1924    Translator1: TTranslator;
     25    procedure AAboutExecute(Sender: TObject);
     26    procedure AExitExecute(Sender: TObject);
     27    procedure AGameNewExecute(Sender: TObject);
     28    procedure ASettingsExecute(Sender: TObject);
    2029    procedure DataModuleCreate(Sender: TObject);
    2130    procedure DataModuleDestroy(Sender: TObject);
    … …  
    3645
    3746uses
    38   UFormMain;
     47  UFormMain, UFormSettings, UFormAbout, UFormNew;
    3948
    4049{ TCore }
    … …  
    4958end;
    5059
     60procedure TCore.ASettingsExecute(Sender: TObject);
     61begin
     62  FormSettings := TFormSettings.Create(nil);
     63  try
     64    FormSettings.ShowModal;
     65  finally
     66    FreeAndNil(FormSettings);
     67  end;
     68end;
     69
     70procedure TCore.AAboutExecute(Sender: TObject);
     71begin
     72  FormAbout := TFormAbout.Create(nil);
     73  try
     74    FormAbout.ApplicationInfo := Core.ApplicationInfo1;
     75    FormAbout.ShowModal;
     76  finally
     77    FreeAndNil(FormAbout);
     78  end;
     79end;
     80
     81procedure TCore.AExitExecute(Sender: TObject);
     82begin
     83  FormMain.Close;
     84end;
     85
     86procedure TCore.AGameNewExecute(Sender: TObject);
     87begin
     88  FormNew := TFormNew.Create(nil);
     89  try
     90    FormNew.Load(Core.Game);
     91    if FormNew.ShowModal = mrOk then begin
     92      FormNew.Save(Core.Game);
     93      Game.New;
     94    end;
     95  finally
     96    FreeAndNil(FormNew);
     97  end;
     98end;
     99
    51100procedure TCore.DataModuleDestroy(Sender: TObject);
    52101begin
    … …  
    57106procedure TCore.GameChange(Sender: TObject);
    58107begin
    59   FormMain.Repaint;
     108  FormMain.Redraw;
    60109end;
    61110
    … …  
    67116
    68117    Game.TopScore := ReadIntegerWithDefault('TopScore', 0);
     118    Game.Size := Point(ReadIntegerWithDefault('SizeX', 4), ReadIntegerWithDefault('SizeY', 4));
     119    Game.AnimationDuration := ReadIntegerWithDefault('AnimationDuration', 30);
    69120  finally
    70121    Free;
    … …  
    79130
    80131    WriteInteger('TopScore', Game.TopScore);
     132    WriteInteger('SizeX', Game.Size.X);
     133    WriteInteger('SizeY', Game.Size.Y);
     134    WriteInteger('AnimationDuration', Game.AnimationDuration);
    81135  finally
    82136    Free;

  • trunk/UGame.pas

    r10 r11  
    66
    77uses
    8   Classes, SysUtils, Dialogs, fgl, Graphics, Types, Forms, Math;
     8  Classes, SysUtils, Dialogs, fgl, Graphics, Types, Forms, Math, DateUtils;
    99
    1010type
    … …  
    3030  TGame = class
    3131  private
     32    FMoving: Boolean;
    3233    FOnChange: TNotifyEvent;
    3334    FRunning: Boolean;
    … …  
    4344    Cells: array of array of TCell;
    4445    TopScore: Integer;
     46    AnimationDuration: Integer;
    4547    procedure GameOver;
    4648    function FillRandomCell: Integer;
    … …  
    6062    property Running: Boolean read FRunning write FRunning;
    6163    property OnChange: TNotifyEvent read FOnChange write FOnChange;
     64    property Moving: Boolean read FMoving;
    6265  end;
    6366
    … …  
    318321  MovedCount: Integer;
    319322  X, Y: Integer;
    320   Step: Integer;
    321323  I: Integer;
    322 const
    323   StepCount = 10;
    324   AnimationDuration = 30;
    325 begin
     324  StartTime: TDateTime;
     325  EndTime: TDateTime;
     326  Time: TDateTime;
     327  Part: Double;
     328begin
     329  FMoving := True;
    326330  //Diff := DirectionDiff[Direction];
    327331  case Direction of
    … …  
    397401      Inc(PI.Y);
    398402    end;
    399     for Step := 0 to StepCount - 2 do begin
     403
     404    // Animate cell move
     405    StartTime := Now;
     406    EndTime := StartTime + AnimationDuration / 300 * OneSecond / Size.X;
     407    if AnimationDuration > 0 then
     408    repeat
     409      Time := Now;
     410      Part := (Time - StartTime) / (EndTime - StartTime);
    400411      for Y := 0 to Size.Y - 1 do
    401412        for X := 0 to Size.X - 1 do begin
    402413          if Cells[Y, X].Moving then
    403             Cells[Y, X].Shift := Point(Trunc(Step / StepCount * MoveDirection.X * 100),
    404               Trunc(Step / StepCount * MoveDirection.Y * 100));
     414            Cells[Y, X].Shift := Point(Trunc(Part * MoveDirection.X * 100),
     415              Trunc(Part * MoveDirection.Y * 100));
    405416        end;
    406417      DoChange;
    407418      Application.ProcessMessages;
    408       Sleep(AnimationDuration div StepCount);
    409     end;
     419      Sleep(10);
     420    until Time > EndTime;
     421
     422    // Set final cell values
    410423    for Y := 0 to Size.Y - 1 do
    411424      for X := 0 to Size.X - 1 do begin
    … …  
    416429  end;
    417430  Result := MovedCount;
     431  FMoving := False;
    418432end;
    419433
    … …  
    434448constructor TGame.Create;
    435449begin
     450  AnimationDuration := 30;
    436451end;
    437452
Note: See TracChangeset for help on using the changeset viewer.