Issue #718: Fonts may still be too large because the monitor on which a form is created has DPI > 100%. Calculate DpiScaleFactor based on that first monitor. See https://www.heidisql.com/forum.php?t=34230

This commit is contained in:
Ansgar Becker
2019-07-18 19:08:32 +02:00
parent 6a75e8c404
commit 2ebbdc6ba3
7 changed files with 24 additions and 22 deletions

View File

@ -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:

View File

@ -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);

View File

@ -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;

View File

@ -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<TQueryTab>.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;

View File

@ -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;

View File

@ -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;

View File

@ -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);