Changeset 79 for trunk/Packages

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/Packages/Common

Files:

• UApplicationInfo.pas (modified) (6 diffs)
• UFormAbout.lfm (added)
• UFormAbout.lrj (added)
• UFormAbout.pas (added)
• UMetaCanvas.pas (modified) (18 diffs)
• UPersistentForm.pas (modified) (12 diffs)

trunk/Packages/Common/UApplicationInfo.pas

@@ -6 +6 @@
 
 uses
-  SysUtils, Classes, Forms, URegistry, Controls;
+  SysUtils, Classes, Forms, URegistry, Controls, Graphics;
 
 type
@@ -15 +15 @@
   private
     FDescription: TCaption;
+    FIcon: TBitmap;
     FIdentification: Byte;
     FLicense: string;
@@ -33 +34 @@
   public
     constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
     property Version: string read GetVersion;
     function GetRegistryContext: TRegistryContext;
@@ -52 +54 @@
     property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot;
     property License: string read FLicense write FLicense;
+    property Icon: TBitmap read FIcon write FIcon;
   end;
 
@@ -74 +77 @@
 constructor TApplicationInfo.Create(AOwner: TComponent);
 begin
-  inherited Create(AOwner);
+  inherited;
   FVersionMajor := 1;
   FIdentification := 1;
@@ -80 +83 @@
   FRegistryKey := '\Software\' + FAppName;
   FRegistryRoot := rrKeyCurrentUser;
+  FIcon := TBitmap.Create;
+end;
+
+destructor TApplicationInfo.Destroy;
+begin
+  FreeAndNil(FIcon);
+  inherited;
 end;
 

trunk/Packages/Common/UMetaCanvas.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Graphics, Contnrs, Types;
+  Classes, SysUtils, Graphics, Contnrs, Types, fgl;
 
 type
@@ -17 +17 @@
     procedure Zoom(Factor: Double); virtual;
     procedure Move(Delta: TPoint); virtual;
+  end;
+
+  TCanvasObjects = class(TFPGObjectList<TCanvasObject>)
   end;
 
@@ -133 +136 @@
     procedure DoLineTo(X, Y: Integer); override;
   public
-    Objects: TObjectList;
+    Objects: TCanvasObjects;
     procedure FillRect(const ARect: TRect); overload; override;
     procedure FillRect(X1,Y1,X2,Y2: Integer); overload;
@@ -145 +148 @@
     procedure Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2,
       StartX, StartY, EndX, EndY: Integer); override;
-    procedure SetSize(Size: TPoint);
     procedure Reset;
     procedure DrawTo(Canvas: TCanvas);
@@ -152 +154 @@
     constructor Create;
     destructor Destroy; override;
-  end;
+    property Size: TPoint read FSize write FSize;
+  end;
+
 
 implementation
@@ -198 +202 @@
   Pen.Free;
   Brush.Free;
-  inherited Destroy;
+  inherited;
 end;
 
@@ -228 +232 @@
 destructor TCanvasStretchDraw.Destroy;
 begin
-  inherited Destroy;
+  inherited;
 end;
 
@@ -264 +268 @@
   Pen.Free;
   Brush.Free;
-  inherited Destroy;
+  inherited;
 end;
 
@@ -304 +308 @@
   Brush.Free;
   Pen.Free;
-  inherited Destroy;
+  inherited;
 end;
 
@@ -336 +340 @@
 begin
   Pen.Free;
-  inherited Destroy;
+  inherited;
 end;
 
@@ -375 +379 @@
   Pen.Free;
   Brush.Free;
-  inherited Destroy;
+  inherited;
 end;
 
@@ -408 +412 @@
   Brush.Free;
   Font.Free;
-  inherited Destroy;
+  inherited;
 end;
 
@@ -618 +622 @@
 end;
 
-procedure TMetaCanvas.SetSize(Size: TPoint);
-begin
-  FSize := Size;
-end;
-
 procedure TMetaCanvas.Reset;
 begin
@@ -633 +632 @@
 begin
   for I := 0 to Objects.Count - 1 do
-    TCanvasObject(Objects[I]).Paint(Canvas);
+    Objects[I].Paint(Canvas);
 end;
 
@@ -641 +640 @@
 begin
   for I := 0 to Objects.Count - 1 do
-    TCanvasObject(Objects[I]).Zoom(Factor);
+    Objects[I].Zoom(Factor);
 end;
 
@@ -649 +648 @@
 begin
   for I := 0 to Objects.Count - 1 do
-    TCanvasObject(Objects[I]).Move(Delta);
+    Objects[I].Move(Delta);
 end;
 
@@ -656 +655 @@
   inherited;
   FPenPos := Point(0, 0);
-  Objects := TObjectList.Create;
+  Objects := TCanvasObjects.Create;
 end;
 
@@ -662 +661 @@
 begin
   Objects.Free;
-  inherited Destroy;
+  inherited;
 end;
 

trunk/Packages/Common/UPersistentForm.pas

@@ -3 +3 @@
 {$mode delphi}
 
-// Date: 2015-04-18
+// Date: 2020-11-26
 
 interface
@@ -9 +9 @@
 uses
   Classes, SysUtils, Forms, URegistry, LCLIntf, Registry, Controls, ComCtrls,
-  ExtCtrls;
+  ExtCtrls, LCLType;
 
 type
@@ -26 +26 @@
     FormRestoredSize: TRect;
     FormWindowState: TWindowState;
+    FormFullScreen: Boolean;
     Form: TForm;
     procedure LoadFromRegistry(RegistryContext: TRegistryContext);
@@ -31 +32 @@
     function CheckEntireVisible(Rect: TRect): TRect;
     function CheckPartVisible(Rect: TRect; Part: Integer): TRect;
-    procedure Load(Form: TForm; DefaultMaximized: Boolean = False);
+    procedure Load(Form: TForm; DefaultMaximized: Boolean = False;
+      DefaultFullScreen: Boolean = False);
     procedure Save(Form: TForm);
     constructor Create(AOwner: TComponent); override;
+    procedure SetFullScreen(State: Boolean);
     property RegistryContext: TRegistryContext read FRegistryContext
       write FRegistryContext;
@@ -43 +46 @@
 procedure Register;
 
+
 implementation
-
 
 procedure Register;
@@ -169 +172 @@
       + FormRestoredSize.Top;
     // Other state
-    FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(wsNormal)));
+    FormWindowState := TWindowState(ReadIntegerWithDefault('WindowState', Integer(FormWindowState)));
+    FormFullScreen := ReadBoolWithDefault('FullScreen', FormFullScreen);
   finally
     Free;
@@ -193 +197 @@
     // Other state
     WriteInteger('WindowState', Integer(FormWindowState));
+    WriteBool('FullScreen', FormFullScreen);
   finally
     Free;
@@ -250 +255 @@
 end;
 
-procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False);
+procedure TPersistentForm.Load(Form: TForm; DefaultMaximized: Boolean = False;
+  DefaultFullScreen: Boolean = False);
 begin
   Self.Form := Form;
@@ -258 +264 @@
   FormRestoredSize := Bounds((Screen.Width - Form.Width) div 2,
     (Screen.Height - Form.Height) div 2, Form.Width, Form.Height);
+  FormWindowState := Form.WindowState;
+  FormFullScreen := DefaultFullScreen;
 
   LoadFromRegistry(RegistryContext);
@@ -277 +285 @@
       Form.BoundsRect := FormNormalSize;
   end;
+  if FormFullScreen then SetFullScreen(True);
   LoadControl(Form);
 end;
@@ -284 +293 @@
   Self.Form := Form;
   FormNormalSize := Bounds(Form.Left, Form.Top, Form.Width, Form.Height);
-  FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
-    Form.RestoredHeight);
+  if not FormFullScreen then
+    FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
+      Form.RestoredHeight);
   FormWindowState := Form.WindowState;
   SaveToRegistry(RegistryContext);
@@ -300 +310 @@
 end;
 
+procedure TPersistentForm.SetFullScreen(State: Boolean);
+begin
+  if State then begin
+    FormFullScreen := True;
+    FormNormalSize := Form.BoundsRect;
+    FormRestoredSize := Bounds(Form.RestoredLeft, Form.RestoredTop, Form.RestoredWidth,
+      Form.RestoredHeight);
+    FormWindowState := Form.WindowState;
+    ShowWindow(Form.Handle, SW_SHOWFULLSCREEN);
+    {$IFDEF WINDOWS}
+    Form.BorderStyle := bsNone;
+    {$ENDIF}
+  end else begin
+    FormFullScreen := False;
+    {$IFDEF WINDOWS}
+    Form.BorderStyle := bsSizeable;
+    {$ENDIF}
+    ShowWindow(Form.Handle, SW_SHOWNORMAL);
+    if FormWindowState = wsNormal then begin
+      Form.BoundsRect := FormNormalSize;
+    end else
+    if FormWindowState = wsMaximized then begin
+      Form.BoundsRect := FormRestoredSize;
+      Form.WindowState := wsMaximized;
+    end;
+  end;
+end;
+
 end.