Changeset 63


Ignore:
Timestamp:
Nov 26, 2020, 1:18:19 PM (4 years ago)
Author:
chronos
Message:
  • Added: Support for full screen mode.
Location:
trunk
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r62 r63  
    88  ClientWidth = 1276
    99  DesignTimePPI = 144
     10  OnActivate = FormActivate
     11  OnClose = FormClose
    1012  OnCreate = FormCreate
    1113  OnDestroy = FormDestroy
    1214  OnKeyPress = FormKeyPress
     15  OnKeyUp = FormKeyUp
    1316  OnShow = FormShow
    1417  LCLVersion = '2.0.10.0'
    15   WindowState = wsMaximized
    1618  object PaintBox1: TPaintBox
    1719    Left = 0
    … …  
    5759    Top = 460
    5860  end
     61  object PersistentForm1: TPersistentForm
     62    MinVisiblePart = 50
     63    EntireVisible = False
     64    Left = 488
     65    Top = 536
     66  end
    5967end

  • trunk/Forms/UFormMain.pas

    r62 r63  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
    9   ExtCtrls, UEngine, LCLType, types, UTranslator, UApplicationInfo, URegistry;
     9  ExtCtrls, UEngine, LCLType, types, UTranslator, UApplicationInfo, URegistry,
     10  UPersistentForm;
    1011
    1112type
    … …  
    1617    ApplicationInfo1: TApplicationInfo;
    1718    PaintBox1: TPaintBox;
     19    PersistentForm1: TPersistentForm;
    1820    Timer1: TTimer;
    1921    Translator1: TTranslator;
     22    procedure FormActivate(Sender: TObject);
     23    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    2024    procedure FormCreate(Sender: TObject);
    2125    procedure FormDestroy(Sender: TObject);
    2226    procedure FormKeyPress(Sender: TObject; var Key: char);
     27    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    2328    procedure FormShow(Sender: TObject);
    2429    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
    … …  
    3641    procedure Timer1Timer(Sender: TObject);
    3742  private
     43    Initialized: Boolean;
    3844    procedure LoadConfig;
    3945    procedure SaveConfig;
    4046  public
     47    FullScreen: Boolean;
    4148    Engine: TEngine;
    4249    procedure EraseBackground(DC: HDC); override;
    … …  
    4552var
    4653  FormMain: TFormMain;
     54
    4755
    4856implementation
    … …  
    6371end;
    6472
     73procedure TFormMain.FormActivate(Sender: TObject);
     74begin
     75  if not Initialized then begin
     76    Initialized := True;
     77  end;
     78end;
     79
     80procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
     81begin
     82  PersistentForm1.Save(Self);
     83end;
     84
    6585procedure TFormMain.FormDestroy(Sender: TObject);
    6686begin
    … …  
    7191procedure TFormMain.FormKeyPress(Sender: TObject; var Key: char);
    7292begin
    73   if (Key = #32) then begin
     93  if Key = #32 then begin
    7494    if Engine.State = gsRunning then Engine.State := gsPaused
    7595    else if Engine.State = gsPaused then Engine.State := gsRunning;
    … …  
    7797end;
    7898
     99procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
     100  );
     101const
     102  KeyF11 = 122;
     103begin
     104  if Key = KeyF11 then begin
     105    FormMain.FullScreen := not FormMain.FullScreen;
     106    FormMain.PersistentForm1.SetFullScreen(FormMain.FullScreen);
     107  end;
     108end;
     109
    79110procedure TFormMain.FormShow(Sender: TObject);
    80111begin
     112  PersistentForm1.RegistryContext := ApplicationInfo1.GetRegistryContext;
     113  PersistentForm1.Load(Self, False, True);
    81114  Randomize;
    82115  Engine.ImagePassenger.Picture.Assign(FormImages.ImagePassenger.Picture);

  • trunk/Languages/BigMetro.cs.po

    r62 r63  
    4141msgstr "Nulové přiblížení není povoleno"
    4242
     43#: umenu.sautomatic
     44msgid "Automatic"
     45msgstr "Automaticky"
     46
    4347#: umenu.sback
    4448msgid "Back"
    … …  
    6771msgstr "Odejít"
    6872
     73#: umenu.sfullscreen
     74msgid "Full screen"
     75msgstr "Celá obrazovka"
     76
    6977#: umenu.slanguage
    70 #, fuzzy
    71 #| msgid "Jazyk"
    7278msgid "Language"
    7379msgstr "Jazyk"
    … …  
    8288msgid "Play"
    8389msgstr "Hrát"
    84 

  • trunk/Languages/BigMetro.po

    r62 r63  
    3131msgstr ""
    3232
     33#: umenu.sautomatic
     34msgid "Automatic"
     35msgstr ""
     36
    3337#: umenu.sback
    3438msgid "Back"
    … …  
    5761msgstr ""
    5862
     63#: umenu.sfullscreen
     64msgid "Full screen"
     65msgstr ""
     66
    5967#: umenu.slanguage
    6068msgid "Language"

  • trunk/Packages/Common/UCommon.pas

    r55 r63  
    88  {$ifdef Windows}Windows,{$endif}
    99  {$ifdef Linux}baseunix,{$endif}
    10   Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
     10  Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf, LCLType, Forms, Controls,
    1111  FileUtil; //, ShFolder, ShellAPI;
    1212

  • trunk/Packages/Common/UPersistentForm.pas

    r55 r63  
    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    FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
     317      Form.RestoredHeight);
     318    ShowWindow(Form.Handle, SW_SHOWFULLSCREEN);
     319  end else begin
     320    FormFullScreen := False;
     321    if Form.WindowState = wsNormal then begin
     322      ShowWindow(Form.Handle, SW_SHOWNORMAL);
     323      //Form.BoundsRect := FormRestoredSize;
     324    end else if Form.WindowState = wsMaximized then ShowWindow(Form.Handle, SW_SHOWMAXIMIZED);
     325  end;
     326end;
     327
    302328end.
    303329

  • trunk/UEngine.pas

    r62 r63  
    301301    procedure DarkModeChanged(Sender: TObject);
    302302    procedure LanguageChanged(Sender: TObject);
     303    procedure FullScreenChanged(Sender: TObject);
    303304    procedure InitMenus;
    304305  public
    … …  
    18831884  NewLanguage: TLanguage;
    18841885begin
    1885   NewLanguage := TLanguage(TMenuItemComboBox(MenuOptions.Items[0]).States.Objects[TMenuItemComboBox(MenuOptions.Items[0]).Index]);
     1886  NewLanguage := TLanguage(TMenuItemComboBox(Sender).States.Objects[TMenuItemComboBox(Sender).Index]);
    18861887  if FormMain.Translator1.Language <> NewLanguage then begin
    18871888    FormMain.Translator1.Language := NewLanguage;
    … …  
    18891890    InitMenus;
    18901891  end;
     1892end;
     1893
     1894procedure TEngine.FullScreenChanged(Sender: TObject);
     1895begin
     1896  FormMain.FullScreen := TMenuItemCheckBox(Sender).Checked;
     1897  FormMain.PersistentForm1.SetFullScreen(FormMain.FullScreen);
    18911898end;
    18921899
    … …  
    19081915    end;
    19091916    AddCheckBox(SDarkMode, DarkModeChanged);
     1917    with AddCheckBox(SFullScreen, FullScreenChanged) do begin
     1918      Checked := FormMain.FullScreen;
     1919    end;
    19101920    AddButton(SBack, MenuItemBack);
    19111921  end;

  • trunk/UMenu.pas

    r62 r63  
    8585  SEnglish = 'English';
    8686  SBack = 'Back';
     87  SAutomatic = 'Automatic';
     88  SFullScreen = 'Full screen';
    8789
    8890
    … …  
    133135
    134136procedure TMenuItemComboBox.Paint(Canvas: TCanvas; P: TPoint);
     137var
     138  OutputText: string;
    135139begin
    136140  if Selected then Canvas.Brush.Color := $e78C31
    137141    else Canvas.Brush.Color := $f7bC61;
    138   Bounds := Classes.Bounds(P.X, P.Y, Canvas.TextWidth(States[Index]), Canvas.TextHeight(States[Index]));
    139   Canvas.TextOut(P.X, P.Y, States[Index]);
     142  OutputText := Text + ': ' + States[Index];
     143  Bounds := Classes.Bounds(P.X, P.Y, Canvas.TextWidth(OutputText), Canvas.TextHeight(OutputText));
     144  Canvas.TextOut(P.X, P.Y, OutputText);
    140145end;
    141146
    … …  
    159164      if (Items[I] is TMenuItemButton) then begin
    160165        if Assigned(TMenuItemButton(Items[I]).FOnClick) then
    161           TMenuItemButton(Items[I]).FOnClick(nil)
     166          TMenuItemButton(Items[I]).FOnClick(Items[I]);
    162167      end else
    163168      if (Items[I] is TMenuItemCheckBox) then begin
    164169        (Items[I] as TMenuItemCheckBox).Checked := not (Items[I] as TMenuItemCheckBox).Checked;
    165170        if Assigned((Items[I] as TMenuItemCheckBox).FOnChanged) then
    166           (Items[I] as TMenuItemCheckBox).FOnChanged(nil);
     171          (Items[I] as TMenuItemCheckBox).FOnChanged(Items[I]);
    167172      end else
    168173      if (Items[I] is TMenuItemComboBox) then begin
    … …  
    170175          (Items[I] as TMenuItemComboBox).States.Count;
    171176        if Assigned((Items[I] as TMenuItemComboBox).FOnChanged) then
    172           (Items[I] as TMenuItemComboBox).FOnChanged(nil);
     177          (Items[I] as TMenuItemComboBox).FOnChanged(Items[I]);
    173178      end;
    174179    end;
Note: See TracChangeset for help on using the changeset viewer.