Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2023年04月07日] [更新 2023年04月08日] Delphi 一般・その他
ディスプレイの拡大表示と画像 - 高 DPI 対応
動作確認等 Windows 10 ビルド 19043 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32
[整理番号 - 1162]







ディスプレイの拡大表示  ( DPI ) と画像の描画


ディスプレイを拡大表示,(高 DPI) で使用する時の画像の描画に関するテストです.

新規に VCL フォームアプリケーションのプロジェクトを作成します.フォームに TButton とと Timage を配置して Button1 クリックのコードを図の下のコードとします..
下図がコンパイルして実行した結果です.240 x 180 のビットマップ画像を読み込んで TImage に描画しています.



図1
テストに使用したプログラム
  • TBitmap に画像を読み込んで TImage に描画
  • 拡大率が 100% の場合
  • フォームのサイズは 286 x 308

リスト1
テストに使用したコード
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
  LWidth  : Integer;
  LHeight : Integer;
  LText   : string;
begin
  Image1.Canvas.Brush.Color := clSilver;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);

  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile('HANDSHAK.BMP');
    Image1.Canvas.Draw(0, 0, LBitmap);

    LWidth  := LBitmap.Width;
    LHeight := LBitmap.Height;
    LText   := '  ' +  IntToStr(LWidth) + ' x ' + IntToStr(LHeight);
    Image1.Canvas.TextOut(0, LHeight + 10, LText);
  finally
    FreeAndNil(LBitmap);
  end;
end;




01_ディスプレイの表示が 150% の場合


フォームを閉じてプログラムを終了します.
以下のリンクをクリックしてディスプレイの拡大率を 150% にします.


// [設定] [ディスプレイ] のダイアログを起動する URI スキーム
ms-settings:display



EXE を実行します.
フォームが拡大し,TButton, TImage も拡大しています.Timage に描画しているビットマップ画像も拡大表示となってまいす.拡大しているため,TButton のキャプションのテキストも,画像下部のテキストも少しぼやけています.この時,ビットマップの描画サイズは 240 x 180 ではありません.その 1.5 倍です.

TForm.scaled プロパティの値を False にすると,拡大表示しません.



図2
拡大率が 150% の場合
  • DPI は 144
  • TButton のテキストが少しぼやけている
  • フォームのサイズは
    428 x 462




02_ディスプレイの表示が 150% の場合 - 高 DPI 対応


作成するアプリを高 DPI 対応にします.
以下の記事に掲載しているアプリケーション・マニフェスト・ファイルを作成してプロジェクトで使用します.コンパイルして実行した結果が下図です.
フォームの表示サイズが,上の図よりも少し大きくなっています.TButton のキャプションのテキストも,画像の下の文字も鮮明になっています.ビットマップ画像は,元の 240 x 180 のサイズで描画されています.



Delphi 10.3 以降では,新規に VCL フォームアプリケーションをサ作成すると,デフォルトで高 DPI 対応になります.アプリケーション・マニフェスト・ファイルを作成する必要はありません.
古いバージョンのプロジェクトを Delphi 10.3 以降で使用する場合は,[プロジェクト] [オプション] のダイアログの [アプリケーション] [マニフェスト] で高 DPI 対応の設定ができます.



図3
高 DPI に対した結果
  • DPI は 144
  • TButton のテキストが鮮明になっている
  • 画像は元のサイズでの描画
  • フォームのサイズは
    441 x 473




03_高 DPI における画像の描画サイズ調整


TBitmap 画像を拡大縮小表示するには,拡大縮小した結果と同じサイズの TBitmap を用意します.そこに元の TBitmap の画像を描画して拡大縮小した画像を作成します.その画像を使用します.



図4
高 DPI に対応して画像の描画サイズを調整した結果
  • DPI は 144
  • フォームのサイズは
    441 x 473

リスト2
procedure TForm1.Button1Click(Sender: TObject);

  //--------------------------------------------------------------------------
  //  ディスプレイの拡大縮小の比率を取得
  //  100% の時は 1.0.150% の時は 1.5 を返す
  //--------------------------------------------------------------------------
  function GetDpiRatio: Double;
  var
    LXDpi : Integer;
  begin
    LXDpi := GetDeviceCaps(GetDC(0), LOGPIXELSX);
    Result := LXDpi / USER_DEFAULT_SCREEN_DPI;
  end;

var
  LBitmap : TBitmap;
  LBmpDst : TBitmap;
  LWidth  : Integer;
  LHeight : Integer;
  LText   : string;
begin
  Image1.Canvas.Brush.Color := clSilver;
  Image1.Canvas.FillRect(Image1.Canvas.ClipRect);

  LBitmap := TBitmap.Create;
  LBmpDst := TBitmap.Create;
  try
    LBitmap.LoadFromFile('HANDSHAK.BMP');

    // 拡大縮小サイズの TBitmap を作成して元の TBitmap を描画
    LWidth  := Round(LBitmap.Width * GetDpiRatio);
    LHeight := Round(LBitmap.Height * GetDpiRatio);
    LBmpDst.SetSize(LWidth, LHeight);
    LBmpDst.Canvas.StretchDraw(Rect(0, 0, LWidth, LHeight), LBitmap);

    Image1.Canvas.Draw(0, 0, LBmpDst);

    LWidth  := LBmpDst.Width;
    LHeight := LBmpDst.Height;
    LText   := '  ' +  IntToStr(LWidth) + ' x ' + IntToStr(LHeight);
    Image1.Canvas.TextOut(0, LHeight + 10, LText);
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LBmpDst);
  end;
end;


より新しいバージョンの Delphi には,高 DPI に対応した TImageCollection, TVirtualImageList などのコンポーネント類が実装されています.






04_高 DPI における画像の描画サイズ調整 - TMetafile 画像


TMetafile 画像の場合です.TMetafile 画像は,帳票類作成用コンポーネントなどで,印刷用あるいは印刷プレビュー用の画像とししても利用されています.
テストに使用した TMetafile 画像のサイズは 7016 x 4961 です.


テストに使用した TMetafile 画像ファイルをダウンロード


図5
ディスプレイの拡大率が 100& の場合

プロジェクトを高 DPI 対応にして,ディスプレイの拡大率を 150& にした結果です.
ベクタ画像である TMetafile 画像の場合は,単純に 描画の幅と高さを設定して StretchDraw メソッドで描画すれば,ディスプレイの表示倍率に応じたサイズでの描画ができます.

GetDpiRatio 関数の戻り値を 1.0 にすれば,拡大率を考慮しない場合の確認になります.



図6
拡大率が 150% の場合
  • 高 DPI 対応
  • 拡大率を考慮しない描画
図7
拡大率が 150% の場合
  • DPI は 144
  • 高 DPI 対応
  • 拡大率を考慮した描画

リスト3
procedure TForm1.Button1Click(Sender: TObject);

  //--------------------------------------------------------------------------
  //  ディスプレイの拡大縮小の比率を取得
  //  100% の時は 1.0.150% の時は 1.5 を返す
  //--------------------------------------------------------------------------
  function GetDpiRatio: Double;
  var
    LXDpi : Integer;
  begin
    LXDpi := GetDeviceCaps(GetDC(0), LOGPIXELSX);
    Result := LXDpi / USER_DEFAULT_SCREEN_DPI;
  end;

var
  LMetafile : TMetafile;
  LDrawSize : Integer;
  LWidth    : Integer;
  LHeight   : Integer;
  LRatio    : Double;
begin
  Self.Color := clSilver;

  LMetafile := TMetafile.Create;
  try
    LMetafile.LoadFromFile('page-01.emf');

    LDrawSize := 200;;
    LRatio  := LMetafile.Width / LMetafile.Height;
    LWidth  := Round(LDrawSize * GetDpiRatio);
    LHeight := Round(LDrawSize / LRatio * GetDpiRatio);

     Image1.Width  := LWidth;
     Image1.Height := LHeight;

    Image1.Canvas.StretchDraw(Rect(0, 0, LWidth, LHeight), LMetafile);
  finally
    FreeAndNil(LMetafile);
  end;
end;