「開発室:備忘録」を編集中 (節単位)

==Delphi 10 Seattle の不具合==
Delphi 10 Seattle の VCL で発生する高 DPI 環境向けの開発における不具合を愚痴ってみました。

Windows 10、ディスプレイ 1 (メイン: 125%)、ディスプレイ 2 (サブ: 100%) の Per-Monitor DPI で確認

===Per-Monitor DPI にてフォーム表示直後にスケーリングされない===
*フォームにボタンでも適当に貼りつけて起動するだけで発生

:BorderStyle が bsSizeable の場合が駄目っぽい
:起動直後に WM_DPICHANGED が飛んでこないためスケーリングされないようだ
::ステータスバーを貼りつけるとなぜか直る
::WS_POPUP を含めるとなぜか直る (Position で poDefault が効かないなどの副作用あり)

*<span style="color:crimson;">なお、Delphi 10 Seattle Update 1 ではもっと派手にぶっ壊れている模様</span>

===Per-Monitor DPI にて Constraints を指定していると正常に動作しない===
[http://qc.embarcadero.com/wc/qcmain.aspx?d=77955 http://qc.embarcadero.com/wc/qcmain.aspx?d=77955]

*Vcl.Forms.pas の問題
:ScaleConstraints(M, D) で制約のサイズを変更している箇所がフォームのサイズを変更した後になってるため
:スケールが小さくなる場合は先に制約のサイズを小さくしておかないと制約にひっかかってフォームのサイズを縮小できない
:スケールが大きくなる場合は後から制約のサイズを大きくしないと制約にひっかかってフォームのサイズを拡大できない
:それを踏まえて修正してみるとこんな感じかもしれない

<source lang="delphi">
procedure TCustomForm.ChangeScale(M, D: Integer);
var
  PriorHeight: Integer;
begin
  // modified begin
  if M < D then
    ScaleConstraints(M, D);
  // modified end
  ScaleScrollBars(M, D);
  ScaleControls(M, D);
  if IsClientSizeStored then
  begin
    PriorHeight := ClientHeight;
    ClientWidth := MulDiv(ClientWidth, M, D);
    ClientHeight := MulDiv(PriorHeight, M, D);
  end;
  Font.Height := MulDiv(Font.Height, M, D);
  // modified begin
  (*
  ScaleConstraints(M, D);
  *)
  if M > D then
    ScaleConstraints(M, D);
  // modified end
end;
</source>

===Constraints を指定しているとスケーリング後のフォームサイズがおかしい===
上記の現象を回避したうえでこの問題が発生する。

そもそも Constraints は ClientWidth、ClientHeight ではなく Width、Height が基準なので MaxHeight、MinHeight にはタイトルバーの高さも含まれている。Vcl.Controls.pas の ScaleConstraints メソッドでは単純に数値のみでスケーリングを行っているため Per-Monitor DPI 状況下でタイトルバーのサイズが一定ということが考慮されておらず、結果としてクライアント領域が計算上より狭くなってしまう。

この問題は ChangeScale の後でタイトルバーの高さをスケーリングした場合の差分を足してやることで回避は可能だが結果的に高さが WM_DPICHANGED で送られてくる LPARAM の中の高さと異なってしまうため、ディスプレイをまたぐ位置によってはサイズが変更されなかったり無限ループが発生する恐れがあると思われる。

===FormCreate 時のフォームの PixelsPerInch がおかしい===
*親フォームの場合
:BorderStyle が bsSizeable だと PixelsPerInch が Screen.PixelsPerInch のまま
:ステータスバーを貼りつけると直る

*子フォームの場合
:WS_POPUP を含めずステータスバーを貼りつけている場合、起動時の PixelsPerInch が入っている
:WS_POPUP を含めてステータスバーを貼りつけている場合、Screen.PixelsPerInch が入っている
:WS_POPUP を含めてステータスバーを貼りつけていない場合、Screen.PixelsPerInch が入っている

*いずれの場合も FormShow 以降に処理を書けば正しい PixelsPerInch を取得できる

===WM_DPICHANGED の実装における問題===
*Vcl.Forms.pas の問題
:WM_DPICHANGED で飛んでくる LPARAM (DPI 変更後の推奨ウィンドウサイズ) を使用せずに ChangeScale(Message.YDpi, FPixelsPerInch); の部分で自前でサイズを計算しているが、このやり方だとディスプレイをまたぐ位置によってはサイズが変更されなかったり、無限ループに陥ることも考えられる

<source lang="delphi">
procedure TCustomForm.WMDpiChanged(var Message: TWMDpi);
var
  I: Integer;
  OldPPI: Integer;
begin
  if not (csDesigning in ComponentState) then
  begin
    if (Message.YDpi = 0) or (FPixelsPerInch = 0) then
    begin
      if (Application.MainForm <> nil) and (Application.MainForm.PixelsPerInch <> 0) then
        FPixelsPerInch := Application.MainForm.PixelsPerInch
      else
        Exit;
    end;

    if Message.YDpi <> FPixelsPerInch then
    begin
      if Assigned(FOnBeforeMonitorDpiChanged) then
        FOnBeforeMonitorDpiChanged(Self, FPixelsPerInch, Message.YDpi);

      ChangeScale(Message.YDpi, FPixelsPerInch);
      for I := 0 to MDIChildCount - 1 do
        MDIChildren[I].ChangeScale(Message.YDpi, FPixelsPerInch);
      OldPPI := FPixelsPerInch;
      FPixelsPerInch := Message.YDpi;
      if Assigned(FOnAfterMonitorDpiChanged) then
        FOnAfterMonitorDpiChanged(Self, OldPPI, FPixelsPerInch);
    end;
    Message.Result := 0;
  end;
end;
</source>

*対策としては Message.ScalledRect^ の値を使用して MS のマニュアル通り SetWindowPos でウィンドウサイズを変更する
:[https://msdn.microsoft.com/ja-jp/library/windows/desktop/dn312083(v=vs.85).aspx https://msdn.microsoft.com/ja-jp/library/windows/desktop/dn312083(v=vs.85).aspx]

*さらなる問題。MS のマニュアル通りにするとウィンドウの高さが若干おかしい
:これの理由は LPARAM に含まれているウィンドウの高さの値がタイトルバーも含めた値のため
::Windows 10 では Per-Monitor DPI でディスプレイをまたいでもタイトルバーの高さは変更されない (むしろ変更できないっぽい)
::ディスプレイをまたいで本来変更されるはずのタイトルバーの高さが変更されないので、その差分だけクライアント領域が狭くなる
::でも自前で高さを変更しちゃうと先に述べたとおり無限ループなどの原因になる
::<span style="color:crimson;">→ つまり回避不能</span>

*でも Windows 10 の電卓みたいな標準アプリはタイトルバーの高さも変わるぞ？
:調べたみたらタイトルバーの高さが変わるのは、実はあのタイトルバーは本物のタイトルバーではなく、クライアント領域に自前で描画されている絵らしいが…
::しかしメニューのサイズとかも変わっているので、もしかすると MS が裏技を用意しているのかも？
::EnableNonClientDpiScaling という API が存在するらしいがまだ公式には発表されていない
:::Windows 10 Anniversary Update の Insider Preview (ビルド 14342) にて EnableNonClientDpiScaling の動作を確認
:::WM_NCCREATE で呼び出して引数にウィンドウハンドルを渡してやれば DPI の変更に合わせてタイトルバーやメニューのサイズが変更されるが、スクロールバーやポップアップメニューのサイズまでは変更されない模様
:::(2016/06/11 時点での Windows 10 現行品では EnableNonClientDpiScaling は使用できず)
:::Windows 10 Anniversary Update で正式に実装された模様
:::ただし、ポップアップメニューや開くダイアログなどの Per-Monitor DPI 対応方法は不明
<source lang="delphi">
function EnableNonClientDpiScaling(hWnd: HWND): BOOL; stdcall;

function EnableNonClientDpiScaling; external user32 name 'EnableNonClientDpiScaling' delayed;
</source>

===FormCreate でフォームのフォントを変更してもスケーリングされない===
*Vcl.Forms.pas を見ると TCustomForm.ReadState の部分でフォントのサイズなどのスケーリングを行っているが、ReadState は FormCreate より前に呼び出されているので FormCreate でフォントを設定しても時すでに遅し
:かといって TCustomForm.ReadState より前にフォントを設定したとしても ReadState でリソースからフォントを上書きされてしまうので無意味
:フォントを変更したい場合は FormShow 以降に PixelsPerInch を使用して自前でフォントの Height をスケーリングしてやる必要がある