Changeset 473 for trunk/Settings.pas

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.

File:

• trunk/Settings.pas (modified) (16 diffs)

trunk/Settings.pas

@@ -14 +14 @@
   TSettingsDlg = class(TDrawDlg)
     ButtonFullscreen: TButtonC;
-    Down2Btn: TButtonC;
+    ButtonCustomDpi: TButtonC;
+    ButtonGammaDown: TButtonC;
+    ButtonDpiDown: TButtonC;
     EditShortCutPrimary: TEdit;
     EditShortCutSecondary: TEdit;
@@ -22 +24 @@
     ButtonCancel: TButtonA;
     ButtonReset: TButtonA;
-    Up2Btn: TButtonC;
+    ButtonGammaUp: TButtonC;
+    ButtonDpiUp: TButtonC;
+    procedure ButtonCustomDpiClick(Sender: TObject);
+    procedure ButtonDpiDownClick(Sender: TObject);
+    procedure ButtonDpiUpClick(Sender: TObject);
     procedure ButtonFullscreenClick(Sender: TObject);
     procedure ButtonCancelClick(Sender: TObject);
     procedure ButtonResetClick(Sender: TObject);
-    procedure Down2BtnClick(Sender: TObject);
+    procedure ButtonGammaDownClick(Sender: TObject);
     procedure EditShortCutPrimaryKeyUp(Sender: TObject; var Key: Word;
       Shift: TShiftState);
@@ -38 +44 @@
     procedure ListKeyBindingsSelectionChange(Sender: TObject; User: Boolean);
     procedure ButtonOkClick(Sender: TObject);
-    procedure Up2BtnClick(Sender: TObject);
+    procedure ButtonGammaUpClick(Sender: TObject);
   private
     LocalGamma: Integer;
     LocalKeyBindings: TKeyBindings;
     CurrentKeyBinding: TKeyBinding;
+    LocalDpi: Integer;
     procedure UpdateShortCutItem;
+    function GetLocalCustomDpiEnabled: Boolean;
   public
     procedure LoadData;
@@ -62 +70 @@
 var
   SFullScreen, SGamma, SRestartMsg, SShortCutPrimary, SShortCutSecondary,
-  SLanguages, SKeyBindings: string;
+  SLanguages, SKeyBindings, SCustomDpi, SDpi: string;
 
 procedure ReloadLanguages;
@@ -73 +81 @@
   SLanguages := Phrases.Lookup('SETTINGS', 5);
   SKeyBindings := Phrases.Lookup('SETTINGS', 6);
+  SCustomDpi := Phrases.Lookup('SETTINGS', 7);
+  SDpi := Phrases.Lookup('SETTINGS', 8);
 end;
 
@@ -108 +118 @@
 end;
 
-procedure TSettingsDlg.Down2BtnClick(Sender: TObject);
+procedure TSettingsDlg.ButtonGammaDownClick(Sender: TObject);
 begin
   if LocalGamma > 50 then
@@ -156 +166 @@
 end;
 
+procedure TSettingsDlg.ButtonDpiDownClick(Sender: TObject);
+begin
+  if LocalDpi >= 105 then
+  begin
+    Dec(LocalDpi, 5);
+    Invalidate;
+  end;
+end;
+
+procedure TSettingsDlg.ButtonCustomDpiClick(Sender: TObject);
+begin
+  ButtonCustomDpi.ButtonIndex := ButtonCustomDpi.ButtonIndex xor 1;
+end;
+
+procedure TSettingsDlg.ButtonDpiUpClick(Sender: TObject);
+begin
+  if LocalDpi <= 495 then begin
+    Inc(LocalDpi, 5);
+    Invalidate;
+  end;
+end;
+
 procedure TSettingsDlg.FormDestroy(Sender: TObject);
 begin
@@ -163 +195 @@
 procedure TSettingsDlg.FormPaint(Sender: TObject);
 begin
-  PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6);
+  PaintBackground(Self, 3, 3, ClientWidth - 6, ClientHeight - 6);
   Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0);
   Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2,
@@ -178 +210 @@
     ButtonFullscreen.Left + 12, ButtonFullscreen.Top + 12, MainTexture.ColorBevelShade,
     MainTexture.ColorBevelLight);
+  {$IFDEF DPI}
+  RFrame(Canvas, ButtonCustomDpi.Left - 1, ButtonCustomDpi.Top - 1,
+    ButtonCustomDpi.Left + 12, ButtonCustomDpi.Top + 12, MainTexture.ColorBevelShade,
+    MainTexture.ColorBevelLight);
+  LoweredTextOut(Canvas, -2, MainTexture, ButtonCustomDpi.Left + 32,
+    ButtonCustomDpi.Top - 4, SCustomDpi);
+  UnderlinedTitleValue(Canvas, SDpi, IntToStr(LocalDpi) + '%',
+    ButtonDpiUp.Left - 150 - 4, ButtonDpiUp.Top + 2, 150);
+  {$ENDIF}
 
   LoweredTextOut(Canvas, -2, MainTexture, ListLanguages.Left,
@@ -186 +227 @@
     ButtonFullscreen.Top - 4, SFullScreen);
   UnderlinedTitleValue(Canvas, SGamma, IntToStr(LocalGamma) + '%',
-    Up2Btn.Left - 150 - 4, Up2Btn.Top + 2, 150);
+    ButtonGammaUp.Left - 150 - 4, ButtonGammaUp.Top + 2, 150);
   LoweredTextOut(Canvas, -2, MainTexture, EditShortCutPrimary.Left,
     EditShortCutPrimary.Top - 26, SShortCutPrimary);
@@ -204 +245 @@
   EditShortCutPrimary.Font.Color := MainTexture.ColorMark;
   EditShortCutSecondary.Font.Color := MainTexture.ColorMark;
+  {$IFDEF DPI}
+  ButtonCustomDpi.Visible := True;
+  ButtonDpiDown.Visible := True;
+  ButtonDpiUp.Visible := True;
+  {$ELSE}
+  ButtonCustomDpi.Visible := False;
+  ButtonDpiDown.Visible := False;
+  ButtonDpiUp.Visible := False;
+  {$ENDIF}
 end;
 
@@ -241 +291 @@
 end;
 
-procedure TSettingsDlg.Up2BtnClick(Sender: TObject);
+procedure TSettingsDlg.ButtonGammaUpClick(Sender: TObject);
 begin
   if LocalGamma < 150 then begin
@@ -262 +312 @@
 end;
 
+function TSettingsDlg.GetLocalCustomDpiEnabled: Boolean;
+begin
+  Result := (ButtonCustomDpi.ButtonIndex and 1) = 1;
+end;
+
 procedure TSettingsDlg.LoadData;
 begin
@@ -272 +327 @@
   LocalGamma := Gamma;
   LocalKeyBindings.Assign(KeyBindings.KeyBindings);
+  {$IFDEF DPI}
+  if CustomDpiEnabled then ButtonCustomDpi.ButtonIndex := 3
+    else ButtonCustomDpi.ButtonIndex := 2;
+  LocalDpi := Round(CustomDpi * 100 / 96);
+  {$ENDIF}
 end;
 
@@ -278 +338 @@
   NeedRestart: Boolean;
 begin
-  NeedRestart := Gamma <> LocalGamma;
+  NeedRestart := (Gamma <> LocalGamma) or (CustomDpiEnabled <> GetLocalCustomDpiEnabled) or
+    ((GetLocalCustomDpiEnabled and (LocalDpi <> CustomDpi)));
   if ListLanguages.ItemIndex <> -1 then begin
     StartDlg.Translator.Language := TLanguage(ListLanguages.Items.Objects[ListLanguages.ItemIndex]);
@@ -288 +349 @@
   FullScreen := (ButtonFullscreen.ButtonIndex and 1) = 1;
   Gamma := LocalGamma;
+  ScreenTools.CustomDpiEnabled := CustomDpiEnabled;
   if NeedRestart then SimpleMessage(SRestartMsg);
   KeyBindings.KeyBindings.Assign(LocalKeyBindings);
+  {$IFDEF DPI}
+  CustomDpiEnabled := GetLocalCustomDpiEnabled;
+  CustomDpi := Round(LocalDpi * 96 / 100);
+  {$ENDIF}
 end;