При выборе большого размера шрифта в панели управления Windows (например, 125% или 150%) в приложении VCL возникают проблемы каждый раз, когда что-то было установлено по пикселям.

Возьмите TStatusBar.Panel. Я установил его ширину так, чтобы он содержал ровно одну метку, теперь с большими шрифтами метка «переполняется». Та же проблема с другими компонентами.

Некоторые новые ноутбуки Dell уже поставляются с настройкой по умолчанию 125%, поэтому, если раньше эта проблема возникала довольно редко, теперь она действительно важна.

Что можно сделать, чтобы решить эту проблему?

Примечание. Просмотрите другие ответы, поскольку они содержат очень ценные приемы. Мой ответ здесь содержит только предостережения и предостережения против предположения, что осведомленность о DPI - это просто.

Я обычно избегаю масштабирования с учетом DPI с помощью TForm.Scaled = True. Осведомленность о DPI важна для меня только тогда, когда это становится важным для клиентов, которые звонят мне и готовы за это платить. Техническая причина этой точки зрения заключается в том, что осведомленность о DPI или нет, вы открываете окно в мир боли. Многие стандартные и сторонние элементы управления VCL не работают с высоким разрешением. Заметным исключением является то, что части VCL, которые охватывают общие элементы управления Windows, работают замечательно при высоком разрешении. Огромное количество сторонних и встроенных пользовательских элементов управления Delphi VCL не работают должным образом или вообще не работают при высоком разрешении. Если вы планируете включить TForm.Scaled, обязательно протестируйте 96, 125 и 150 DPI для каждой формы в вашем проекте, а также для всех сторонних и встроенных элементов управления, которые вы используете.

Сам Delphi написан на Delphi. В нем включен флаг осведомленности о высоком разрешении для большинства форм, хотя даже совсем недавно, как в Delphi XE2, авторы среды разработки сами решили НЕ включать этот флаг манифеста о высоком разрешении на разрешение. Обратите внимание, что в Delphi XE4 и более поздних версиях флаг поддержки HIGH DPI включен, и среда IDE выглядит хорошо.

Я предлагаю вам не использовать TForm.Scaled = true (который используется по умолчанию в Delphi, поэтому, если вы не изменили его, большинство ваших форм имеют Scaled = true) с флагами High DPI Aware (как показано в ответах Дэвида) с Приложения VCL, созданные с использованием встроенного конструктора форм delphi.

В прошлом я пытался сделать минимальный образец поломки, которую вы можете ожидать увидеть, когда TForm.Scaled имеет значение true и когда масштабирование формы Delphi имеет сбой. Эти сбои не всегда и вызываются только значением DPI, отличным от 96. Мне не удалось определить полный список других вещей, включая изменения размера шрифта Windows XP. Но поскольку большинство этих сбоев появляется только в моих собственных приложениях, в довольно сложных ситуациях я решил показать вам некоторые доказательства, которые вы можете проверить самостоятельно.

Delphi XE выглядит так, когда вы устанавливаете масштабирование DPI на «Fonts @ 200%» в Windows 7, и Delphi XE2 так же не работает в Windows 7 и 8, но эти сбои, похоже, исправлены в Delphi XE4:

В основном это стандартные элементы управления VCL, которые некорректно работают при высоком разрешении. Обратите внимание, что большинство вещей вообще не масштабировалось, поэтому разработчики IDE Delphi решили игнорировать осведомленность о DPI, а также отключить виртуализацию DPI. Такой интересный выбор.

Отключите виртуализацию DPI, только если вам нужен этот новый дополнительный источник боли и трудный выбор. Я предлагаю вам оставить это в покое. Обратите внимание, что общие элементы управления Windows в основном работают нормально. Обратите внимание, что элемент управления обозревателя данных Delphi представляет собой оболочку C # WinForms вокруг стандартного общего элемента управления деревом Windows. Это чистый сбой Microsoft, и для его исправления может потребоваться, чтобы Embarcadero либо переписал чистый родной элемент управления деревом .Net для своего проводника данных, либо написал код DPI-check-and-modify-properties для изменения высоты элементов в элементе управления. Даже Microsoft WinForms не может обрабатывать высокий DPI чисто, автоматически и без специального кода kludge.

Обновление: интересный факт: хотя среда IDE delphi не кажется «виртуализированной», она не использует содержимое манифеста, показанное Дэвидом, для достижения «виртуализации без DPI». Возможно, он использует какую-то функцию API во время выполнения.

Обновление 2: в ответ на то, как я буду поддерживать 100% / 125% DPI, я бы предложил двухэтапный план. Фаза 1 - инвентаризация моего кода для настраиваемых элементов управления, которые необходимо исправить для высокого разрешения, а затем составить план их исправления или постепенного отказа. Фаза 2 заключалась в том, чтобы взять некоторые области моего кода, которые разработаны как формы без управления макетом, и преобразовать их в формы, которые используют какое-то управление макетом, чтобы изменение DPI или высоты шрифта могло работать без отсечения. Я подозреваю, что такая компоновка «между элементами управления» будет намного более сложной для большинства приложений, чем работа «внутри управления».

Обновление: в 2016 году последняя версия Delphi 10.1 Berlin хорошо работает на моей рабочей станции с разрешением 150 dpi.

Ваши настройки в файле .dfm будут правильно увеличены, пока Scaledесть True.

Если вы устанавливаете размеры в коде, вам нужно масштабировать их, Screen.PixelsPerInchразделив на Form.PixelsPerInch. Используйте MulDivдля этого.

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

Это то, что делает фреймворк сохранения формы, когда Scaledесть True.

Фактически, вы можете привести убедительный аргумент в пользу замены этой функции версией, которая жестко кодирует значение 96 в качестве знаменателя. Это позволяет вам использовать абсолютные значения размеров и не беспокоиться об изменении значения, если вы случайно измените масштаб шрифта на своей машине разработки и повторно сохраните файл .dfm. Причина, по которой это имеет значение, заключается в том, что PixelsPerInchсвойство, хранящееся в файле .dfm, является значением компьютера, на котором последний раз был сохранен файл .dfm.

const
  SmallFontsPixelsPerInch = 96;

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

Итак, продолжая тему, еще одна вещь, которой следует опасаться, заключается в том, что если ваш проект разрабатывается на нескольких машинах с разными значениями DPI, вы обнаружите, что масштабирование, которое Delphi использует при сохранении файлов .dfm, приводит к блужданию элементов управления по серии изменений. . На моем рабочем месте, чтобы избежать этого, мы придерживаемся строгой политики, согласно которой формы всегда редактируются только с разрешением 96 точек на дюйм (100% масштабирование).

Фактически, моя версия ScaleFromSmallFontsDimensionтакже допускает возможность отличия шрифта формы во время выполнения от шрифта, установленного во время разработки. На машинах XP мои формы приложения используют 8pt Tahoma. В Vista и выше используется пользовательский интерфейс Segoe с разрешением 9 пунктов. Это дает еще одну степень свободы. При масштабировании необходимо учитывать это, потому что абсолютные значения измерений, используемые в исходном коде, считаются относительными к базовой линии 8pt Tahoma при 96dpi.

Если вы используете какие-либо изображения или глифы в своем пользовательском интерфейсе, их тоже нужно масштабировать. Типичным примером могут служить глифы, которые используются на панелях инструментов и в меню. Вы захотите предоставить эти глифы в качестве ресурсов значков, связанных с вашим исполняемым файлом. Каждый значок должен содержать диапазон размеров, а затем во время выполнения вы выбираете наиболее подходящий размер и загружаете его в список изображений. Некоторые подробности по этой теме можно найти здесь: Как мне загружать значки с ресурса, не страдая от алиасинга?

Другой полезный прием - определение размеров в относительных единицах относительно TextWidthили TextHeight. Итак, если вы хотите, чтобы что-то было размером около 10 вертикальных линий, вы можете использовать 10*Canvas.TextHeight('Ag'). Это очень приблизительная и готовая метрика, потому что она не учитывает межстрочный интервал и так далее. Однако часто все, что вам нужно сделать, это уметь правильно масштабировать графический интерфейс PixelsPerInch.

Вы также должны отметить свое приложение как поддерживающее высокое разрешение . Лучше всего это сделать через манифест приложения. Поскольку инструменты сборки Delphi не позволяют настраивать манифест, который вы используете, это заставляет вас связать собственный ресурс манифеста.

<?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>

Сценарий ресурса выглядит так:

1 24 "Manifest.txt"

где Manifest.txtсодержит фактический manifest. Вам также нужно будет включить раздел comctl32 v6 и установить requestedExecutionLevelзначение asInvoker. Затем вы связываете этот скомпилированный ресурс со своим приложением и убедитесь, что Delphi не пытается сделать то же самое со своим манифестом. В современном Delphi этого можно добиться, установив для параметра проекта Runtime Themes значение None.

Манифест - это верный способ заявить, что ваше приложение поддерживает высокий уровень DPI. Если вы просто хотите быстро опробовать его, не вмешиваясь в манифест, позвоните SetProcessDPIAware. Сделайте это в первую очередь при запуске приложения. Желательно в одном из первых разделов инициализации модуля или первым делом в вашем файле .dpr.

Если вы не заявляете, что ваше приложение поддерживает высокий уровень разрешения, то Vista и более поздние версии будут отображать его в устаревшем режиме для любого масштабирования шрифта выше 125%. Это выглядит ужасно. Постарайтесь не попасть в эту ловушку.

Обновление Windows 8.1 для каждого монитора

Начиная с Windows 8.1, теперь ОС поддерживает настройки DPI для каждого монитора ( http://msdn.microsoft.com/en-ca/magazine/dn574798.aspx ). Это большая проблема для современных устройств, к которым могут быть подключены разные дисплеи с очень разными возможностями. У вас может быть экран ноутбука с очень высоким разрешением и внешний проектор с низким разрешением. Поддержка такого сценария требует еще больше усилий, чем описано выше.

Также важно отметить, что соблюдение DPI пользователя - это лишь часть вашей реальной работы:

соблюдение размера шрифта пользователя

На протяжении десятилетий Windows решала эту проблему, создавая макет с использованием диалоговых единиц , а не пикселей. «Диалог единица» определяется так , что шрифт в среднем характера является

• 4 диалоговых блока (dlus) в ширину, и
• 8 диалоговых блоков (кластеров) в высоту

Delphi действительно поставляется с (ошибочным) понятием Scaled, когда форма пытается автоматически настраиваться на основе

• Настройки Windows DPI пользователя, стихи
• настройка DPI на компьютере разработчика, который последним сохранил форму

Это не решает проблему, когда пользователь использует шрифт, отличный от того, который вы использовали для формы, например:

• разработчик разработал форму с помощью MS Sans Serif 8pt (где средний символ - 6.21px x 13.00px96 точек на дюйм)

• пользователь, работающий с Tahoma 8pt (где средний символ - 5.94px x 13.00px96 точек на дюйм)

  Как и в случае с любым, кто разрабатывает приложение для Windows 2000 или Windows XP.

или

• разработчик разработал форму с помощью ** Tahoma 8pt * (где средний символ - 5.94px x 13.00px96 точек на дюйм)
• пользователь, работающий с Segoe UI 9pt (где средний символ - 6.67px x 15px96 точек на дюйм)

Как хороший разработчик, вы будете уважать предпочтения шрифтов вашего пользователя. Это означает, что вам также необходимо масштабировать все элементы управления в вашей форме в соответствии с новым размером шрифта:

• развернуть все по горизонтали на 12,29% (6,67 / 5,94)
• растянуть все по вертикали на 15,38% (15/13)

Scaled не справится с этим за вас.

Становится хуже, когда:

• разработал вашу форму в Segoe UI 9pt (Windows Vista, Windows 7, Windows 8 по умолчанию)
• пользователь использует Segoe UI 14pt (например, мои предпочтения), который10.52px x 25px

Теперь вам нужно все масштабировать

• по горизонтали на 57,72%
• по вертикали на 66,66%

Scaled не справится с этим за вас.

Если вы умны, вы можете увидеть, насколько безразлично соблюдение DPI:

• форма, разработанная с помощью Segoe UI 9pt @ 96dpi (6,67 x 15 пикселей)
• пользователь, работающий с Segoe UI 9pt @ 150dpi (10,52px x 25px)

Вы не должны смотреть на настройки DPI пользователя, вы должны смотреть на их размер шрифта . Два пользователя работают

• Segoe UI 14pt @ 96dpi (10,52 x 25 пикселей)
• Segoe UI 9pt @ 150dpi (10,52 x 25 пикселей)

используют тот же шрифт . DPI - это только одна вещь, которая влияет на размер шрифта; предпочтения пользователя - другое.

StandardizeFormFont

Кловис заметил, что я ссылаюсь на функцию, StandardizeFormFontкоторая исправляет шрифт в форме и масштабирует его до нового размера шрифта. Это не стандартная функция, а полный набор функций, которые выполняют простую задачу, с которой Borland никогда не справлялся.

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 6 разных шрифтов; в Windows нет единой «настройки шрифта».
Но по опыту мы знаем, что наши формы должны соответствовать настройке шрифта заголовка значка.

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;

После того, как мы знаем , размер шрифта , мы будем масштабировать форму к , мы получаем текущую высоту шрифта в формах ( в пикселях ), и масштабах по этому фактору.

Например, если я устанавливаю форму -16, и форма в настоящее время находится -11, то нам нужно масштабировать всю форму следующим образом:

-16 / -11 = 1.45454%

Стандартизация происходит в два этапа. Сначала масштабируйте форму по соотношению новых и старых размеров шрифта. Затем фактически измените элементы управления (рекурсивно), чтобы использовать новый шрифт.

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;

Вот работа по фактическому масштабированию формы. Он работает с ошибками в собственном Form.ScaleByметоде Borland . Сначала он должен отключить все привязки в форме, затем выполнить масштабирование, а затем снова включить привязки:

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;

а затем мы должны рекурсивно использовать новый шрифт:

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;

С рекурсивно отключенными якорями:

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;

И якоря повторно активируются рекурсивно:

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;

С работой по фактическому изменению шрифта элементов управления осталось:

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;

Это намного больше кода, чем вы думали; Я знаю. Печально то, что на земле нет разработчика Delphi, кроме меня, который на самом деле делает свои приложения правильными.

Уважаемый разработчик Delphi ! Установите шрифт Windows на Segoe UI 14pt и исправьте ошибочное приложение.

Примечание . Любой код является общедоступным. Ссылка на авторство не требуется.

Вот мой подарок. Функция, которая может помочь вам с горизонтальным расположением элементов в макете графического интерфейса. Бесплатно для всех.

function CenterInParent(Place,NumberOfPlaces,ObjectWidth,ParentWidth,CropPercent: Integer): Integer;
  {returns formated centered position of an object relative to parent.
  Place          - P order number of an object beeing centered
  NumberOfPlaces - NOP total number of places available for object beeing centered
  ObjectWidth    - OW width of an object beeing centered
  ParentWidth    - PW width of an parent
  CropPercent    - CP percentage of safe margin on both sides which we want to omit from calculation
  +-----------------------------------------------------+
  |                                                     |
  |        +--------+       +---+      +--------+       |
  |        |        |       |   |      |        |       |
  |        +--------+       +---+      +--------+       |
  |     |              |             |            |     |
  +-----------------------------------------------------+
  |     |<---------------------A----------------->|     |
  |<-C->|<------B----->|<-----B----->|<-----B---->|<-C->|
  |                    |<-D>|
  |<----------E------------>|

  A = PW-C   B = A/NOP  C=(CP*PW)/100  D = (B-OW)/2
  E = C+(P-1)*B+D }

var
  A, B, C, D: Integer;
begin
  C := Trunc((CropPercent*ParentWidth)/100);
  A := ParentWidth - C;
  B := Trunc(A/NumberOfPlaces);
  D := Trunc((B-ObjectWidth)/2);
  Result := C+(Place-1)*B+D;
end;