Changeset 79


Ignore:
Timestamp:
Feb 11, 2021, 11:20:18 PM (3 years ago)
Author:
chronos
Message:
  • Added: Toggle full screen mode (F11) from View main menu.
  • Modified: Updated Common package files.
Location:
trunk
Files:
3 added
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r72 r79  
    1818  LCLVersion = '2.0.10.0'
    1919  object MainMenu1: TMainMenu
    20     Left = 325
     20    Left = 328
    2121    Top = 152
    2222    object MenuItemGame: TMenuItem
    … …  
    3333      object MenuItemExit: TMenuItem
    3434        Action = Core.AExit
     35      end
     36    end
     37    object MenuItem5: TMenuItem
     38      Caption = 'View'
     39      object MenuItemFullScreen: TMenuItem
     40        Caption = 'Full screen'
     41        ShortCut = 122
     42        OnClick = MenuItemFullScreenClick
    3543      end
    3644    end

  • trunk/Forms/UFormMain.lrj

    r72 r79  
    22{"hash":217976,"name":"tformmain.caption","sourcebytes":[50,48,52,56],"value":"2048"},
    33{"hash":317493,"name":"tformmain.menuitemgame.caption","sourcebytes":[71,97,109,101],"value":"Game"},
     4{"hash":380871,"name":"tformmain.menuitem5.caption","sourcebytes":[86,105,101,119],"value":"View"},
     5{"hash":131549534,"name":"tformmain.menuitemfullscreen.caption","sourcebytes":[70,117,108,108,32,115,99,114,101,101,110],"value":"Full screen"},
    46{"hash":5989939,"name":"tformmain.menuitemtools.caption","sourcebytes":[84,111,111,108,115],"value":"Tools"},
    57{"hash":322608,"name":"tformmain.menuitemhelp.caption","sourcebytes":[72,101,108,112],"value":"Help"}

  • trunk/Forms/UFormMain.pas

    r72 r79  
    2828    MenuItem3: TMenuItem;
    2929    MenuItem4: TMenuItem;
     30    MenuItem5: TMenuItem;
     31    MenuItemFullScreen: TMenuItem;
    3032    MenuItemMovesHistory: TMenuItem;
    3133    MenuItemTools: TMenuItem;
    … …  
    4749    procedure FormPaint(Sender: TObject);
    4850    procedure FormShow(Sender: TObject);
     51    procedure MenuItemFullScreenClick(Sender: TObject);
    4952    procedure TimerDrawTimer(Sender: TObject);
    5053    procedure EraseBackground(DC: HDC); override;
    … …  
    5659    MoveBuffer: array of TMoveDirection;
    5760    MoveBufferLock: TCriticalSection;
     61    FullScreen: Boolean;
    5862    procedure AddToMoveBuffer(Direction: TMoveDirection);
    5963    procedure ProcessMoveBuffer;
     64    procedure ToggleFullscreen;
    6065  public
    6166    MoveThread: TMoveThread;
    … …  
    8792
    8893procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     94const
     95  KeyLeft = 37;
     96  KeyUp = 38;
     97  KeyRight = 39;
     98  KeyDown = 40;
    8999begin
    90100  if Core.Game.Running then begin
    91101    case Key of
    92       37: AddToMoveBuffer(drLeft);
    93       38: AddToMoveBuffer(drUp);
    94       39: AddToMoveBuffer(drRight);
    95       40: AddToMoveBuffer(drDown);
     102      KeyLeft: AddToMoveBuffer(drLeft);
     103      KeyUp: AddToMoveBuffer(drUp);
     104      KeyRight: AddToMoveBuffer(drRight);
     105      KeyDown: AddToMoveBuffer(drDown);
    96106    end;
    97107    //ProcessMoveBuffer;
    … …  
    184194  Core.PersistentForm1.RegistryContext := Core.ApplicationInfo1.GetRegistryContext;
    185195  Core.PersistentForm1.Load(Self);
     196  FullScreen := Core.PersistentForm1.FormFullScreen;
    186197  Core.ThemeManager1.UseTheme(Self);
    187198  UpdateInterface;
    … …  
    189200    InitialTileCount then
    190201    Core.Game.New;
     202end;
     203
     204procedure TFormMain.MenuItemFullScreenClick(Sender: TObject);
     205begin
     206  ToggleFullscreen;
    191207end;
    192208
    … …  
    235251end;
    236252
     253procedure TFormMain.ToggleFullscreen;
     254begin
     255  FullScreen := not FullScreen;
     256  Core.PersistentForm1.SetFullScreen(FormMain.FullScreen);
     257  UpdateInterface;
     258end;
     259
    237260procedure TFormMain.Redraw;
    238261begin
    … …  
    245268  ToolsVisible: Boolean;
    246269begin
     270  MenuItemFullScreen.Checked := FullScreen;
    247271  MenuItemMovesHistory.Visible := Core.Game.RecordHistory;
    248272  ToolsVisible := False;

  • trunk/Forms/UFormNew.lfm

    r49 r79  
    1111  OnCreate = FormCreate
    1212  OnShow = FormShow
    13   LCLVersion = '2.0.2.0'
     13  LCLVersion = '2.0.10.0'
    1414  object Label1: TLabel
    1515    Left = 16
    16     Height = 26
     16    Height = 24
    1717    Top = 16
    1818    Width = 93
    … …  
    7474    Height = 30
    7575    Top = 88
    76     Width = 210
     76    Width = 209
    7777    Caption = 'Record moves history'
    7878    TabOrder = 4
    … …  
    8080  object Label2: TLabel
    8181    Left = 16
    82     Height = 26
     82    Height = 24
    8383    Top = 125
    8484    Width = 75
    … …  
    8888  object ComboBoxSkin: TComboBox
    8989    Left = 173
    90     Height = 38
     90    Height = 37
    9191    Top = 120
    9292    Width = 262

  • trunk/Languages/Game2048.cs.po

    r70 r79  
    55"POT-Creation-Date: \n"
    66"PO-Revision-Date: \n"
    7 "Last-Translator: \n"
     7"Last-Translator: Chronos <robie@centrum.cz>\n"
    88"Language-Team: \n"
    99"MIME-Version: 1.0\n"
    1010"Content-Transfer-Encoding: 8bit\n"
    1111"Language: cs\n"
    12 "X-Generator: Poedit 2.2.4\n"
     12"X-Generator: Poedit 2.4.1\n"
    1313
    1414#: tcore.aabout.caption
    … …  
    103103msgstr "2048"
    104104
     105#: tformmain.menuitem5.caption
     106msgid "View"
     107msgstr "Zobrazení"
     108
     109#: tformmain.menuitemfullscreen.caption
     110msgid "Full screen"
     111msgstr "Celá obrazovka"
     112
    105113#: tformmain.menuitemgame.caption
    106114msgid "Game"
    … …  
    244252#: ugame.sskinbinary
    245253msgid "Binary"
    246 msgstr ""
     254msgstr "Binární"
    247255
    248256#: ugame.sskinlinear
    … …  
    255263
    256264#: ugame.sskinroman
    257 #, fuzzy
    258 #| msgid "Roman numerals"
    259265msgid "Roman"
    260266msgstr "Římské číslice"
    … …  
    267273msgid "Top score"
    268274msgstr "Nejvyšší skóre"
    269 

  • trunk/Languages/Game2048.po

    r70 r79  
    9393msgstr ""
    9494
     95#: tformmain.menuitem5.caption
     96msgid "View"
     97msgstr ""
     98
     99#: tformmain.menuitemfullscreen.caption
     100msgid "Full screen"
     101msgstr ""
     102
    95103#: tformmain.menuitemgame.caption
    96104msgid "Game"

  • trunk/Packages/Common/UApplicationInfo.pas

    r7 r79  
    66
    77uses
    8   SysUtils, Classes, Forms, URegistry, Controls;
     8  SysUtils, Classes, Forms, URegistry, Controls, Graphics;
    99
    1010type
    … …  
    1515  private
    1616    FDescription: TCaption;
     17    FIcon: TBitmap;
    1718    FIdentification: Byte;
    1819    FLicense: string;
    … …  
    3334  public
    3435    constructor Create(AOwner: TComponent); override;
     36    destructor Destroy; override;
    3537    property Version: string read GetVersion;
    3638    function GetRegistryContext: TRegistryContext;
    … …  
    5254    property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot;
    5355    property License: string read FLicense write FLicense;
     56    property Icon: TBitmap read FIcon write FIcon;
    5457  end;
    5558
    … …  
    7477constructor TApplicationInfo.Create(AOwner: TComponent);
    7578begin
    76   inherited Create(AOwner);
     79  inherited;
    7780  FVersionMajor := 1;
    7881  FIdentification := 1;
    … …  
    8083  FRegistryKey := '\Software\' + FAppName;
    8184  FRegistryRoot := rrKeyCurrentUser;
     85  FIcon := TBitmap.Create;
     86end;
     87
     88destructor TApplicationInfo.Destroy;
     89begin
     90  FreeAndNil(FIcon);
     91  inherited;
    8292end;
    8393

  • trunk/Packages/Common/UMetaCanvas.pas

    r69 r79  
    66
    77uses
    8   Classes, SysUtils, Graphics, Contnrs, Types;
     8  Classes, SysUtils, Graphics, Contnrs, Types, fgl;
    99
    1010type
    … …  
    1717    procedure Zoom(Factor: Double); virtual;
    1818    procedure Move(Delta: TPoint); virtual;
     19  end;
     20
     21  TCanvasObjects = class(TFPGObjectList<TCanvasObject>)
    1922  end;
    2023
    … …  
    133136    procedure DoLineTo(X, Y: Integer); override;
    134137  public
    135     Objects: TObjectList;
     138    Objects: TCanvasObjects;
    136139    procedure FillRect(const ARect: TRect); overload; override;
    137140    procedure FillRect(X1,Y1,X2,Y2: Integer); overload;
    … …  
    145148    procedure Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2,
    146149      StartX, StartY, EndX, EndY: Integer); override;
    147     procedure SetSize(Size: TPoint);
    148150    procedure Reset;
    149151    procedure DrawTo(Canvas: TCanvas);
    … …  
    152154    constructor Create;
    153155    destructor Destroy; override;
    154   end;
     156    property Size: TPoint read FSize write FSize;
     157  end;
     158
    155159
    156160implementation
    … …  
    198202  Pen.Free;
    199203  Brush.Free;
    200   inherited Destroy;
     204  inherited;
    201205end;
    202206
    … …  
    228232destructor TCanvasStretchDraw.Destroy;
    229233begin
    230   inherited Destroy;
     234  inherited;
    231235end;
    232236
    … …  
    264268  Pen.Free;
    265269  Brush.Free;
    266   inherited Destroy;
     270  inherited;
    267271end;
    268272
    … …  
    304308  Brush.Free;
    305309  Pen.Free;
    306   inherited Destroy;
     310  inherited;
    307311end;
    308312
    … …  
    336340begin
    337341  Pen.Free;
    338   inherited Destroy;
     342  inherited;
    339343end;
    340344
    … …  
    375379  Pen.Free;
    376380  Brush.Free;
    377   inherited Destroy;
     381  inherited;
    378382end;
    379383
    … …  
    408412  Brush.Free;
    409413  Font.Free;
    410   inherited Destroy;
     414  inherited;
    411415end;
    412416
    … …  
    618622end;
    619623
    620 procedure TMetaCanvas.SetSize(Size: TPoint);
    621 begin
    622   FSize := Size;
    623 end;
    624 
    625624procedure TMetaCanvas.Reset;
    626625begin
    … …  
    633632begin
    634633  for I := 0 to Objects.Count - 1 do
    635     TCanvasObject(Objects[I]).Paint(Canvas);
     634    Objects[I].Paint(Canvas);
    636635end;
    637636
    … …  
    641640begin
    642641  for I := 0 to Objects.Count - 1 do
    643     TCanvasObject(Objects[I]).Zoom(Factor);
     642    Objects[I].Zoom(Factor);
    644643end;
    645644
    … …  
    649648begin
    650649  for I := 0 to Objects.Count - 1 do
    651     TCanvasObject(Objects[I]).Move(Delta);
     650    Objects[I].Move(Delta);
    652651end;
    653652
    … …  
    656655  inherited;
    657656  FPenPos := Point(0, 0);
    658   Objects := TObjectList.Create;
     657  Objects := TCanvasObjects.Create;
    659658end;
    660659
    … …  
    662661begin
    663662  Objects.Free;
    664   inherited Destroy;
     663  inherited;
    665664end;
    666665

  • trunk/Packages/Common/UPersistentForm.pas

    r7 r79  
    33{$mode delphi}
    44
    5 // Date: 2015-04-18
     5// Date: 2020-11-26
    66
    77interface
    … …  
    99uses
    1010  Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls,
    11   ExtCtrls;
     11  ExtCtrls, LCLType;
    1212
    1313type
    … …  
    2626    FormRestoredSize: TRect;
    2727    FormWindowState: TWindowState;
     28    FormFullScreen: Boolean;
    2829    Form: TForm;
    2930    procedure LoadFromRegistry(RegistryContext: TRegistryContext);
    … …  
    3132    function CheckEntireVisible(Rect: TRect): TRect;
    3233    function CheckPartVisible(Rect: TRect; Part: Integer): TRect;
    33     procedure Load(Form: TForm; DefaultMaximized: Boolean = False);
     34    procedure Load(Form: TForm; DefaultMaximized: Boolean = False;
     35      DefaultFullScreen: Boolean = False);
    3436    procedure Save(Form: TForm);
    3537    constructor Create(AOwner: TComponent); override;
     38    procedure SetFullScreen(State: Boolean);
    3639    property RegistryContext: TRegistryContext read FRegistryContext
    3740      write FRegistryContext;
    … …  
    4346procedure Register;
    4447
     48
    4549implementation
    46 
    4750
    4851procedure Register;
    … …  
    169172      + FormRestoredSize.Top;
    170173    // Other state
    171     FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal)));
     174    FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(FormWindowState)));
     175    FormFullScreen := ReadBoolWithDefault('FullScreen', FormFullScreen);
    172176  finally
    173177    Free;
    … …  
    193197    // Other state
    194198    WriteInteger('WindowState', Integer(FormWindowState));
     199    WriteBool('FullScreen', FormFullScreen);
    195200  finally
    196201    Free;
    … …  
    250255end;
    251256
    252 procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False);
     257procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False;
     258  DefaultFullScreen: Boolean = False);
    253259begin
    254260  Self.Form := Form;
    … …  
    258264  FormRestoredSize := Bounds((Screen.Width - Form.Width) div 2,
    259265    (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);
     266  FormWindowState := Form.WindowState;
     267  FormFullScreen := DefaultFullScreen;
    260268
    261269  LoadFromRegistry(RegistryContext);
    … …  
    277285      Form.BoundsRect := FormNormalSize;
    278286  end;
     287  if FormFullScreen then SetFullScreen(True);
    279288  LoadControl(Form);
    280289end;
    … …  
    284293  Self.Form := Form;
    285294  FormNormalSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height);
    286   FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
    287     Form.RestoredHeight);
     295  if not FormFullScreen then
     296    FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
     297      Form.RestoredHeight);
    288298  FormWindowState := Form.WindowState;
    289299  SaveToRegistry(RegistryContext);
    … …  
    300310end;
    301311
     312procedure TPersistentForm.SetFullScreen(State: Boolean);
     313begin
     314  if State then begin
     315    FormFullScreen := True;
     316    FormNormalSize := Form.BoundsRect;
     317    FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
     318      Form.RestoredHeight);
     319    FormWindowState := Form.WindowState;
     320    ShowWindow(Form.Handle, SW_SHOWFULLSCREEN);
     321    {$IFDEF WINDOWS}
     322    Form.BorderStyle := bsNone;
     323    {$ENDIF}
     324  end else begin
     325    FormFullScreen := False;
     326    {$IFDEF WINDOWS}
     327    Form.BorderStyle := bsSizeable;
     328    {$ENDIF}
     329    ShowWindow(Form.Handle, SW_SHOWNORMAL);
     330    if FormWindowState = wsNormal then begin
     331      Form.BoundsRect := FormNormalSize;
     332    end else
     333    if FormWindowState = wsMaximized then begin
     334      Form.BoundsRect := FormRestoredSize;
     335      Form.WindowState := wsMaximized;
     336    end;
     337  end;
     338end;
     339
    302340end.
    303341

  • trunk/UGame.pas

    r73 r79  
    623623begin
    624624  MetaCanvas := TMetaCanvas.Create;
    625   MetaCanvas.SetSize(Point(Canvas.Width, Canvas.Height));
     625  MetaCanvas.Size := Point(Canvas.Width, Canvas.Height);
    626626
    627627  TopBarHeight := ScaleY(24, 96);
Note: See TracChangeset for help on using the changeset viewer.