How do I make my GUI behave well when Windows font scaling is greater than 100%

Solution 1:

Your settings in the .dfm file will be scaled up correctly, so long as Scaled is True.

If you are setting dimensions in code then you need to scale them by Screen.PixelsPerInch divided by Form.PixelsPerInch. Use MulDiv to do this.

function TMyForm.ScaleDimension(const X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, PixelsPerInch);
end;

This is what the form persistence framework does when Scaled is True.

In fact, you can make a cogent argument for replacing this function with a version that hard codes a value of 96 for the denominator. This allows you to use absolute dimension values and not worry about the meaning changing if you happen to change font scaling on your development machine and re-save the .dfm file. The reason that matters is that the PixelsPerInch property stored in the .dfm file is the value of the machine on which the .dfm file was last saved.

const
  SmallFontsPixelsPerInch = 96;

function ScaleFromSmallFontsDimension(const X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, SmallFontsPixelsPerInch);
end;

So, continuing the theme, another thing to be wary of is that if your project is developed on multiple machines with different DPI values, you will find that the scaling that Delphi uses when saving .dfm files results in controls wandering over a series of edits. At my place of work, to avoid this, we have a strict policy that forms are only ever edited at 96dpi (100% scaling).

In fact my version of ScaleFromSmallFontsDimension also makes allowance for the possibility of the form font differing at runtime from that set at designtime. On XP machines my application's forms use 8pt Tahoma. On Vista and up 9pt Segoe UI is used. This provides yet another degree of freedom. The scaling must account for this because the absolute dimension values used in the source code are assumed to be relative to the baseline of 8pt Tahoma at 96dpi.

If you use any images or glyphs in your UI then these need to scale too. A common example would be the glyphs that are used on toolbars and menus. You'll want to provide these glyphs as icon resources linked to your executable. Each icon should contain a range of sizes and then at runtime you choose the most appropriate size and load it into an image list. Some details on that topic can be found here: How do I load icons from a resource without suffering from aliasing?

Another useful trick is to define dimensions in relative units, relative to TextWidth or TextHeight. So, if you want something to be around 10 vertical lines in size you can use 10*Canvas.TextHeight('Ag'). This is a very rough and ready metric because it doesn't allow for line spacing and so on. However, often all you need to do is be able to arrange that the GUI scales correctly with PixelsPerInch.

You should also mark your application as being high DPI aware. The best way to do this is through the application manifest. Since Delphi's build tools don't allow you to customise the manifest you use this forces you to link your own manifest resource.

<?xml version='1.0' encoding='UTF-8' standalone='yes'?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
  <asmv3:application xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
    <asmv3:windowsSettings
         xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
      <dpiAware>true</dpiAware>
    </asmv3:windowsSettings>
  </asmv3:application>
</assembly>

The resource script looks like this:

1 24 "Manifest.txt"

where Manifest.txt contains the actual manifest. You would also need to include the comctl32 v6 section and set requestedExecutionLevel to asInvoker. You then link this compiled resource to your app and make sure that Delphi doesn't try to do the same with its manifest. In modern Delphi you achieve that by setting the Runtime Themes project option to None.

The manifest is the right way to declare your app to be high DPI aware. If you just want to try it out quickly without messing with your manifest, call SetProcessDPIAware. Do so as the very first thing you do when your app runs. Preferably in one of the early unit initialization sections, or as the first thing in your .dpr file.

If you don't declare your app to be high DPI aware then Vista and up will render it in a legacy mode for any font scaling above 125%. This looks quite dreadful. Try to avoid falling into that trap.

Windows 8.1 per monitor DPI update

As of Windows 8.1, there is now OS support for per-monitor DPI settings (http://msdn.microsoft.com/en-ca/magazine/dn574798.aspx). This is a big issue for modern devices which might have different displays attached with very different capabilities. You might have a very high DPI laptop screen, and a low DPI external projector. Supporting such a scenario takes even more work than described above.

Solution 2:

Note: Please see the other answers as they contain very valuable techniques. My answer here only provides caveats and cautions against assuming DPI-awareness is easy.

I generally avoid DPI-aware scaling with TForm.Scaled = True. DPI awareness is only important to me when it becomes important to customers who call me and are willing to pay for it. The technical reason behind that point of view is that DPI-awareness or not, you are opening a window into a world of hurt. Many standard and third party VCL controls do not work well in High DPI. The notable exception that the VCL parts that wrap Windows Common Controls work remarkably well at high DPI. A huge number of third party and built-in Delphi VCL custom controls do not work well, or at all, at high DPI. If you plan to turn on TForm.Scaled be sure to test at 96, 125, and 150 DPI for every single form in your project, and every single third party and built in control that you use.

Delphi itself is written in Delphi. It has the High DPI awareness flag turned on, for most forms, although even as recently as in Delphi XE2, the IDE authors themselves decided NOT to turn that High DPI Awareness manifest flag on. Note that in Delphi XE4 and later, the HIGH DPI awareness flag is turned on, and the IDE looks good.

I suggest that you do not use TForm.Scaled=true (which is a default in Delphi so unless you've modified it, most of your forms have Scaled=true) with the High DPI Aware flags (as shown in David's answers) with VCL applications that are built using the built-in delphi form designer.

I have tried in the past to make a minimal sample of the kind of breakage you can expect to see when TForm.Scaled is true, and when Delphi form scaling has a glitch. These glitches are not always and only triggered by a DPI value other than 96. I have been unable to determine a complete list of other things, that includes Windows XP font size changes. But since most of these glitches appear only in my own applications, in fairly complex situations, I have decided to show you some evidence you can verify yourselves.

Delphi XE looks like this when you set the DPI Scaling to "Fonts @ 200%" in Windows 7, and Delphi XE2 is similarly broken on Windows 7 and 8, but these glitches appear to be fixed as of Delphi XE4:

enter image description here

enter image description here

These are mostly Standard VCL controls that are misbehaving at high DPI. Note that most things have not been scaled at all, so the Delphi IDE developers have decided to ignore the DPI awareness, as well as turning off the DPI virtualization. Such an interesting choice.

Turn off DPI virtualization only if want this new additional source of pain, and difficult choices. I suggest you leave it alone. Note that Windows common controls mostly seem to work fine. Note that the Delphi data-explorer control is a C# WinForms wrapper around a standard Windows Tree common control. That's a pure microsoft glitch, and fixing it might either require Embarcadero to rewrite a pure native .Net tree control for their data explorer, or to write some DPI-check-and-modify-properties code to change item heights in the control. Not even microsoft WinForms can handle high DPI cleanly, automatically and without custom kludge code.

Update: Interesting factoid: While the delphi IDE appears not to be "virtualized", it is not using the manifest content shown by David to achieve "non-DPI-virtualization". Perhaps it is using some API function at runtime.

Update 2: In response to how I would support 100%/125% DPI, I would come up with a two-phase plan. Phase 1 is to inventory my code for custom controls that need to be fixed for high DPI, and then make a plan to fix them or phase them out. Phase 2 would be to take some areas of my code which are designed as forms without layout management and change them over to forms that use some kind of layout management so that DPI or font height changes can work without clipping. I suspect that this "inter-control" layout work would be far more complex in most applications than the "intra-control" work.

Update: In 2016, the latest Delphi 10.1 Berlin is working well on my 150 dpi workstation.

Solution 3:

It's also important to note that honoring the user's DPI is only a subset of your real job:

honoring the user's font size

For decades, Windows has solved this issue with the notion performing layout using Dialog Units, rather than pixels. A "dialog unit" is defined so that font's average character is

  • 4 dialog units (dlus) wide, and
  • 8 dialog units (clus) high

enter image description here

Delphi does ship with a (buggy) notion of Scaled, where a form tries to automatically adjust based on the

  • Windows DPI settings of the user, verses
  • the DPI setting on the machine of the developer who last saved the form

That doesn't solve the problem when the user uses a font different from what you designed the form with, e.g.:

  • developer designed the form with MS Sans Serif 8pt (where the average character is 6.21px x 13.00px, at 96dpi)
  • user running with Tahoma 8pt (where the average character is 5.94px x 13.00px, at 96dpi)

    As was the case with anyone developing an application for Windows 2000 or Windows XP.

or

  • developer designed the form with **Tahoma 8pt* (where the average character is 5.94px x 13.00px, at 96dpi)
  • a user running with Segoe UI 9pt (where the average character is 6.67px x 15px, at 96dpi)

As a good developer you are going to honor your user's font preferences. This means that you also need to scale all controls on your form to match the new font size:

  • expand everything horizontally by 12.29% (6.67/5.94)
  • stretch everything vertically by 15.38% (15/13)

Scaled won't handle this for you.

It gets worse when:

  • designed your form at Segoe UI 9pt (the Windows Vista, Windows 7, Windows 8 default)
  • user is running Segoe UI 14pt, (e.g. my preference) which is 10.52px x 25px

Now you have to scale everything

  • horizontally by 57.72%
  • vertically by 66.66%

Scaled won't handle this for you.


If you're smart you can see how honoring DPI is irrelavent:

  • form designed with Segoe UI 9pt @ 96dpi (6.67px x 15px)
  • user running with Segoe UI 9pt @ 150dpi (10.52px x 25px)

You should not be looking at the user's DPI setting, you should be looking at their font size. Two users running

  • Segoe UI 14pt @ 96dpi (10.52px x 25px)
  • Segoe UI 9pt @ 150dpi (10.52px x 25px)

are running the same font. DPI is just one thing that affects font size; the user's preferences are the other.

StandardizeFormFont

Clovis noticed that i reference a function StandardizeFormFont that fixes the font on a form, and scales it to the new font size. It's not a standard function, but an entire set of functions that accomplish the simple task that Borland never handled.

function StandardizeFormFont(AForm: TForm): Real;
var
    preferredFontName: string;
    preferredFontHeight: Integer;
begin
    GetUserFontPreference({out}preferredFontName, {out}preferredFontHeight);

    //e.g. "Segoe UI",     
    Result := Toolkit.StandardizeFormFont(AForm, PreferredFontName, PreferredFontHeight);
end;

Windows has 6 different fonts; there is no single "font setting" in Windows.
But we know from experience that our forms should follow the Icon Title Font setting

procedure GetUserFontPreference(out FaceName: string; out PixelHeight: Integer);
var
   font: TFont;
begin
   font := Toolkit.GetIconTitleFont;
   try
      FaceName := font.Name; //e.g. "Segoe UI"

      //Dogfood testing: use a larger font than we're used to; to force us to actually test it    
      if IsDebuggerPresent then
         font.Size := font.Size+1;

      PixelHeight := font.Height; //e.g. -16
   finally
      font.Free;
   end;
end;

Once we know the font size we will scale the form to, we get the form's current font height (in pixels), and scale up by that factor.

For example, if i am setting the form to -16, and the form is currently at -11, then we need to scale the entire form by:

-16 / -11 = 1.45454%

The standardization happens in two phases. First scale the form by the ratio of the new:old font sizes. Then actually change the controls (recursively) to use the new font.

function StandardizeFormFont(AForm: TForm; FontName: string; FontHeight: Integer): Real;
var
    oldHeight: Integer;
begin
    Assert(Assigned(AForm));

    if (AForm.Scaled) then
    begin
        OutputDebugString(PChar('WARNING: StandardizeFormFont: Form "'+GetControlName(AForm)+'" is set to Scaled. Proper form scaling requires VCL scaling to be disabled, unless you implement scaling by overriding the protected ChangeScale() method of the form.'));
    end;

    if (AForm.AutoScroll) then
    begin
        if AForm.WindowState = wsNormal then
        begin
            OutputDebugString(PChar('WARNING: StandardizeFormFont: Form "'+GetControlName(AForm)+'" is set to AutoScroll. Form designed size will be suseptable to changes in Windows form caption height (e.g. 2000 vs XP).'));
                    if IsDebuggerPresent then
                        Windows.DebugBreak; //Some forms would like it (to fix maximizing problem)
        end;
    end;

    if (not AForm.ShowHint) then
    begin
        AForm.ShowHint := True;
        OutputDebugString(PChar('INFORMATION: StandardizeFormFont: Turning on form "'+GetControlName(AForm)+'" hints. (ShowHint := True)'));
                    if IsDebuggerPresent then
                        Windows.DebugBreak; //Some forms would like it (to fix maximizing problem)
    end;

    oldHeight := AForm.Font.Height;

    //Scale the form to the new font size
//  if (FontHeight <> oldHeight) then    For compatibility, it's safer to trigger a call to ChangeScale, since a lot of people will be assuming it always is called
    begin
        ScaleForm(AForm, FontHeight, oldHeight);
    end;

    //Now change all controls to actually use the new font
    Toolkit.StandardizeFont_ControlCore(AForm, g_ForceClearType, FontName, FontHeight,
            AForm.Font.Name, AForm.Font.Size);

    //Return the scaling ratio, so any hard-coded values can be multiplied
    Result := FontHeight / oldHeight;
end;

Here's the job of actually scaling a form. It works around bugs in Borland's own Form.ScaleBy method. First it has to disable all anchors on the form, then perform the scaling, then re-enable the anchors:

TAnchorsArray = array of TAnchors;

procedure ScaleForm(const AForm: TForm; const M, D: Integer);
var
    aAnchorStorage: TAnchorsArray;
    RectBefore, RectAfter: TRect;
    x, y: Integer;
    monitorInfo: TMonitorInfo;
    workArea: TRect;
begin
    if (M = 0) and (D = 0) then
        Exit;

    RectBefore := AForm.BoundsRect;

    SetLength(aAnchorStorage, 0);
    aAnchorStorage := DisableAnchors(AForm);
    try
        AForm.ScaleBy(M, D);
    finally
        EnableAnchors(AForm, aAnchorStorage);
    end;

    RectAfter := AForm.BoundsRect;

    case AForm.Position of
    poScreenCenter, poDesktopCenter, poMainFormCenter, poOwnerFormCenter,
    poDesigned: //i think i really want everything else to also follow the nudging rules...why did i exclude poDesigned
        begin
            //This was only nudging by one quarter the difference, rather than one half the difference
//          x := RectAfter.Left - ((RectAfter.Right-RectBefore.Right) div 2);
//          y := RectAfter.Top - ((RectAfter.Bottom-RectBefore.Bottom) div 2);
            x := RectAfter.Left - ((RectAfter.Right-RectAfter.Left) - (RectBefore.Right-RectBefore.Left)) div 2;
            y := RectAfter.Top - ((RectAfter.Bottom-RectAfter.Top)-(RectBefore.Bottom-RectBefore.Top)) div 2;
        end;
    else
        //poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly:
        x := RectAfter.Left;
        y := RectAfter.Top;
    end;

    if AForm.Monitor <> nil then
    begin
        monitorInfo.cbSize := SizeOf(monitorInfo);
        if GetMonitorInfo(AForm.Monitor.Handle, @monitorInfo) then
            workArea := monitorInfo.rcWork
        else
        begin
            OutputDebugString(PChar(SysErrorMessage(GetLastError)));
            workArea := Rect(AForm.Monitor.Left, AForm.Monitor.Top, AForm.Monitor.Left+AForm.Monitor.Width, AForm.Monitor.Top+AForm.Monitor.Height);
        end;

//      If the form is off the right or bottom of the screen then we need to pull it back
        if RectAfter.Right > workArea.Right then
            x := workArea.Right - (RectAfter.Right-RectAfter.Left); //rightEdge - widthOfForm

        if RectAfter.Bottom > workArea.Bottom then
            y := workArea.Bottom - (RectAfter.Bottom-RectAfter.Top); //bottomEdge - heightOfForm

        x := Max(x, workArea.Left); //don't go beyond left edge
        y := Max(y, workArea.Top); //don't go above top edge
    end
    else
    begin
        x := Max(x, 0); //don't go beyond left edge
        y := Max(y, 0); //don't go above top edge
    end;

    AForm.SetBounds(x, y,
            RectAfter.Right-RectAfter.Left, //Width
            RectAfter.Bottom-RectAfter.Top); //Height
end;

and then we have to recursively actually use the new font:

procedure StandardizeFont_ControlCore(AControl: TControl; ForceClearType: Boolean;
        FontName: string; FontSize: Integer;
        ForceFontIfName: string; ForceFontIfSize: Integer);
const
    CLEARTYPE_QUALITY = 5;
var
    i: Integer;
    RunComponent: TComponent;
    AControlFont: TFont;
begin
    if not Assigned(AControl) then
        Exit;

    if (AControl is TStatusBar) then
    begin
        TStatusBar(AControl).UseSystemFont := False; //force...
        TStatusBar(AControl).UseSystemFont := True;  //...it
    end
    else
    begin
        AControlFont := Toolkit.GetControlFont(AControl);

        if not Assigned(AControlFont) then
            Exit;

        StandardizeFont_ControlFontCore(AControlFont, ForceClearType,
                FontName, FontSize,
                ForceFontIfName, ForceFontIfSize);
    end;

{   If a panel has a toolbar on it, the toolbar won't paint properly. So this idea won't work.
    if (not Toolkit.IsRemoteSession) and (AControl is TWinControl) and (not (AControl is TToolBar)) then
        TWinControl(AControl).DoubleBuffered := True;
}

    //Iterate children
    for i := 0 to AControl.ComponentCount-1 do
    begin
        RunComponent := AControl.Components[i];
        if RunComponent is TControl then
            StandardizeFont_ControlCore(
                    TControl(RunComponent), ForceClearType,
                    FontName, FontSize,
                    ForceFontIfName, ForceFontIfSize);
    end;
end;

With the anchors being recursively disabled:

function DisableAnchors(ParentControl: TWinControl): TAnchorsArray;
var
    StartingIndex: Integer;
begin
    StartingIndex := 0;
    DisableAnchors_Core(ParentControl, Result, StartingIndex);
end;


procedure DisableAnchors_Core(ParentControl: TWinControl; var aAnchorStorage: TAnchorsArray; var StartingIndex: Integer);
var
    iCounter: integer;
    ChildControl: TControl;
begin
    if (StartingIndex+ParentControl.ControlCount+1) > (Length(aAnchorStorage)) then
        SetLength(aAnchorStorage, StartingIndex+ParentControl.ControlCount+1);

    for iCounter := 0 to ParentControl.ControlCount - 1 do
    begin
        ChildControl := ParentControl.Controls[iCounter];
        aAnchorStorage[StartingIndex] := ChildControl.Anchors;

        //doesn't work for set of stacked top-aligned panels
//      if ([akRight, akBottom ] * ChildControl.Anchors) <> [] then
//          ChildControl.Anchors := [akLeft, akTop];

        if (ChildControl.Anchors) <> [akTop, akLeft] then
            ChildControl.Anchors := [akLeft, akTop];

//      if ([akTop, akBottom] * ChildControl.Anchors) = [akTop, akBottom] then
//          ChildControl.Anchors := ChildControl.Anchors - [akBottom];

        Inc(StartingIndex);
    end;

    //Add children
    for iCounter := 0 to ParentControl.ControlCount - 1 do
    begin
        ChildControl := ParentControl.Controls[iCounter];
        if ChildControl is TWinControl then
            DisableAnchors_Core(TWinControl(ChildControl), aAnchorStorage, StartingIndex);
    end;
end;

And anchors being recursively re-enabled:

procedure EnableAnchors(ParentControl: TWinControl; aAnchorStorage: TAnchorsArray);
var
    StartingIndex: Integer;
begin
    StartingIndex := 0;
    EnableAnchors_Core(ParentControl, aAnchorStorage, StartingIndex);
end;


procedure EnableAnchors_Core(ParentControl: TWinControl; aAnchorStorage: TAnchorsArray; var StartingIndex: Integer);
var
    iCounter: integer;
    ChildControl: TControl;
begin
    for iCounter := 0 to ParentControl.ControlCount - 1 do
    begin
        ChildControl := ParentControl.Controls[iCounter];
        ChildControl.Anchors := aAnchorStorage[StartingIndex];

        Inc(StartingIndex);
    end;

    //Restore children
    for iCounter := 0 to ParentControl.ControlCount - 1 do
    begin
        ChildControl := ParentControl.Controls[iCounter];
        if ChildControl is TWinControl then
            EnableAnchors_Core(TWinControl(ChildControl), aAnchorStorage, StartingIndex);
    end;
end;

With the work of actually changing a controls font left to:

procedure StandardizeFont_ControlFontCore(AControlFont: TFont; ForceClearType: Boolean;
        FontName: string; FontSize: Integer;
        ForceFontIfName: string; ForceFontIfSize: Integer);
const
    CLEARTYPE_QUALITY = 5;
var
    CanChangeName: Boolean;
    CanChangeSize: Boolean;
    lf: TLogFont;
begin
    if not Assigned(AControlFont) then
        Exit;

{$IFDEF ForceClearType}
    ForceClearType := True;
{$ELSE}
    if g_ForceClearType then
        ForceClearType := True;
{$ENDIF}

    //Standardize the font if it's currently
    //  "MS Shell Dlg 2" (meaning whoever it was opted into the 'change me' system
    //  "MS Sans Serif" (the Delphi default)
    //  "Tahoma" (when they wanted to match the OS, but "MS Shell Dlg 2" should have been used)
    //  "MS Shell Dlg" (the 9x name)
    CanChangeName :=
            (FontName <> '')
            and
            (AControlFont.Name <> FontName)
            and
            (
                (
                    (ForceFontIfName <> '')
                    and
                    (AControlFont.Name = ForceFontIfName)
                )
                or
                (
                    (ForceFontIfName = '')
                    and
                    (
                        (AControlFont.Name = 'MS Sans Serif') or
                        (AControlFont.Name = 'Tahoma') or
                        (AControlFont.Name = 'MS Shell Dlg 2') or
                        (AControlFont.Name = 'MS Shell Dlg')
                    )
                )
            );

    CanChangeSize :=
            (
                //there is a font size
                (FontSize <> 0)
                and
                (
                    //the font is at it's default size, or we're specifying what it's default size is
                    (AControlFont.Size = 8)
                    or
                    ((ForceFontIfSize <> 0) and (AControlFont.Size = ForceFontIfSize))
                )
                and
                //the font size (or height) is not equal
                (
                    //negative for height (px)
                    ((FontSize < 0) and (AControlFont.Height <> FontSize))
                    or
                    //positive for size (pt)
                    ((FontSize > 0) and (AControlFont.Size <> FontSize))
                )
                and
                //no point in using default font's size if they're not using the face
                (
                    (AControlFont.Name = FontName)
                    or
                    CanChangeName
                )
            );

    if CanChangeName or CanChangeSize or ForceClearType then
    begin
        if GetObject(AControlFont.Handle, SizeOf(TLogFont), @lf) <> 0 then
        begin
            //Change the font attributes and put it back
            if CanChangeName then
                StrPLCopy(Addr(lf.lfFaceName[0]), FontName, LF_FACESIZE);
            if CanChangeSize then
                lf.lfHeight := FontSize;

            if ForceClearType then
                lf.lfQuality := CLEARTYPE_QUALITY;
            AControlFont.Handle := CreateFontIndirect(lf);
        end
        else
        begin
            if CanChangeName then
                AControlFont.Name := FontName;
            if CanChangeSize then
            begin
                if FontSize > 0 then
                    AControlFont.Size := FontSize
                else if FontSize < 0 then
                    AControlFont.Height := FontSize;
            end;
        end;
    end;
end;

That's a whole lot more code than you thought it was going to be; i know. The sad thing is that there is no Delphi developer on earth, except for me, who actually makes their applications correct.

Dear Delphi Developer: Set your Windows font to Segoe UI 14pt, and fix your buggy application

Note: Any code is released into the public domain. No attribution required.