настройки в .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'). Это очень грубая и готовая метрика, потому что он не учитывает межстрочный интервал и так далее. Тем не менее, часто все, что вам нужно сделать, это быть в состоянии организовать, что GUI масштабируется правильно с PixelsPerInch.

вы также должны отметить свое приложение как высокий DPI aware. Лучший способ сделать это через манифест приложения. Поскольку инструменты сборки 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 содержит фактический манифест. Вам также нужно будет включить раздел comctl32 v6 и установить requestedExecutionLevel до asInvoker. Затем вы связываете этот скомпилированный ресурс с вашим приложением и убедитесь, что Delphi не пытается сделать то же самое с его манифестом. В современном Delphi вы достигаете этого, установив параметр проекта темы выполнения в None.

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

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

Windows 8.1 на обновление DPI монитора

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

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

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

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

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

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

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

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

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

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

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

или

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

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

• развернуть все по горизонтали на 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 является безвозвратным:

• форма спроектирована с 9 кегль, шрифт Segoe UI с @ 96 точек на дюйм (15px 6.67 РХ х)
• пользователь работает с 9 кегль, шрифт Segoe Ui В @ 150 точек на дюйм (10.52 РХ х 25 пикселей)

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

• шрифт Segoe UI для 14пт @ 96 точек на дюйм (10.52 РХ х 25 пикселей)
• шрифт Segoe UI с 9 кегль @ 150 точек на дюйм (10.52 РХ х 25 пикселей)

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

StandardizeFormFont

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

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 метод. Сначала он должен отключить все якоря на форме, затем выполнить масштабирование, а затем снова включить якоря:

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;