Changeset 548 for Common

Timestamp:

Feb 12, 2021, 12:03:11 AM (4 years ago)

Author:

chronos

Message:

• Added: Full screen mode support to PersistentForm class.
• Added: Missing AboutDialog unit and text translation.

Location:

Common

Files:

• Common.lpk (modified) (2 diffs)
• Common.pas (modified) (2 diffs)
• Languages/UFormAbout.cs.po (added)
• Languages/UFormAbout.po (added)
• UAboutDialog.pas (added)
• UApplicationInfo.pas (modified) (3 diffs)
• UFormAbout.lfm (modified) (4 diffs)
• UMetaCanvas.pas (modified) (18 diffs)
• UPersistentForm.pas (modified) (12 diffs)

Common/Common.lpk

@@ -39 +39 @@
     <Description Value="Various libraries"/>
     <License Value="GNU/GPL"/>
-    <Version Minor="7"/>
-    <Files Count="26">
+    <Version Minor="8"/>
+    <Files Count="28">
       <Item1>
         <Filename Value="StopWatch.pas"/>
@@ -156 +156 @@
         <UnitName Value="ULanguages"/>
       </Item26>
+      <Item27>
+        <Filename Value="UFormAbout.pas"/>
+        <UnitName Value="UFormAbout"/>
+      </Item27>
+      <Item28>
+        <Filename Value="UAboutDialog.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UAboutDialog"/>
+      </Item28>
     </Files>
     <i18n>

Common/Common.pas

@@ -12 +12 @@
   UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 
   UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 
-  UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UAboutDialog, 
-  UTranslator, ULanguages, UFormAbout, LazarusPackageIntf;
+  UPersistentForm, UFindFile, UScaleDPI, UTheme, UStringTable, UMetaCanvas, 
+  UGeometric, UTranslator, ULanguages, UFormAbout, UAboutDialog, 
+  LazarusPackageIntf;
 
 implementation
@@ -29 +30 @@
   RegisterUnit('UScaleDPI', @UScaleDPI.Register);
   RegisterUnit('UTheme', @UTheme.Register);
+  RegisterUnit('UTranslator', @UTranslator.Register);
   RegisterUnit('UAboutDialog', @UAboutDialog.Register);
-  RegisterUnit('UTranslator', @UTranslator.Register);
 end;
 

Common/UApplicationInfo.pas

@@ -6 +6 @@
 
 uses
-  SysUtils, Classes, Forms, URegistry, Controls, Graphics;
+  SysUtils, Classes, Forms, URegistry, Controls, Graphics, LCLType;
 
 type
@@ -14 +14 @@
   TApplicationInfo = class(TComponent)
   private
-    FDescription: TCaption;
+    FDescription: TTranslateString;
     FIcon: TBitmap;
     FIdentification: Byte;
@@ -49 +49 @@
     property EmailContact: string read FEmailContact write FEmailContact;
     property AppName: string read FAppName write FAppName;
-    property Description: string read FDescription write FDescription;
+    property Description: TTranslateString read FDescription write FDescription;
     property ReleaseDate: TDateTime read FReleaseDate write FReleaseDate;
     property RegistryKey: string read FRegistryKey write FRegistryKey;

Common/UFormAbout.lfm

@@ -11 +11 @@
   OnShow = FormShow
   Position = poScreenCenter
-  LCLVersion = '2.0.2.0'
+  LCLVersion = '2.0.10.0'
   object LabelDescription: TLabel
     Left = 30
-    Height = 26
+    Height = 24
     Top = 135
     Width = 642
@@ -28 +28 @@
   object LabelContent: TLabel
     Left = 30
-    Height = 26
-    Top = 191
+    Height = 24
+    Top = 189
     Width = 642
     Align = alTop
@@ -50 +50 @@
     TabOrder = 0
     object LabelAppName: TLabel
-      Left = 96
-      Height = 100
+      Left = 108
+      Height = 84
       Top = 20
-      Width = 572
+      Width = 564
       Anchors = [akTop, akLeft, akRight]
       AutoSize = False
@@ -68 +68 @@
       Top = 30
       Width = 72
+      Proportional = True
+      Stretch = True
     end
   end

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;
 

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.