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;