Changeset 12 for trunk


Ignore:
Timestamp:
Oct 5, 2019, 12:48:02 AM (5 years ago)
Author:
chronos
Message:
  • Added: Show wing dialog message if player gets cell with value 2048.
Location:
trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormMain.pas

    r11 r12  
    6262    if not Core.Game.CanMove and (Core.Game.GetEmptyCellsCount = 0) then
    6363      Core.Game.GameOver;
     64    if (not Core.Game.Won) and (Core.Game.GetHighestCellValue >= 2048) then
     65      Core.Game.Win;
    6466  end;
    6567end;
  • trunk/Languages/Game2048.cs.po

    r11 r12  
    120120msgstr "Verze"
    121121
    122 #: ugame.sgameover
    123 msgid "Game over"
    124 msgstr "Konec hry"
     122#: ugame.sgameovercaption
     123msgid "Lost"
     124msgstr ""
    125125
     126#: ugame.sgameovermessage
     127msgid "Game over!"
     128msgstr ""
     129
     130#: ugame.swincaption
     131msgid "Win"
     132msgstr ""
     133
     134#: ugame.swinmessage
     135msgid "You won! Do you want to continue to play?"
     136msgstr ""
     137
  • trunk/Languages/Game2048.po

    r11 r12  
    104104msgstr ""
    105105
    106 #: ugame.sgameover
    107 msgid "Game over"
     106#: ugame.sgameovercaption
     107msgid "Lost"
    108108msgstr ""
    109109
     110#: ugame.sgameovermessage
     111msgid "Game over!"
     112msgstr ""
     113
     114#: ugame.swincaption
     115msgid "Win"
     116msgstr ""
     117
     118#: ugame.swinmessage
     119msgid "You won! Do you want to continue to play?"
     120msgstr ""
     121
  • trunk/UCore.lfm

    r11 r12  
    2828    AppName = '2048'
    2929    Description = 'Classic 2048 game.'
    30     ReleaseDate = 43733
     30    ReleaseDate = 43742
    3131    RegistryKey = '\Software\Chronosoft\2048'
    3232    RegistryRoot = rrKeyCurrentUser
  • trunk/UGame.pas

    r11 r12  
    66
    77uses
    8   Classes, SysUtils, Dialogs, fgl, Graphics, Types, Forms, Math, DateUtils;
     8  Classes, SysUtils, Dialogs, fgl, Graphics, Types, Forms, Math, DateUtils,
     9  Controls;
    910
    1011type
     
    4546    TopScore: Integer;
    4647    AnimationDuration: Integer;
     48    Won: Boolean;
    4749    procedure GameOver;
     50    procedure Win;
    4851    function FillRandomCell: Integer;
    4952    function CanMove: Boolean;
    5053    function GetEmptyCellsCount: Integer;
     54    function GetHighestCellValue: Integer;
    5155    procedure Assign(Source: TGame);
    5256    procedure New;
     
    7175
    7276resourcestring
    73   SGameOver = 'Game over';
     77  SGameOverCaption = 'Lost';
     78  SGameOverMessage = 'Game over!';
     79  SWinCaption = 'Win';
     80  SWinMessage = 'You won! Do you want to continue to play?';
    7481
    7582
     
    128135procedure TGame.GameOver;
    129136begin
     137  if Running then MessageDlg(SGameOverCaption, SGameOverMessage, mtInformation, [mbOK], 0);
    130138  Running := False;
    131   ShowMessage(SGameOver);
     139end;
     140
     141procedure TGame.Win;
     142begin
     143  if not Won then begin
     144    Won := True;
     145    if MessageDlg(SWinCaption, SWinMessage, mtConfirmation,
     146    mbYesNo, 0) = mrNo then begin
     147      Running := False;
     148    end;
     149  end;
    132150end;
    133151
     
    154172  try
    155173    TempGame.Assign(Self);
     174    TempGame.AnimationDuration := 0;
    156175    Result := TempGame.MoveAll(drDown) > 0;
    157176    if Result then Exit;
     
    177196end;
    178197
     198function TGame.GetHighestCellValue: Integer;
     199var
     200  X, Y: Integer;
     201begin
     202  Result := 0;
     203  for Y := 0 to Size.Y - 1 do
     204    for X := 0 to Size.X - 1 do
     205      if Result < Cells[Y, X].Value then Result := Cells[Y, X].Value;
     206end;
     207
    179208procedure TGame.Assign(Source: TGame);
    180209var
    181210  X, Y: Integer;
    182211begin
     212  FScore := Source.FScore;
     213  TopScore := Source.TopScore;
     214  AnimationDuration := Source.AnimationDuration;
     215  Won := Source.Won;
    183216  Size := Source.Size;
    184217  for Y := 0 to Size.Y - 1 do
     
    193226  Clear;
    194227  Score := 0;
     228  Won := False;
    195229  Running := True;
    196230  for I := 0 to 1 do FillRandomCell;
     
    232266  Canvas.Font.Color := clWhite;
    233267  Canvas.Font.Height := Trunc(TopBarHeight * 0.7);
    234   Canvas.TextOut(ScaleY(106, 96), (TopBarHeight - Canvas.TextHeight(ValueStr)) div 2, ValueStr);
     268  Canvas.TextOut(ScaleY(136, 96), (TopBarHeight - Canvas.TextHeight(ValueStr)) div 2, ValueStr);
    235269
    236270  // Form.Canvas.Width and Form.Canvas.Height is not working correctly under Windows.
     
    409443      Time := Now;
    410444      Part := (Time - StartTime) / (EndTime - StartTime);
     445      if Part > 1 then Part := 1;
    411446      for Y := 0 to Size.Y - 1 do
    412447        for X := 0 to Size.X - 1 do begin
     
    417452      DoChange;
    418453      Application.ProcessMessages;
    419       Sleep(10);
     454      Sleep(1);
    420455    until Time > EndTime;
    421456
     
    423458    for Y := 0 to Size.Y - 1 do
    424459      for X := 0 to Size.X - 1 do begin
     460        Cells[Y, X].Shift := Point(0, 0);
     461        Cells[Y, X].Moving := False;
    425462        Cells[Y, X].Value := Cells[Y, X].NewValue;
    426         Cells[Y, X].Shift := Point(0, 0);
    427463      end;
    428464    DoChange;
Note: See TracChangeset for help on using the changeset viewer.