Windowsフォントのスケーリングが100％を超える場合、GUIを適切に動作させるにはどうすればよいですか

Question

Windowsコントロールパネルで大きなフォントサイズ（125％、150％など）を選択すると、ピクセル単位で何かが設定されるたびにVCLアプリケーションに問題が発生します。

TStatusBar.Panel。幅が1つのラベルを含むように幅を設定しましたが、大きなフォントではラベルが「オーバーフロー」します。他のコンポーネントと同じ問題。

Dellの新しいラップトップには、デフォルト設定として125％がすでに搭載されているため、過去にはこの問題は非常にまれでしたが、今では非常に重要です。

この問題を克服するために何ができますか？

Answer 1

注：他の回答には非常に価値のあるテクニックが含まれているのでご覧ください。ここでの私の答えは、DPI対応が容易であると仮定することに対する警告と注意のみを提供します。

私は通常、TForm.Scaled = True。 DPIの認識は、私に電話をかけて、喜んで支払いをする顧客にとって重要になった場合にのみ重要です。その観点の背後にある技術的な理由は、DPIを認識しているかどうかにかかわらず、あなたは傷の世界への窓を開いているということです。多くの標準およびサードパーティのVCLコントロールは、高DPIではうまく機能しません。 Windows Common ControlsをラップするVCLパーツが高DPIで非常にうまく機能するという注目すべき例外です。多数のサードパーティおよび組み込みのDelphi VCLカスタムコントロールは、高DPIではうまく機能しないか、まったく機能しません。 TForm.Scaledをオンにする予定がある場合は、プロジェクト内のすべてのフォーム、および使用するサードパーティとビルトインコントロールごとに、96、125、および150 DPIでテストしてください。

Delphi自体はDelphiで書かれています。ほとんどのフォームで高DPI認識フラグがオンになっていますが、Delphi XE2のようにごく最近でも、IDE作成者自身がその高DPI認識マニフェストフラグをオンにしないことに決めました。 Delphi XE4以降では、HIGH DPI認識フラグがオンになり、IDEが適切に見えます。

TForm.Scaled = true（Delphiのデフォルトであるため、変更しない限り、ほとんどのフォームはScaled = trueになっています）とHigh DPI対応フラグ（Davidの回答に示されている）を使用しないことをお勧めします組み込みのデルファイフォームデザイナを使用して構築されたVCLアプリケーション。

過去に、TForm.Scaledがtrueの場合、およびDelphiフォームのスケーリングに不具合がある場合に予想される破損の最小限のサンプルを作成しようとしました。これらのグリッチは常に96以外のDPI値によってトリガーされるわけではありません。WindowsXPフォントサイズの変更を含む、他のすべてのリストを決定できませんでした。これらのグリッチは、非常に複雑な状況で、自分のアプリケーションでのみ表示されます。自分で確認できるいくつかの証拠を示すことにしました。

Windows 7でDPIスケーリングを「Fonts @ 200％」に設定すると、Delphi XEは次のようになります。Windows7および8では、Delphi XE2も同様に壊れますが、これらの不具合はDelphi XE4で修正されたようです。

これらはほとんどが高VPIで誤動作する標準VCLコントロールです。ほとんどのものはまったくスケーリングされていないことに注意してください。そのため、Delphi IDE開発者はDPI仮想化をオフにするだけでなく、DPI認識も無視することにしました。

この新しい追加の痛みの原因と難しい選択が必要な場合にのみ、DPI仮想化をオフにします。そのままにしておくことをお勧めします。ほとんどの場合、Windowsの共通コントロールは正常に機能するようです。 Delphiデータエクスプローラーコントロールは、標準のWindowsツリーコモンコントロールのC＃WinFormsラッパーであることに注意してください。それはMicrosoftの純粋な不具合であり、それを修正するにはEmbarcaderoがデータエクスプローラーの純粋なネイティブ.Netツリーコントロールを書き換えるか、コントロールのアイテムの高さを変更するためのDPI-check-and-modify-propertiesコードを書く必要があります。 Microsoft WinFormsでさえも、高DPIをきれいに、自動的に、カスタムクラッジコードなしで処理することはできません。

更新：興味深いファクトイド：delphi IDEは「仮想化」されていないように見えますが、Davidが示したマニフェストコンテンツを使用して「非DPI仮想化」を実現しているわけではありません。実行時のAPI関数。

更新2：100％/ 125％DPIをサポートする方法に応じて、2段階の計画を立てました。フェーズ1では、高DPIのために修正する必要があるカスタムコントロールのコードをインベントリし、修正または段階的に廃止する計画を立てます。フェーズ2は、レイアウト管理のないフォームとして設計されたコードの一部の領域を取得し、それらを何らかのレイアウト管理を使用するフォームに切り替えて、DPIまたはフォントの高さの変更がクリッピングなしで機能するようにすることです。この「コントロール間」レイアウト作業は、「コントロール内」作業よりもほとんどのアプリケーションではるかに複雑になると思います。

更新： 2016年、最新のDelphi 10.1 Berlinは150 dpiのワークステーションで正常に動作しています。

Answer 2

.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ファイルを再保存しても、意味の変化を心配せずに絶対寸法値を使用できます。重要な理由は、.dfmファイルに保存されているPixelsPerInchプロパティが、.dfmファイルが最後に保存されたマシンの値であることです。

_const
  SmallFontsPixelsPerInch = 96;

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

したがって、テーマを継続すると、別の注意が必要なのは、プロジェクトが異なるDPI値を持つ複数のマシンで開発されている場合、.dfmファイルを保存するときにDelphiが使用するスケーリングにより、コントロールが一連の編集をさまようことです。私の職場では、これを避けるために、フォームは96dpi（100％スケーリング）でのみ編集されるという厳格なポリシーを持っています。

実際、ScaleFromSmallFontsDimensionの私のバージョンでは、デザイン時のセットと実行時のフォームフォントが異なる可能性も考慮しています。 On XPマシンは、アプリケーションのフォームで8pt Tahomaを使用します。Vista以降では9pt Segoe UIを使用します。これにより、さらに別の自由度が提供されます。ソースコードは、96dpiの8pt Tahomaのベースラインを基準としています。

UIで画像またはグリフを使用する場合、これらもスケーリングする必要があります。一般的な例は、ツールバーとメニューで使用されるグリフです。これらのグリフは、実行可能ファイルにリンクされたアイコンリソースとして提供する必要があります。各アイコンにはさまざまなサイズを含める必要があり、実行時に最適なサイズを選択して画像リストにロードします。そのトピックに関する詳細は、ここで見つけることができます： エイリアスから苦しむことなくリソースからアイコンをロードする方法は？

別の便利なトリックは、TextWidthまたはTextHeightを基準とした相対的な単位でディメンションを定義することです。したがって、何かを10本の垂直線のサイズにする場合は、10*Canvas.TextHeight('Ag')を使用できます。これは、行間隔などを許可しないため、非常に大まかですぐに使用できるメトリックです。ただし、多くの場合、PixelsPerInchを使用してGUIが正しくスケーリングされるように調整するだけで済みます。

また、アプリケーションを 高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では、Runtime ThemesプロジェクトオプションをNoneに設定することでそれを実現しています。

マニフェストは、アプリが高DPI対応であることを宣言するright方法です。マニフェストをいじらずにすぐに試してみたい場合は、 SetProcessDPIAware を呼び出してください。これは、アプリの実行時に最初に行うこととして行います。できれば初期ユニット初期化セクションの1つ、または.dprファイルの最初のものとして。

アプリが高DPI対応であると宣言しない場合、Vista以降では、125％を超えるフォントスケーリングに対してレガシーモードでレンダリングされます。これは非常に恐ろしく見えます。そのtrapに落ちないようにしてください。

Windows 8.1モニターごとのDPI更新

Windows 8.1の時点で、モニターごとのDPI設定のOSサポートがあります（ http://msdn.Microsoft.com/en-ca/magazine/dn574798.aspx ）。これは、非常に異なる機能を備えた異なるディスプレイが接続されている現代のデバイスにとって大きな問題です。非常に高いDPIラップトップスクリーンと、低いDPI外部プロジェクターがある場合があります。このようなシナリオをサポートするには、上記よりもさらに多くの作業が必要です。

Answer 3

ユーザーのDPIを尊重することは、実際の仕事の一部に過ぎないことに注意することも重要です。

ユーザーのフォントサイズを尊重する

何十年もの間、Windowsは、ピクセルではなくDialog Unitsを使用してレイアウトを実行する概念でこの問題を解決してきました。 "ダイアログユニット"は、フォントの平均文字が

• 4対話単位（dlus）幅、および
• 8ダイアログユニット（clus）高

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設定を確認するのではなく、ユーザーのフォントサイズを確認する必要があります。実行中の2人のユーザー

• Segoe UI 14pt @ 96dpi（10.52px x 25px）
• Segoe UI 9pt @ 150dpi（10.52px x 25px）

同じフォントを実行しています。 DPIはただoneフォントサイズに影響するもの;ユーザーの設定はもう一方です。

StandardizeFormFont

Clovisは、フォーム上のフォントを修正し、新しいフォントサイズにスケーリングする関数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;

フォントサイズがわかったら、フォームを拡大縮小しますto、フォームの現在のフォントの高さ（ピクセル単位）を取得し、その係数で拡大します。

たとえば、フォームを-16、フォームは現在-11、フォーム全体を次のようにスケーリングする必要があります。

-16 / -11 = 1.45454%

標準化は2段階で行われます。最初に、new：oldフォントサイズの比率でフォームをスケーリングします。次に、実際にコントロールを（再帰的に）変更して、新しいフォントを使用します。

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;

そして、実際に再帰的にse新しいフォントを使用する必要があります。

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開発者は誰もいません。

Dear Delphi Developer：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;