Changeset 473 for trunk/Packages

Timestamp:

Dec 4, 2023, 12:13:15 PM (5 months ago)

Author:

chronos

Message:

• Added: Custom DPI configuration in Settings dialog.
• Fixed: Better High DPI support.

Location:

trunk/Packages

Files:

• CevoComponents/ScreenTools.pas (modified) (8 diffs)
• DpiControls/Dpi.Common.pas (modified) (1 diff)
• DpiControls/Dpi.Forms.pas (modified) (5 diffs)

trunk/Packages/CevoComponents/ScreenTools.pas

@@ -104 +104 @@
 procedure UnshareBitmap(Bitmap: TBitmap);
 procedure Gtk2Fix;
+procedure LoadConfig(Key: string);
+procedure SaveConfig(Key: string);
 
 const
@@ -193 +195 @@
   UniFont: array [TFontType] of TFont;
   Gamma: Integer; // global gamma correction (cent)
+  CustomDpiEnabled: Boolean;
+  CustomDpi: Integer;
 
 procedure LoadAssets;
@@ -204 +208 @@
 uses
   {$IFDEF DPI}Dpi.PixelPointer,{$ELSE}PixelPointer,{$ENDIF}
-  Directories, Sound;
+  Directories, Sound, Registry;
 
 var
@@ -1550 +1554 @@
 procedure PaintLogo(Canvas: TCanvas; X, Y, LightColor, ShadeColor: Integer);
 begin
+  if not Assigned(LogoBuffer) then Exit;
   UnshareBitmap(LogoBuffer);
   BitBltCanvas(LogoBuffer.Canvas, 0, 0, Logo.Width, Logo.Height, Canvas, X, Y);
@@ -1732 +1737 @@
 end;
 
+procedure LoadConfig(Key: string);
+var
+  Reg: TRegistry;
+begin
+  Reg := TRegistry.Create;
+  with Reg do try
+    OpenKey(Key, True);
+    if ValueExists('Gamma') then Gamma := ReadInteger('Gamma')
+      else Gamma := 100;
+    if Gamma <> 100 then InitGammaLookupTable;
+    if ValueExists('CustomDpiEnabled') then CustomDpiEnabled := Reg.ReadBool('CustomDpiEnabled')
+       else CustomDpiEnabled := False;
+    if ValueExists('CustomDpi') then CustomDpi := Reg.ReadInteger('CustomDpi')
+       else CustomDpi := 96;
+    {$IFDEF DPI}
+    if CustomDpiEnabled then Screen.Dpi := CustomDpi
+      else Screen.Dpi := Screen.GetSystemDpi;
+    {$ENDIF}
+  finally
+    Reg.Free;
+  end;
+end;
+
+procedure SaveConfig(Key: string);
+var
+  Reg: TRegistry;
+begin
+  Reg := TRegistry.Create;
+  with Reg do try
+    OpenKey(Key, True);
+    WriteInteger('Gamma', Gamma);
+    WriteBool('CustomDpiEnabled', CustomDpiEnabled);
+    WriteInteger('CustomDpi', CustomDpi);
+  finally
+    Free;
+  end;
+end;
+
 procedure LoadAssets;
 begin
@@ -1752 +1795 @@
   end;
 
+  LogoBuffer := TBitmap.Create;
+  LogoBuffer.PixelFormat := TPixelFormat.pf24bit;
+  LogoBuffer.SetSize(BigBook.Width, BigBook.Height);
+
   LoadGraphicFile(Colors, GetGraphicsDir + DirectorySeparator + 'Colors.png');
   LoadGraphicFile(Paper, GetGraphicsDir + DirectorySeparator + 'Paper.jpg');
@@ -1801 +1848 @@
 
   LoadAssets;
-
-  LogoBuffer := TBitmap.Create;
-  LogoBuffer.PixelFormat := TPixelFormat.pf24bit;
-  LogoBuffer.SetSize(BigBook.Width, BigBook.Height);
 end;
 
@@ -1814 +1857 @@
   FreeAndNil(Phrases);
   FreeAndNil(Phrases2);
-  FreeAndNil(LogoBuffer);
+  if Assigned(LogoBuffer) then FreeAndNil(LogoBuffer);
   FreeAndNil(BigImp);
   FreeAndNil(Paper);

trunk/Packages/DpiControls/Dpi.Common.pas

@@ -7 +7 @@
 
 const
-  FixedDpi = 2*96;
   DpiControlsComponentPaletteName = 'DpiControls';
 

trunk/Packages/DpiControls/Dpi.Forms.pas

@@ -228 +228 @@
     constructor Create;
     destructor Destroy; override;
-    procedure UpdateScreen;
     procedure UpdateActiveFormFromNativeScreen;
     function DisableForms(SkipForm: TForm; DisabledList: Classes.TList = nil): Classes.TList;
     procedure EnableForms(var AFormList: Classes.TList);
+    function GetSystemDpi: Integer;
     property FormCount: Integer read GetFormCount;
     property Forms[Index: Integer]: TForm read GetForms;
@@ -400 +400 @@
 begin
   GetNativeApplication.Initialize;
-  Screen.UpdateScreen;
 end;
 
@@ -442 +441 @@
       FCreatingForm := TForm(Instance);
     Instance.Create(Self);
-    Ok := true;
+    Ok := True;
   finally
     if not Ok then begin
@@ -978 +977 @@
 end;
 
+function TScreen.GetSystemDpi: Integer;
+begin
+  Result := LCLScreen.PixelsPerInch;
+end;
+
 constructor TScreen.Create;
 begin
@@ -993 +997 @@
   FreeAndNil(FPrevActiveForms);
   inherited;
-end;
-
-procedure TScreen.UpdateScreen;
-begin
-  if FixedDpi = -1 then Dpi := LCLScreen.PixelsPerInch
-    else Dpi := FixedDpi;
 end;