Windows字体缩放大于100％时如何使GUI正常运行
Answers:
注意：请参阅其他答案，因为它们包含非常有价值的技术。我在这里的回答仅提供警告和警告，以防止容易理解DPI。
我通常避免使用进行DPI感知缩放TForm.Scaled = True。仅当DPI意识对打电话给我并愿意为此付出代价的客户变得重要时，它才对我重要。这种观点背后的技术原因是，无论是否了解DPI，您都在打开一个通往受伤世界的窗口。许多标准和第三方VCL控件在High DPI中不能很好地工作。值得注意的例外是，包装Windows公共控件的VCL部件在高DPI时表现出色。大量的第三方和内置的Delphi VCL自定义控件无法很好地发挥作用，或者根本无法达到很高的DPI。如果您打算打开TForm.Scaled，请确保针对项目中的每个表单，您使用的每个第三方和内置控件都以96、125和150 DPI进行测试。
Delphi本身是用Delphi编写的。对于大多数形式，它都已打开了“高DPI意识”标记，尽管就在最近的Delphi XE2中，IDE作者自己还是决定不打开“高DPI意识”清单标记。请注意，在Delphi XE4和更高版本中，HIGH DPI感知标记已打开，并且IDE看起来不错。
我建议您不要使用带有高DPI Aware标志（如David的答案所示）的TForm.Scaled = true（这是Delphi中的默认设置，因此，除非您对其进行了修改，否则大多数表单都具有Scaled = true）。使用内置的delphi表单设计器构建的VCL应用程序。
过去，我曾尝试对TForm.Scaled为true以及Delphi表单缩放出现故障时可以看到的那种破损进行最小化的示例。这些故障并非总是且仅由DPI值（而不是96）触发。我无法确定其他事物的完整列表，包括Windows XP字体大小的更改。但是，由于大多数故障仅出现在我自己的应用程序中，因此在相当复杂的情况下，我决定向您展示一些可以验证自己的证据。
在Windows 7中将DPI Scaling设置为“ Fonts @ 200％”时，Delphi XE看起来像这样，并且在Windows 7和8中，Delphi XE2同样被破坏，但是这些故障在Delphi XE4上似乎已得到修复：
这些大多是标准的VCL控件，在高DPI时表现不佳。请注意，大多数事情根本没有扩展，因此Delphi IDE开发人员已决定忽略DPI意识，并关闭DPI虚拟化。如此有趣的选择。
仅在需要这种新的痛苦和困难选择的新来源时，才关闭DPI虚拟化。我建议你别管它。请注意，Windows通用控件通常似乎可以正常工作。请注意，Delphi数据浏览器控件是一个围绕标准Windows Tree公共控件的C＃WinForms包装器。那纯粹是微软的小故障，要解决这个问题，要么需要Embarcadero为他们的数据浏览器重写一个纯净的本机.Net树控件，要么编写一些DPI-check-and-modify-properties代码来更改控件中的项目高度。甚至连Microsoft WinForms都不能自动，干净地处理高DPI，而无需自定义垃圾代码。
更新：有趣的事实：尽管delphi IDE似乎没有被“虚拟化”，但它并未使用David所示的清单内容来实现“非DPI虚拟化”。也许它在运行时使用一些API函数。
更新2：针对我将如何支持100％/ 125％DPI的要求，我提出了一个两阶段计划。第1阶段是清点我的代码，以获取需要针对高DPI进行修复的自定义控件，然后制定计划对其进行修复或逐步淘汰。第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文件时使用的缩放比例会导致控件在一系列编辑中徘徊。在我的工作场所，为避免这种情况，我们有一个严格的政策，即表单只能以96dpi（100％缩放）进行编辑。
实际上，我的版本ScaleFromSmallFontsDimension还考虑了表单字体在运行时与设计时设置的字体可能不同的可能性。在XP计算机上，我的应用程序表单使用8pt Tahoma。在Vista和更高版本上，使用9pt Segoe UI。这提供了另一个自由度。缩放必须考虑到这一点，因为假定源代码中使用的绝对尺寸值是相对于96dpi的8pt Tahoma基线的相对值。
如果您在用户界面中使用任何图像或字形，那么这些图像或字形也需要缩放。一个常见的示例是在工具栏和菜单上使用的标志符号。您需要提供这些字形作为链接到可执行文件的图标资源。每个图标都应包含一定范围的大小，然后在运行时选择最合适的大小并将其加载到图像列表中。可以在以下位置找到有关该主题的一些详细信息：如何在不出现别名的情况下从资源加载图标？
另一个有用的技巧是以相对单位（相对于TextWidth或）定义尺寸TextHeight。因此，如果您希望某物的大小约为10条垂直线，则可以使用10*Canvas.TextHeight('Ag')。这是一个非常粗糙且易于使用的指标，因为它不允许行距等等。但是，通常您需要做的就是能够使用来安排GUI的正确缩放 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>资源脚本如下所示：
1 24 "Manifest.txt"其中Manifest.txt包含实际清单。您还需要包括comctl32 v6部分并将其设置requestedExecutionLevel为asInvoker。然后，您可以将此编译后的资源链接到您的应用程序，并确保Delphi不会对其清单进行尝试。在现代的Delphi中，您可以通过将“运行时主题”项目选项设置为“无”来实现。
清单是将您的应用声明为高度DPI感知的正确方法。如果您只是想快速尝试一下而又不会弄乱您的清单，请致电SetProcessDPIAware。这样做是您运行应用程序时要做的第一件事。最好在早期的单元初始化部分之一中，或作为.dpr文件中的第一件事。
如果您不声明您的应用程序具有很高的DPI感知能力，那么对于任何字体比例超过125％的用户，Vista及更高版本将以旧版模式呈现它。这看起来很可怕。尽量避免掉入那个陷阱。
Windows 8.1每台显示器DPI更新
从Windows 8.1开始，现在每个监视器的DPI设置都支持OS（http://msdn.microsoft.com/zh-cn/magazine/dn574798.aspx）。对于现代设备而言，这可能是一个大问题，因为这些设备可能连接了具有不同功能的不同显示器。您的DPI笔记本电脑屏幕可能非常高，而DPI外部投影仪却很低。支持这种情况需要比上述更多的工作。
还需要注意的是，尊重用户的DPI只是您实际工作的一部分：
尊重用户的字体大小
几十年来，Windows通过使用对话框单元而不是像素执行布局的概念解决了这一问题。一个“对话框单位”如此定义字体的平均字符是
- 4个对话框单位（dlus）宽，以及
- 高8个对话单元（clus）
Delphi确实附带了（buggy）概念Scaled，其中表单尝试根据
- 用户的Windows DPI设置
- 最后保存表单的开发人员的计算机上的DPI设置
当用户使用与您设计表单所用字体不同的字体时，这不能解决问题，例如：
- 开发人员使用MS Sans Serif 8pt设计表格（平均字符为
6.21px x 13.00px96dpi） 使用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只是影响字体大小的一件事。用户的偏好是另一个。
标准化表格字体
克洛维斯（Clovis）注意到我引用了一个函数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;这是实际缩放表单的工作。它可以解决Borland自己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，并修复有问题的应用程序
注意：任何代码都会发布到公共领域。无需注明出处。
这是我的礼物。可以帮助您在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;
SetProcessDPIAware。