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;