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

Также важно отметить, что соблюдение пользовательского 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 и исправьте ваше ошибочное приложение

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

Вот мой подарок. Функция, которая может помочь вам с горизонтальным позиционированием элементов в ваших графических интерфейсах 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;