Permalink
Browse files

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

…ttings
  • Loading branch information...
ansgarbecker committed Oct 23, 2018
1 parent 5d9dbe2 commit e2aea335883004f4ae2d3a2e2577c0975fe7ebd2
Showing with 29 additions and 32 deletions.
  1. +5 −2 out/locale/en/LC_MESSAGES/default.po
  2. +4 −22 source/about.dfm
  3. +11 −6 source/about.pas
  4. +9 −2 source/apphelpers.pas
@@ -7,15 +7,15 @@ 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"
"Content-Type: text/plain; charset=UTF-8\n"
"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."
@@ -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
@@ -35,6 +35,7 @@ TAboutBox = class(TForm)
procedure btnDonatedOKClick(Sender: TObject);
procedure lblCreditsClick(Sender: TObject);
procedure menuCopyLabelClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
@@ -120,16 +121,20 @@ procedure TAboutBox.editDonatedExit(Sender: TObject);
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);
@@ -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 @@ procedure InheritFont(AFont: TFont);
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;
function GetLightness(AColor: TColor): Byte;

0 comments on commit e2aea33

Please sign in to comment.