Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    primarykey
    data
    text
    <p>It's also important to note that honoring the user's DPI is only a subset of your real job: </p> <blockquote> <p>honoring the user's font size</p> </blockquote> <p>For decades, Windows has solved this issue with the notion performing layout using <strong>Dialog Units</strong>, rather than pixels. A <em>"dialog unit"</em> is defined so that font's <em>average character</em> is</p> <ul> <li>4 dialog units (dlus) wide, and</li> <li>8 dialog units (clus) high</li> </ul> <p><img src="https://i.stack.imgur.com/yRvvQ.png" alt="enter image description here"></p> <p>Delphi does ship with a (buggy) notion of <code>Scaled</code>, where a form tries to automatically adjust based on the </p> <ul> <li>Windows DPI settings of the user, verses</li> <li>the DPI setting on the machine of the developer who last saved the form</li> </ul> <p>That doesn't solve the problem when the user uses a font different from what you designed the form with, e.g.: </p> <ul> <li>developer designed the form with <em>MS Sans Serif 8pt</em> (where the average character is <code>6.21px x 13.00px</code>, at 96dpi)</li> <li><p>user running with <em>Tahoma 8pt</em> (where the average character is <code>5.94px x 13.00px</code>, at 96dpi)</p> <p>As was the case with anyone developing an application for Windows 2000 or Windows XP.</p></li> </ul> <p>or</p> <ul> <li>developer designed the form with **Tahoma 8pt* (where the average character is <code>5.94px x 13.00px</code>, at 96dpi)</li> <li>a user running with <em>Segoe UI 9pt</em> (where the average character is <code>6.67px x 15px</code>, at 96dpi)</li> </ul> <p>As a good developer you are going to honor your user's font preferences. This means that you also need to scale all controls on your form to match the new font size:</p> <ul> <li>expand everything horizontally by 12.29% (6.67/5.94)</li> <li>stretch everything vertically by 15.38% (15/13)</li> </ul> <p><code>Scaled</code> won't handle this for you.</p> <p>It gets worse when:</p> <ul> <li>designed your form at <strong>Segoe UI 9pt</strong> (the Windows Vista, Windows 7, Windows 8 default)</li> <li>user is running <strong>Segoe UI 14pt</strong>, (e.g. my preference) which is <code>10.52px x 25px</code></li> </ul> <p>Now you have to scale everything </p> <ul> <li>horizontally by 57.72%</li> <li>vertically by 66.66%</li> </ul> <p><code>Scaled</code> won't handle this for you.</p> <hr> <p>If you're smart you can see how honoring DPI is irrelavent: </p> <ul> <li>form designed with Segoe UI 9pt @ 96dpi (6.67px x 15px)</li> <li>user running with Segoe UI 9pt @ 150dpi (10.52px x 25px)</li> </ul> <p>You should not be looking at the user's DPI setting, you should be looking at their <em>font size</em>. Two users running</p> <ul> <li>Segoe UI 14pt @ 96dpi (10.52px x 25px)</li> <li>Segoe UI 9pt @ 150dpi (10.52px x 25px)</li> </ul> <p><em>are running the same font</em>. DPI is just <strong><em>one</em></strong> thing that affects font size; the user's preferences are the other.</p> <h1>StandardizeFormFont</h1> <p>Clovis noticed that i reference a function <code>StandardizeFormFont</code> that fixes the font on a form, and scales it to the new font size. It's not a standard function, but an entire set of functions that accomplish the simple task that Borland never handled.</p> <pre><code>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; </code></pre> <p>Windows has 6 different fonts; there is no single "font setting" in Windows.<br> But we know from experience that our forms should follow the <strong>Icon Title Font</strong> setting</p> <pre><code>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; </code></pre> <p>Once we know the font size we will scale the form <strong>to</strong>, we get the form's current font height (<strong>in pixels</strong>), and scale up by that factor.</p> <p>For example, if i am setting the form to <strong><code>-16</code></strong>, and the form is currently at <strong><code>-11</code></strong>, then we need to scale the entire form by:</p> <pre><code>-16 / -11 = 1.45454% </code></pre> <p>The standardization happens in two phases. First scale the form by the ratio of the new:old font sizes. Then actually change the controls (recursively) to use the new font.</p> <pre><code>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 &lt;&gt; 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; </code></pre> <p>Here's the job of actually scaling a form. It works around bugs in Borland's own <code>Form.ScaleBy</code> method. First it has to disable all anchors on the form, then perform the scaling, then re-enable the anchors:</p> <pre><code>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 &lt;&gt; 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 &gt; workArea.Right then x := workArea.Right - (RectAfter.Right-RectAfter.Left); //rightEdge - widthOfForm if RectAfter.Bottom &gt; 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; </code></pre> <p>and then we have to recursively actually <strong>use</strong> the new font:</p> <pre><code>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; </code></pre> <p>With the anchors being recursively disabled:</p> <pre><code>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) &gt; (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) &lt;&gt; [] then // ChildControl.Anchors := [akLeft, akTop]; if (ChildControl.Anchors) &lt;&gt; [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; </code></pre> <p>And anchors being recursively re-enabled:</p> <pre><code>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; </code></pre> <p>With the work of actually changing a controls font left to:</p> <pre><code>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 &lt;&gt; '') and (AControlFont.Name &lt;&gt; FontName) and ( ( (ForceFontIfName &lt;&gt; '') 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 &lt;&gt; 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 &lt;&gt; 0) and (AControlFont.Size = ForceFontIfSize)) ) and //the font size (or height) is not equal ( //negative for height (px) ((FontSize &lt; 0) and (AControlFont.Height &lt;&gt; FontSize)) or //positive for size (pt) ((FontSize &gt; 0) and (AControlFont.Size &lt;&gt; 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) &lt;&gt; 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 &gt; 0 then AControlFont.Size := FontSize else if FontSize &lt; 0 then AControlFont.Height := FontSize; end; end; end; end; </code></pre> <p>That's a whole lot more code than you thought it was going to be; i know. The sad thing is that there is no Delphi developer on earth, except for me, who actually makes their applications correct.</p> <blockquote> <p><strong>Dear Delphi Developer</strong>: Set your Windows font to <strong>Segoe UI 14pt</strong>, and fix your buggy application</p> <p><strong>Note</strong>: Any code is released into the public domain. No attribution required.</p> </blockquote>
    singulars
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. VO
      singulars
      1. This table or related slice is empty.
    2. VO
      singulars
      1. This table or related slice is empty.
    3. VO
      singulars
      1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload