Issue #213: auto-scale font size within InheritFont() for high dpi settings

out/locale/en/LC_MESSAGES/default.po

@@ -7,7 +7,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: HeidiSQL\n"
 "POT-Creation-Date: 2012-11-05 21:40\n"
-"PO-Revision-Date: 2018-09-02 13:03+0200\n"
+"PO-Revision-Date: 2018-10-23 21:30+0200\n"
 "Last-Translator: Ansgar Becker <anse@heidisql.com>\n"
 "Language-Team: English (http://www.transifex.com/projects/p/heidisql/language/en/)\n"
 "MIME-Version: 1.0\n"
@@ -15,7 +15,7 @@ msgstr ""
 "Content-Transfer-Encoding: 8bit\n"
 "Language: en\n"
 "Plural-Forms: nplurals=2; plural=(n != 1);\n"
-"X-Generator: Poedit 2.1.1\n"
+"X-Generator: Poedit 2.2\n"
 
 #. AboutBox..Caption
 #: about.dfm:5
@@ -6254,3 +6254,6 @@ msgstr "Successfully moved \"%s\" to \"%s\""
 
 msgid "Error: Could not move \"%s\" to \"%s\" (Error: %s)"
 msgstr "Error: Could not move \"%s\" to \"%s\" (Error: %s)"
+
+msgid "Scaling font size from %d to %d."
+msgstr "Scaling font size from %d to %d."

source/about.dfm

@@ -14,6 +14,7 @@ object AboutBox: TAboutBox
   FormStyle = fsStayOnTop
   OldCreateOrder = True
   Position = poOwnerFormCenter
+  OnCreate = FormCreate
   OnMouseMove = MouseOver
   OnShow = FormShow
   DesignSize = (
@@ -24,15 +25,9 @@ object AboutBox: TAboutBox
   object lblAppName: TLabel
     Left = 117
     Top = 8
-    Width = 116
-    Height = 23
+    Width = 56
+    Height = 13
     Caption = 'lblAppName'
-    Font.Charset = DEFAULT_CHARSET
-    Font.Color = clWindowText
-    Font.Height = -19
-    Font.Name = 'Tahoma'
-    Font.Style = [fsBold]
-    ParentFont = False
     PopupMenu = popupLabels
     Transparent = True
     IsControl = True
@@ -63,12 +58,6 @@ object AboutBox: TAboutBox
     Height = 13
     Cursor = crHandPoint
     Caption = 'lblAppWebpage'
-    Font.Charset = DEFAULT_CHARSET
-    Font.Color = clBlue
-    Font.Height = -11
-    Font.Name = 'Tahoma'
-    Font.Style = []
-    ParentFont = False
     PopupMenu = popupLabels
     Transparent = True
     OnClick = OpenURL
@@ -298,6 +287,7 @@ object AboutBox: TAboutBox
       084B856B8A3615B896B5B8660E8112B4265C9BB08E11D7067C5006AC6340AEC6
       1660FFFFFD5CB59BD7D4BCD003903AD6CD4B4B615B2C56B80EB4CBFD00FBFF01
       899BBF997FF95B380000000049454E44AE426082}
+    Transparent = True
     OnClick = OpenURL
   end
   object imgDonate: TImage
@@ -1386,14 +1376,6 @@ object AboutBox: TAboutBox
     Height = 13
     Cursor = crHandPoint
     Caption = 'Credits'
-    Color = clBtnFace
-    Font.Charset = DEFAULT_CHARSET
-    Font.Color = clBlue
-    Font.Height = -11
-    Font.Name = 'Tahoma'
-    Font.Style = []
-    ParentColor = False
-    ParentFont = False
     PopupMenu = popupLabels
     OnClick = lblCreditsClick
     OnMouseMove = MouseOver

source/about.pas

@@ -35,6 +35,7 @@ type
     procedure btnDonatedOKClick(Sender: TObject);
     procedure lblCreditsClick(Sender: TObject);
     procedure menuCopyLabelClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
   private
     { Private declarations }
   public
@@ -120,16 +121,20 @@ begin
   btnClose.Default := True;
 end;
 
+procedure TAboutBox.FormCreate(Sender: TObject);
+begin
+  TranslateComponent(Self);
+  InheritFont(Font);
+  lblAppName.Font.Size := Round(lblAppName.Font.Size * 1.5);
+  lblAppName.Font.Style := [fsBold];
+  lblAppWebpage.Font.Color := clBlue;
+  lblCredits.Font.Color := clBlue;
+end;
+
 procedure TAboutBox.FormShow(Sender: TObject);
 begin
   Screen.Cursor := crHourGlass;
 
-  TranslateComponent(Self);
-
-  InheritFont(Font);
-  InheritFont(lblAppName.Font);
-  lblAppName.Font.Size := 14;
-  InheritFont(lblAppWebpage.Font);
   imgDonate.Visible := MainForm.HasDonated(False) <> nbTrue;
   imgDonate.OnClick := MainForm.btnDonate.OnClick;
   editDonated.Text := AppSettings.ReadString(asDonatedEmail);

source/apphelpers.pas

@@ -1747,13 +1747,14 @@ procedure InheritFont(AFont: TFont);
 var
   LogFont: TLogFont;
   GUIFontName: String;
+  ScaledFontSize: Integer;
 begin
   GUIFontName := AppSettings.ReadString(asGUIFontName);
   if not GUIFontName.IsEmpty then begin
     // Apply user specified font
     AFont.Name := GUIFontName;
     AFont.Size := AppSettings.ReadInt(asGUIFontSize);
-  end else begin
+  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
@@ -1768,7 +1769,13 @@ begin
       end;
     end;
   end;
-end;
+  // Increase font size for high dpi settings
+  ScaledFontSize := Round(AFont.Size * (MainForm.Monitor.PixelsPerInch / MainForm.PixelsPerInch));
+  if ScaledFontSize <> AFont.Size then begin
+    Mainform.LogSQL(f_('Scaling font size from %d to %d.', [AFont.Size, ScaledFontSize]), lcDebug);
+    AFont.Size := ScaledFontSize;
+  end;
+
 end;