Windowsフォントのスケーリングが100％を超える場合にGUIを適切に動作させるには
回答:
注：他の回答には非常に貴重なテクニックが含まれているため、こちらをご覧ください。ここでの私の答えは、DPI認識が容易であると想定することに対する警告と注意を提供するだけです。
私は通常、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です）を（Davidの回答に示されているように）高DPI対応フラグと一緒に使用しないことをお勧めします。組み込みのDelphiフォームデザイナを使用して構築されたVCLアプリケーション。
私は過去に、TForm.Scaledがtrueの場合、およびDelphiフォームのスケーリングに問題がある場合に見られるような破損の最小限のサンプルを作成することを試みました。これらの不具合は常にではなく、96以外のDPI値によってのみ引き起こされます。WindowsXPのフォントサイズの変更を含む他のすべての完全なリストを特定できませんでした。しかし、これらのグリッチのほとんどは自分のアプリケーションでのみ発生するため、かなり複雑な状況では、自分で確認できる証拠をいくつか示すことにしました。
Windows 7でDPIスケーリングを「フォント@ 200％」に設定すると、Delphi XEは次のようになり、Windows 7および8ではDelphi XE2も同様に機能しなくなりますが、これらの不具合はDelphi XE4で修正されたようです。
これらは主に、高DPIで正常に動作しない標準VCLコントロールです。ほとんどのものがまったくスケーリングされていないため、Delphi IDE開発者はDPIの認識を無視すること、およびDPI仮想化をオフにすることを決定したことに注意してください。そのような興味深い選択。
DPIの仮想化をオフにするのは、この新たな痛みの原因と難しい選択が必要な場合のみにしてください。そのままにしておくことをお勧めします。Windowsコモンコントロールはほとんど正常に動作するように見えることに注意してください。Delphiデータエクスプローラーコントロールは、標準のWindowsツリーコモンコントロールのC＃WinFormsラッパーであることに注意してください。これは純粋なMicrosoftの不具合であり、修正するには、Embarcaderoがデータエクスプローラーの純粋なネイティブ.Netツリーコントロールを書き換えるか、またはコントロールのアイテムの高さを変更するDPI-check-and-modify-propertiesコードを記述する必要があります。Microsoft WinFormsでさえ、カスタムDludgeコードがなくても、高DPIをきれいに、自動的に、処理することはできません。
更新：興味深いファクトイド：delphi IDEは「仮想化」されていないように見えますが、Davidが示したマニフェストコンテンツを使用して「非DPI仮想化」を実現していません。実行時にAPI関数を使用している可能性があります。
更新2：100％/ 125％DPIをどのようにサポートするかに応じて、私は2段階の計画を立てます。フェーズ1は、高DPIのために修正する必要があるカスタムコントロールのコードをインベントリし、それらを修正するか段階的に廃止する計画を立てることです。フェーズ2では、レイアウト管理なしのフォームとして設計されたコードの一部の領域を取り、DPIまたはフォントの高さの変更がクリッピングなしで機能できるように、それらをある種のレイアウト管理を使用するフォームに変更します。この「コントロール間の」レイアウト作業は、「コントロール内」作業よりもほとんどのアプリケーションではるかに複雑になると思います。
更新： 2016年に、最新のDelphi 10.1ベルリンは私の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値を持つ複数のマシンでプロジェクトが開発された場合、.dfmファイルを保存するときにDelphiが使用するスケーリングにより、コントロールが一連の編集をさまよっていることがわかります。 。私の職場では、これを回避するために、フォームは常に96dpi（100％スケーリング）でのみ編集されるという厳格なポリシーがあります。
実際、私のバージョンのScaleFromSmallFontsDimensionも、実行時にフォームフォントがデザインタイムで設定されたものと異なる可能性を考慮しています。XPマシンでは、私のアプリケーションのフォームは8pt Tahomaを使用します。Vista以降では、9pt Segoe UIが使用されます。これにより、さらに別の自由度が提供されます。ソースコードで使用される絶対寸法値は、96dpiでの8pt Tahomaのベースラインに関連していると想定されるため、スケーリングはこれを考慮する必要があります。
UIで画像やグリフを使用する場合は、これらもスケーリングする必要があります。一般的な例は、ツールバーとメニューで使用されるグリフです。これらのグリフを、実行可能ファイルにリンクされたアイコンリソースとして提供する必要があります。各アイコンにはサイズの範囲が含まれている必要があり、実行時に最適なサイズを選択して画像リストにロードします。そのトピックに関するいくつかの詳細はここにあります：エイリアスの影響を受けることなくリソースからアイコンをロードするにはどうすればよいですか？
もう1つの便利な方法は、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。これは、アプリの実行時に最初に行うこととして行います。できれば、初期ユニット初期化セクションの1つ、または.dprファイルの最初のセクションとして。
アプリが高DPI対応であると宣言しない場合、Vista以降では、フォントスケーリングが125％を超える場合にレガシーモードでレンダリングされます。これはかなり恐ろしいようです。その罠に陥らないようにしてください。
モニターごとのWindows 8.1 DPIアップデート
Windows 8.1以降、モニターごとのDPI設定のOSサポートがあります（http://msdn.microsoft.com/en-ca/magazine/dn574798.aspx）。これは、異なるディスプレイが非常に異なる機能で接続されている可能性がある現代のデバイスにとって大きな問題です。非常に高いDPIノートパソコン画面と低いDPI外部プロジェクターがあるかもしれません。このようなシナリオをサポートするには、上記よりもさらに多くの作業が必要です。
また、ユーザーのDPIを尊重することは、実際の仕事の一部にすぎないことにも注意してください。
ユーザーのフォントサイズを尊重する
Windowsは何十年もの間、ピクセルではなくダイアログユニットを使用してレイアウトを実行するという概念でこの問題を解決してきました。「ダイアログ単位は、」そのフォントのように定義される平均的な文字があります
- 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は、フォントサイズに影響する1つの要素にすぎません。ユーザーの好みは他のものです。
StandardizeFormFont
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%標準化は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;
その後、新しいフォントを再帰的に実際に使用する必要があります。
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。