当Windows字体缩放大于100％时，如何使我的GUIperformance良好

在Windows控制面板中select较大的字体大小（如125％或150％）时，VCL应用程序中会出现问题，每次都按照像素设置。

采取TStatusBar.Panel 。 我已经设置了它的宽度，以便它包含一个标签，现在用大字体标签“溢出”。 与其他组件相同的问题。

戴尔的一些新笔记本电脑已经有125％的默认设置，所以过去这个问题相当罕见，现在非常重要。

可以做些什么来克服这个问题？

Answer 1

注意：请参阅其他答案，因为它们包含非常有价值的技术。 我在这里的回答只提供警告和警告，不要假设DPI意识很容易。

我通常使用TForm.Scaled = True避免DPI感知的缩放。 对于打电话给我并愿意支付费用的客户而言，DPI意识对我来说才是重要的。 这种观点背后的技术原因是，新闻部的意识与否，你打开了一个受伤的世界的窗口。 许多标准和第三方的VCL控件在高DPI中效果不佳。 包含Windows公共控件的VCL部件在高DPI下工作得非常好。 大量的第三方和内置的Delphi VCL自定义控件在高DPI下工作不好，或者根本不工作。 如果您计划打开TForm.Scaled，请确保您的项目中的每个表单都有96,125和150 DPI的testing，并且每个第三方都使用内置的控件。

Delphi本身是用Delphi编写的。 对于大多数表单，它都打开了高DPI警告标志，尽pipe即使在Delphi XE2中，IDE作者本身也决定不打开高DPI警告标志。 请注意，在Delphi XE4和更高版本中，HIGH DPI感知标志打开，IDE看起来不错。

我build议你不要使用TForm.Scaled = true（这是Delphi中的一个默认设置，所以除非你修改了它，大部分的表单都是Scaled = true），并且使用High DPI Aware标志（如David的答案中所示） VCL应用程序是使用内置的delphi表单devise器构build的。

在过去，我已经尝试了一下当TForm.Scaled为true时，以及当Delphi缩放出现问题时，您可以期望看到什么types的破坏。 这些毛刺并不总是，只有一个DPI值不是96.我一直无法确定其他事情的完整列表，包括Windows XP的字体大小的变化。 但是，由于大多数这些小故障只出现在我自己的应用程序中，在相当复杂的情况下，我决定向您显示一些证据，您可以validation自己。

在Windows 7中将DPI Scaling设置为“字体@ 200％”时，Delphi XE看起来像这样，在Windows 7和8上，Delphi XE2也同样崩溃，但是从Delphi XE4开始，这些毛刺似乎是固定的：

这些大多是标准的VCL控制，在高DPI上行事exception。 请注意，大多数事情根本没有扩展，所以Delphi IDE开发人员已经决定忽略DPI意识，并closuresDPI虚拟化。 这样一个有趣的select。

closuresDPI虚拟化只有想要这个新的额外的痛苦来源，并且是困难的select。 我build议你不要pipe它。 请注意，Windows通用控件大多似乎工作正常。 请注意，Delphi数据浏览器控件是围绕标准Windows树公共控件的C＃WinForms包装器。 这是一个纯粹的微软故障，修复它可能需要Embarcadero为其数据浏览器重写一个纯原生的.Net树形控件，或者编写一些DPI检查和修改属性代码来更改控件中的项目高度。 甚至微软的WinForms都不能自动处理高DPI，也不需要自定义的kludge代码。

更新：有趣的事实：虽然delphi IDE似乎不是“虚拟化”，但它并没有使用David显示的清单内容来实现“非DPI虚拟化”。 也许它在运行时使用了一些API函数。

更新2：为了回应我将如何支持100％/ 125％DPI，我会提出一个两阶段计划。 阶段1是清理自定义控件的代码，这些自定义控件需要针对高DPI进行修复，然后制定一个解决scheme或逐步淘汰它们。 第二阶段将采取我的代码的一些领域的devise为没有布局pipe理的forms，并将其更改为使用某种布局pipe理的表单，以便DPI或字体高度更改可以工作而不削减。 我怀疑，这种“相互控制”的布局工作在大多数应用中要比“内部控制”工作复杂得多。

更新： 2016年，最新的Delphi 10.1柏林在我的150 dpi工作站上运行良好。

Answer 2

只要Scaled为True ，您的.dfm文件中的设置就会正确放大。

如果你在代码中设置尺寸，那么你需要通过Screen.PixelsPerInch除以Form.PixelsPerInch来缩放它们。 使用MulDiv来做到这一点。

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

当Scaled为True时，这是表单持久性框架所做的。

事实上，你可以用一个硬编码为分母值96的版本来替代这个函数。 这允许您使用绝对尺寸值，而不必担心在开发计算机上更改字体缩放并重新保存.dfm文件时意义的改变。 重要的原因是存储在.dfm文件中的PixelsPerInch属性是上次保存.dfm文件的计算机的值。

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

因此，继续这个主题，还有一点需要注意的是，如果您的项目是在具有不同DPI值的多台机器上开发的，那么您会发现Delphi在保存.dfm文件时使用的缩放会导致控件在一系列编辑。 在我工作的地方，为了避免这种情况，我们有一个严格的政策，forms只能在96dpi（100％缩放）下进行编辑。

实际上，我的ScaleFromSmallFontsDimension版本也考虑到了在devise时设置的运行时窗体字体不同的可能性。 在XP机器上，我的应用程序的表单使用8pt的Tahoma。 在Vista和9pt使用Segoe UI。 这提供了另一个自由度。 缩放必须考虑到这一点，因为源代码中使用的绝对尺寸值被假定为相对于96dpi的8pt Tahoma的基线。

如果您在UI中使用任何图像或字形，那么这些也需要缩放。 一个常见的例子是在工具栏和菜单上使用的字形。 您需要提供这些字形作为链接到您的可执行文件的图标资源。 每个图标应包含一系列尺寸，然后在运行时select最合适的尺寸并将其加载到图像列表中。 关于这个主题的一些细节可以在这里find： 我如何从一个资源加载图标，而不会遭受别名？

另一个有用的技巧是以相对单位定义相对于TextWidth或TextHeight尺寸。 所以，如果你想要大约10条垂直线的大小，你可以使用10*Canvas.TextHeight('Ag') 。 这是一个非常粗糙和准备好的指标，因为它不允许行距等。 但是，通常所有您需要做的就是能够安排GUI使用PixelsPerInch正确PixelsPerInch 。

您还应该将您的应用程序标记为DPI高 。 最好的方法是通过应用程序清单。 由于Delphi的构build工具不允许你自定义你使用的清单，所以你必须链接你自己的清单资源。

 <?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 。 这样做是您的应用程序运行时所做的第一件事情。 最好在早期的单元初始化部分之一，或作为您的.dpr文件中的第一件事。

如果你没有声明你的应用程序是高DPI的意识，那么Vista和以上将使它在传统模式下的任何字体缩放125％以上。 这看起来相当可怕。 尽量避免陷入这个陷阱。

每台显示器的DPI更新为Windows 8.1

从Windows 8.1开始，现在支持每个监视器DPI设置的操作系统（ http://msdn.microsoft.com/en-ca/magazine/dn574798.aspx ）。 对于现代设备而言，这是一个很大的问题，可能会有不同的显示器附加不同的function。 您可能拥有非常高的DPI笔记本电脑屏幕和低DPI外部投影仪。 支持这种情况需要比上述更多的工作。

Answer 3

同样重要的是要注意尊重用户的DPI只是你真正的工作的一部分：

尊重用户的字体大小

数十年来，Windows已经使用对话单元 （而不是像素）执行布局的概念解决了这个问题。 定义一个“对话单元” ，以便字体的平均字符是

• 4个对话单元（dlus）宽，和
• 8个对话单元（clus）高

delphi确实提供了Scaled的（错误的）概念，表单试图根据

• 用户的Windows DPI设置，经文
• 上次保存表单的开发人员的机器上的DPI设置

当用户使用与devise表单不同的字体时，这并不能解决问题，例如：

• 开发人员用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

现在你必须扩展一切

• 横向减less57.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来修复表单上的字体，并将其缩放到新的字体大小。 这不是一个标准function，而是一组完成Borland从不处理的简单任务的function。

 function StandardizeFormFont(AForm: TForm): Real; var preferredFontName: string; preferredFontHeight: Integer; begin GetUserFontPreference({out}preferredFontName, {out}preferredFontHeight); //eg "Segoe UI", Result := Toolkit.StandardizeFormFont(AForm, PreferredFontName, PreferredFontHeight); end; 

Windows有6种不同的字体; Windows中没有单一的“字体设置”。
但是我们从经验中知道，我们的forms应该遵循图标标题字体设置

 procedure GetUserFontPreference(out FaceName: string; out PixelHeight: Integer); var font: TFont; begin font := Toolkit.GetIconTitleFont; try FaceName := font.Name; //eg "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; //eg -16 finally font.Free; end; end; 

一旦我们知道字体大小，我们将缩放表单，我们得到表单的当前字体高度（ 以像素为单位 ），然后按照这个因子放大。

例如，如果我将表单设置为-16 ，表单当前处于-11 ，那么我们需要通过以下方式缩放整个表单：

 -16 / -11 = 1.45454% 

标准化分两个阶段进行。 首先按照新旧字体大小的比例缩放表单。 然后实际上改变控制（recursion）使用新的字体。

 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 (eg 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; 

然后我们必须recursion地使用新的字体：

 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; 

随着锚的recursion禁用：

 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; 

并且recursion地重新启用锚：

 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 ，并修复您的越野车应用程序

注意 ：任何代码都被释放到公共领域。 不需要归属

Answer 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;