Changeset 79 for trunk/Packages/Common


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

Legend:

Unmodified
Added
Removed
  • 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
Note: See TracChangeset for help on using the changeset viewer.