Ответ 1

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

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

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

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

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

Delphi XE выглядит так, когда вы устанавливаете масштабирование DPI на "Fonts @200%" в Windows 7, а Delphi XE2 аналогично разбивается на Windows 7 и 8, но эти глюки, по-видимому, исправлены с Delphi XE4:

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

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

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

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

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

Ответ 2

Ваши настройки в файле .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, приводит к тому, что элементы управления блуждают по серия изменений. На моем месте работы, чтобы избежать этого, у нас есть строгая политика, формы которой редактируются только при 96dpi (100% масштабирование).

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

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

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

Вы также должны отметить свое приложение как с высоким уровнем DPI. Лучший способ сделать это - проявить себя. Поскольку инструменты сборки 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>

Ресурс script выглядит следующим образом:

1 24 "Manifest.txt"

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

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

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

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

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

Ответ 3

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

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

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

• 4 диалоговых окна (dlus) в ширину и
• 8 диалоговых блоков (clus) high

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

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

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

• Разработчик
• разработал форму с MS Sans Serif 8pt (где средний символ 6.21px x 13.00px, при 96dpi)

• пользователь работает с Tahoma 8pt (где средний символ 5.94px x 13.00px, при 96dpi)

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

или

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

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

• развернуть все по горизонтали на 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.67px x 15px)
• пользователь работает с Segoe UI 9pt @150dpi (10.52px x 25px)

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

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

работают с тем же шрифтом. 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 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 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 default size, or we're specifying what it 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 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 и исправьте ваше ошибочное приложение

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

Ответ 4

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

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;