Skip to content
Permalink
Browse files

High DPI:

* remove ParentFont flag from forms again (introduced in 9cdcd63 for #213). This just inherits from default Windows settings.
* instead, scale font size in InheritFont(), and move that to the new TExtForm class
* mark app with PerMonitorV2 support
  • Loading branch information...
ansgarbecker committed Jul 17, 2019
1 parent 2dfb118 commit 92c8f62b854d0d5700ec3fe77781f65b65c0b5f2
Showing with 218 additions and 103 deletions.
  1. +0 −1 packages/Delphi10.3/heidisql.dpr
  2. +3 −2 res/manifest.xml
  3. +5 −1 source/about.dfm
  4. +2 −2 source/about.pas
  5. +0 −34 source/apphelpers.pas
  6. +2 −1 source/bineditor.pas
  7. +5 −1 source/change_password.dfm
  8. +2 −1 source/change_password.pas
  9. +5 −1 source/column_selection.dfm
  10. +2 −1 source/column_selection.pas
  11. +5 −1 source/connections.dfm
  12. +2 −1 source/connections.pas
  13. +5 −1 source/copytable.dfm
  14. +2 −1 source/copytable.pas
  15. +5 −1 source/createdatabase.dfm
  16. +2 −2 source/createdatabase.pas
  17. +5 −1 source/data_sorting.dfm
  18. +2 −2 source/data_sorting.pas
  19. +5 −1 source/editvar.dfm
  20. +2 −1 source/editvar.pas
  21. +5 −1 source/exportgrid.dfm
  22. +2 −1 source/exportgrid.pas
  23. +48 −6 source/extra_controls.pas
  24. +5 −1 source/insertfiles.dfm
  25. +2 −1 source/insertfiles.pas
  26. +5 −1 source/loaddata.dfm
  27. +2 −1 source/loaddata.pas
  28. +5 −6 source/loginform.dfm
  29. +5 −1 source/main.dfm
  30. +8 −5 source/main.pas
  31. +5 −1 source/options.dfm
  32. +2 −1 source/options.pas
  33. +5 −1 source/printlist.dfm
  34. +5 −1 source/searchreplace.dfm
  35. +2 −1 source/searchreplace.pas
  36. +5 −1 source/selectdbobject.dfm
  37. +2 −1 source/selectdbobject.pas
  38. +5 −1 source/sqlhelp.dfm
  39. +2 −1 source/sqlhelp.pas
  40. +5 −1 source/syncdb.dfm
  41. +2 −1 source/syncdb.pas
  42. +5 −1 source/tabletools.dfm
  43. +2 −1 source/tabletools.pas
  44. +5 −1 source/texteditor.dfm
  45. +2 −1 source/texteditor.pas
  46. +2 −2 source/theme_preview.pas
  47. +5 −1 source/updatecheck.dfm
  48. +2 −2 source/updatecheck.pas
  49. +5 −1 source/usermanager.dfm
  50. +2 −1 source/usermanager.pas
@@ -78,7 +78,6 @@ begin
Application.Initialize;
Application.Title := APPNAME;
Application.UpdateFormatSettings := False;
AppHelpers.InheritFont(Application.DefaultFont);
TStyleManager.TrySetStyle(AppSettings.ReadString(asTheme));
Application.CreateForm(TMainForm, MainForm);
MainForm.AfterFormCreate;
@@ -3,8 +3,9 @@
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">

<asmv3:application>
<asmv3:windowsSettings xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
<dpiAware>True/PM</dpiAware>
<asmv3:windowsSettings>
<dpiAware xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">true/pm</dpiAware>
<dpiAwareness xmlns="http://schemas.microsoft.com/SMI/2016/WindowsSettings">PerMonitorV2</dpiAwareness>
</asmv3:windowsSettings>
</asmv3:application>

@@ -6,7 +6,11 @@ object AboutBox: TAboutBox
ClientHeight = 315
ClientWidth = 481
Color = clBtnFace
ParentFont = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = True
Position = poOwnerFormCenter
@@ -8,10 +8,10 @@ interface

uses
Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, SysUtils, ComCtrls, pngimage, gnugettext,
Dialogs, SynRegExpr, Vcl.Menus, ClipBrd;
Dialogs, SynRegExpr, Vcl.Menus, ClipBrd, extra_controls;

type
TAboutBox = class(TForm)
TAboutBox = class(TExtForm)
btnClose: TButton;
lblAppName: TLabel;
lblAppVersion: TLabel;
@@ -318,7 +318,6 @@ TAppSettings = class(TObject)
function GetNextNode(Tree: TVirtualStringTree; CurrentNode: PVirtualNode; Selected: Boolean=False): PVirtualNode;
function GetPreviousNode(Tree: TVirtualStringTree; CurrentNode: PVirtualNode; Selected: Boolean=False): PVirtualNode;
function DateBackFriendlyCaption(d: TDateTime): String;
procedure InheritFont(AFont: TFont);
function GetLightness(AColor: TColor): Byte;
function ReformatSQL(SQL: String): String;
function ParamBlobToStr(lpData: Pointer): String;
@@ -1751,39 +1750,6 @@ procedure ExplodeQuotedList(Text: String; var List: TStringList);
end;


procedure InheritFont(AFont: TFont);
var
LogFont: TLogFont;
GUIFontName: String;
begin
// Set custom font if set, or default system font.
// In high-dpi mode, the font *size* is increased automatically somewhere in the VCL,
// caused by a form's .Scaled property. So we don't increase it here again.
// To test this, you really need to log off/on Windows!
GUIFontName := AppSettings.ReadString(asGUIFontName);
if not GUIFontName.IsEmpty then begin
// Apply user specified font
AFont.Name := GUIFontName;
// Set size on top of automatic dpi-increased size
AFont.Size := AppSettings.ReadInt(asGUIFontSize);
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 := LogFont.lfHeight;
AFont.Orientation := LogFont.lfOrientation;
AFont.Charset := TFontCharset(LogFont.lfCharSet);
AFont.Name := PChar(@LogFont.lfFaceName);
case LogFont.lfPitchAndFamily and $F of
VARIABLE_PITCH: AFont.Pitch := fpVariable;
FIXED_PITCH: AFont.Pitch := fpFixed;
else AFont.Pitch := fpDefault;
end;
end;
end;
end;


function GetLightness(AColor: TColor): Byte;
var
R, G, B: Byte;
@@ -9,7 +9,7 @@ interface
{$I const.inc}

type
TfrmBinEditor = class(TFormWithSizeGrip)
TfrmBinEditor = class(TExtForm)
memoText: TMemo;
tlbStandard: TToolBar;
btnWrap: TToolButton;
@@ -90,6 +90,7 @@ procedure TfrmBinEditor.SetFont(font: TFont);
procedure TfrmBinEditor.FormCreate(Sender: TObject);
begin
TranslateComponent(Self);
AddSizeGrip;
end;


@@ -10,7 +10,11 @@ object frmPasswordChange: TfrmPasswordChange
Constraints.MaxWidth = 600
Constraints.MinHeight = 185
Constraints.MinWidth = 400
ParentFont = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
OnCreate = FormCreate
@@ -8,7 +8,7 @@ interface
Vcl.Menus, Clipbrd, Vcl.ComCtrls, System.Math;

type
TfrmPasswordChange = class(TFormWithSizeGrip)
TfrmPasswordChange = class(TExtForm)
lblHeading: TLabel;
lblPassword: TLabel;
lblRepeatPassword: TLabel;
@@ -58,6 +58,7 @@ implementation
procedure TfrmPasswordChange.FormCreate(Sender: TObject);
begin
TranslateComponent(Self);
AddSizeGrip;
end;


@@ -8,7 +8,11 @@ object ColumnSelectionForm: TColumnSelectionForm
Color = clBtnFace
Constraints.MinHeight = 150
Constraints.MinWidth = 200
ParentFont = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
@@ -7,7 +7,7 @@ interface
apphelpers, gnugettext, extra_controls;

type
TColumnSelectionForm = class(TFormWithSizeGrip)
TColumnSelectionForm = class(TExtForm)
btnCancel: TButton;
btnOK: TButton;
chkSelectAll: TCheckBox;
@@ -46,6 +46,7 @@ implementation
procedure TColumnSelectionForm.FormCreate(Sender: TObject);
begin
TranslateComponent(Self);
AddSizeGrip;
Width := AppSettings.ReadInt(asColumnSelectorWidth);
Height := AppSettings.ReadInt(asColumnSelectorHeight);
FCheckedColumns := TStringList.Create;
@@ -8,7 +8,11 @@ object connform: Tconnform
Color = clBtnFace
Constraints.MinHeight = 360
Constraints.MinWidth = 640
ParentFont = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
ShowHint = True
OnClose = FormClose
@@ -14,7 +14,7 @@ interface
dbconnection, gnugettext, SynRegExpr, System.Types, System.IOUtils, Vcl.GraphUtil;

type
Tconnform = class(TFormWithSizeGrip)
Tconnform = class(TExtForm)
btnCancel: TButton;
btnOpen: TButton;
btnSave: TButton;
@@ -239,6 +239,7 @@ procedure Tconnform.FormCreate(Sender: TObject);
begin
// Fix GUI stuff
TranslateComponent(Self);
AddSizeGrip;
FixDropDownButtons(Self);
lblDownloadPlink.Font.Style := [fsUnderline];
lblDownloadPlink.Font.Color := clBlue;
@@ -7,7 +7,11 @@ object CopyTableForm: TCopyTableForm
Color = clBtnFace
Constraints.MinHeight = 340
Constraints.MinWidth = 380
ParentFont = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
OnClose = FormClose
@@ -8,7 +8,7 @@ interface
dbconnection, dbstructures, VirtualTrees, SynEdit, SynMemo, Menus, gnugettext;

type
TCopyTableForm = class(TFormWithSizeGrip)
TCopyTableForm = class(TExtForm)
editNewTablename: TEdit;
lblNewTablename: TLabel;
btnCancel: TButton;
@@ -68,6 +68,7 @@ implementation
procedure TCopyTableForm.FormCreate(Sender: TObject);
begin
TranslateComponent(Self);
AddSizeGrip;
FixDropDownButtons(Self);
Width := AppSettings.ReadInt(asCopyTableWindowWidth);
Height := AppSettings.ReadInt(asCopyTableWindowHeight);
@@ -6,7 +6,11 @@ object CreateDatabaseForm: TCreateDatabaseForm
ClientHeight = 227
ClientWidth = 317
Color = clBtnFace
ParentFont = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poOwnerFormCenter
OnClose = FormClose
@@ -4,10 +4,10 @@ interface

uses
Windows, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, SynEdit, SynMemo,
dbconnection, dbstructures, gnugettext, SynRegExpr;
dbconnection, dbstructures, gnugettext, SynRegExpr, extra_controls;

type
TCreateDatabaseForm = class(TForm)
TCreateDatabaseForm = class(TExtForm)
editDBName: TEdit;
lblDBName: TLabel;
btnOK: TButton;
@@ -6,7 +6,11 @@ object DataSortingForm: TDataSortingForm
ClientHeight = 97
ClientWidth = 204
Color = clBtnFace
ParentFont = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
@@ -4,11 +4,11 @@ interface

uses
Windows, SysUtils, Classes, Controls, Forms, StdCtrls, ExtCtrls, ComCtrls, Buttons,
Vcl.Graphics, apphelpers, gnugettext;
Vcl.Graphics, apphelpers, gnugettext, extra_controls;


type
TDataSortingForm = class(TForm)
TDataSortingForm = class(TExtForm)
pnlBevel: TPanel;
btnOK: TButton;
btnCancel: TButton;
@@ -7,7 +7,11 @@ object frmEditVariable: TfrmEditVariable
Color = clBtnFace
Constraints.MinHeight = 260
Constraints.MinWidth = 200
ParentFont = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
OnCreate = FormCreate
@@ -10,7 +10,7 @@ interface
TVarType = (vtString, vtNumeric, vtBoolean, vtEnum);
EVariableError = class(Exception);

TfrmEditVariable = class(TFormWithSizeGrip)
TfrmEditVariable = class(TExtForm)
btnOK: TButton;
btnCancel: TButton;
grpScope: TGroupBox;
@@ -56,6 +56,7 @@ implementation
procedure TfrmEditVariable.FormCreate(Sender: TObject);
begin
TranslateComponent(Self);
AddSizeGrip;
Width := AppSettings.ReadInt(asEditVarWindowWidth);
Height := AppSettings.ReadInt(asEditVarWindowHeight);
end;
@@ -8,7 +8,11 @@ object frmExportGrid: TfrmExportGrid
Color = clBtnFace
Constraints.MinHeight = 450
Constraints.MinWidth = 350
ParentFont = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
OnClose = FormClose
@@ -10,7 +10,7 @@ interface
type
TGridExportFormat = (efExcel, efCSV, efHTML, efXML, efSQLInsert, efSQLReplace, efSQLDeleteInsert, efLaTeX, efWiki, efPHPArray, efMarkDown, efJSON);

TfrmExportGrid = class(TFormWithSizeGrip)
TfrmExportGrid = class(TExtForm)
btnOK: TButton;
btnCancel: TButton;
grpFormat: TRadioGroup;
@@ -104,6 +104,7 @@ procedure TfrmExportGrid.FormCreate(Sender: TObject);
FormatDesc: String;
begin
TranslateComponent(Self);
AddSizeGrip;
Width := AppSettings.ReadInt(asGridExportWindowWidth);
Height := AppSettings.ReadInt(asGridExportWindowHeight);
editFilename.Text := AppSettings.ReadString(asGridExportFilename);

0 comments on commit 92c8f62

Please sign in to comment.
You can’t perform that action at this time.