diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 872418e8..0c92623b 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -356,7 +356,6 @@ type function GetCurrentPackageFullName(out Len: Cardinal; Name: PWideChar): Integer; stdcall; external kernel32 delayed; function GetUwpFullName: String; function RunningAsUwp: Boolean; - function DpiScaleFactor(Form: TForm): Double; function GetThemeColor(Color: TColor): TColor; function ThemeIsDark(ThemeName: String): Boolean; function ProcessExists(pid: Cardinal): Boolean; @@ -2935,12 +2934,6 @@ begin end; -function DpiScaleFactor(Form: TForm): Double; -begin - Result := Form.Monitor.PixelsPerInch / Form.PixelsPerInch; -end; - - function GetThemeColor(Color: TColor): TColor; begin // Not required with vcl-style-utils: diff --git a/source/extra_controls.pas b/source/extra_controls.pas index 215dadd1..e927c900 100644 --- a/source/extra_controls.pas +++ b/source/extra_controls.pas @@ -4,17 +4,19 @@ interface uses Classes, SysUtils, Forms, Windows, Messages, System.Types, StdCtrls, Clipbrd, - SizeGrip, SizeGripThemed, apphelpers, Vcl.Graphics; + SizeGrip, SizeGripThemed, apphelpers, Vcl.Graphics, Vcl.Dialogs; type // Form with a sizegrip in the lower right corner, without the need for a statusbar TExtForm = class(TForm) private FFontSet: Boolean; + FPixelsPerInchOnDefaultMonitor: Integer; public constructor Create(AOwner: TComponent); override; procedure AddSizeGrip; - class procedure InheritFont(AFont: TFont; Form: TForm); + function DpiScaleFactor(Form: TForm=nil): Double; + procedure InheritFont(AFont: TFont); protected procedure DoShow; override; end; @@ -33,6 +35,7 @@ implementation constructor TExtForm.Create(AOwner: TComponent); begin + FPixelsPerInchOnDefaultMonitor := Screen.Monitors[0].PixelsPerInch; inherited; FFontSet := False; end; @@ -43,7 +46,7 @@ begin // Expect the window to be on the wanted monitor now, so we can scale fonts according // to the screen's DPI setting if not FFontSet then begin - InheritFont(Font, Self); + InheritFont(Font); FFontSet := True; end; inherited; @@ -61,7 +64,13 @@ begin end; -class procedure TExtForm.InheritFont(AFont: TFont; Form: TForm); +function TExtForm.DpiScaleFactor(Form: TForm=nil): Double; +begin + Result := Monitor.PixelsPerInch / FPixelsPerInchOnDefaultMonitor; +end; + + +procedure TExtForm.InheritFont(AFont: TFont); var LogFont: TLogFont; GUIFontName: String; @@ -75,12 +84,12 @@ begin // Apply user specified font AFont.Name := GUIFontName; // Set size on top of automatic dpi-increased size - AFont.Size := Round(AppSettings.ReadInt(asGUIFontSize) * DpiScaleFactor(Form)); + AFont.Size := Round(AppSettings.ReadInt(asGUIFontSize) * DpiScaleFactor); end else begin // Apply system font. See issue #3204. // Code taken from http://www.gerixsoft.com/blog/delphi/system-font if SystemParametersInfo(SPI_GETICONTITLELOGFONT, SizeOf(TLogFont), @LogFont, 0) then begin - AFont.Height := Round(LogFont.lfHeight * DpiScaleFactor(Form)); + AFont.Height := Round(LogFont.lfHeight * DpiScaleFactor); AFont.Orientation := LogFont.lfOrientation; AFont.Charset := TFontCharset(LogFont.lfCharSet); AFont.Name := PChar(@LogFont.lfFaceName); diff --git a/source/loginform.pas b/source/loginform.pas index cbe86ebc..2987db0e 100644 --- a/source/loginform.pas +++ b/source/loginform.pas @@ -4,10 +4,10 @@ interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, ExtCtrls, gnugettext, System.UITypes; + Dialogs, StdCtrls, ExtCtrls, gnugettext, System.UITypes, extra_controls; type - TfrmLogin = class(TForm) + TfrmLogin = class(TExtForm) btnOK: TButton; pnlBackground: TPanel; lblPrompt: TLabel; diff --git a/source/main.pas b/source/main.pas index 4f33a4ad..db9116e1 100644 --- a/source/main.pas +++ b/source/main.pas @@ -1830,7 +1830,7 @@ begin Delimiter := AppSettings.ReadString(asDelimiter); - InheritFont(SynCompletionProposal.Font, Self); + InheritFont(SynCompletionProposal.Font); // Simulated link label, has non inherited blue font color lblExplainProcess.Font.Color := clBlue; lblExplainProcessAnalyzer.Font.Color := clBlue; @@ -1849,7 +1849,7 @@ begin QueryTab.spltHelpers := spltQueryHelpers; QueryTab.spltQuery := spltQuery; QueryTab.tabsetQuery := tabsetQuery; - InheritFont(QueryTab.tabsetQuery.Font, Self); + InheritFont(QueryTab.tabsetQuery.Font); QueryTab.ResultTabs := TResultTabs.Create(True); QueryTabs := TObjectList.Create(True); @@ -10752,7 +10752,7 @@ begin // Prevent various problems with alignment of controls. See http://www.heidisql.com/forum.php?t=18924 QueryTab.tabsetQuery.Top := QueryTab.spltQuery.Top + QueryTab.spltQuery.Height; QueryTab.tabsetQuery.Align := tabsetQuery.Align; - InheritFont(QueryTab.tabsetQuery.Font, Self); + InheritFont(QueryTab.tabsetQuery.Font); QueryTab.tabsetQuery.Images := tabsetQuery.Images; QueryTab.tabsetQuery.Style := tabsetQuery.Style; QueryTab.tabsetQuery.TabHeight := tabsetQuery.TabHeight; diff --git a/source/routine_editor.pas b/source/routine_editor.pas index a6516afe..a3e3ebcc 100644 --- a/source/routine_editor.pas +++ b/source/routine_editor.pas @@ -184,11 +184,11 @@ begin btnSave.Enabled := Modified; btnDiscard.Enabled := Modified; // Buttons are randomly moved, since VirtualTree update, see #440 - btnSave.Top := Height - btnSave.Height - Round(3 * DpiScaleFactor(MainForm)); + btnSave.Top := Height - btnSave.Height - Round(3 * MainForm.DpiScaleFactor); btnHelp.Top := btnSave.Top; btnDiscard.Top := btnSave.Top; btnRunProc.Top := btnSave.Top; - btnRunProc.Left := Width - btnRunProc.Width - Round(3 * DpiScaleFactor(MainForm)); + btnRunProc.Left := Width - btnRunProc.Width - Round(3 * MainForm.DpiScaleFactor); Mainform.actRunRoutines.Enabled := DBObject.Name <> ''; Mainform.ShowStatusMsg; Screen.Cursor := crDefault; diff --git a/source/table_editor.pas b/source/table_editor.pas index 20a42f55..4cfbeae5 100644 --- a/source/table_editor.pas +++ b/source/table_editor.pas @@ -353,7 +353,7 @@ begin AlterCodeValid := False; PageControlMainChange(Self); // Foreign key editor needs a hit // Buttons are randomly moved, since VirtualTree update, see #440 - btnSave.Top := Height - btnSave.Height - Round(3 * DpiScaleFactor(MainForm)); + btnSave.Top := Height - btnSave.Height - Round(3 * MainForm.DpiScaleFactor); btnHelp.Top := btnSave.Top; btnDiscard.Top := btnSave.Top; UpdateSQLCode; diff --git a/source/trigger_editor.pas b/source/trigger_editor.pas index 0b22be94..aac34cf9 100644 --- a/source/trigger_editor.pas +++ b/source/trigger_editor.pas @@ -164,7 +164,7 @@ begin end; end; // Buttons are randomly moved, since VirtualTree update, see #440 - btnSave.Top := Height - btnSave.Height - Round(3 * DpiScaleFactor(MainForm)); + btnSave.Top := Height - btnSave.Height - Round(3 * MainForm.DpiScaleFactor); btnHelp.Top := btnSave.Top; btnDiscard.Top := btnSave.Top; Modification(Self);