Delphi Programming / Object Pascal
[掲載 2023年04月07日] [更新 2023年04月08日] Delphi 一般・その他 |
ディスプレイの拡大表示と画像 - 高 DPI 対応 |
動作確認等 |
Windows 10 ビルド 19043 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32 |
ディスプレイの拡大表示 ( DPI ) と画像の描画 |
ディスプレイを拡大表示,(高 DPI) で使用する時の画像の描画に関するテストです.
新規に VCL フォームアプリケーションのプロジェクトを作成します.フォームに TButton とと Timage を配置して Button1 クリックのコードを図の下のコードとします..
下図がコンパイルして実行した結果です.240 x 180 のビットマップ画像を読み込んで TImage に描画しています. |
|
図1
テストに使用したプログラム
- TBitmap に画像を読み込んで TImage に描画
- 拡大率が 100% の場合
- フォームのサイズは 286 x 308
|
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;
フォームを閉じてプログラムを終了します.
以下のリンクをクリックしてディスプレイの拡大率を 150% にします. |
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
|
TBitmap 画像を拡大縮小表示するには,拡大縮小した結果と同じサイズの TBitmap を用意します.そこに元の TBitmap の画像を描画して拡大縮小した画像を作成します.その画像を使用します. |
|
図4
高 DPI に対応して画像の描画サイズを調整した結果
- DPI は 144
- フォームのサイズは
441 x 473
|
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 です. |
|
図5
ディスプレイの拡大率が 100& の場合 |
プロジェクトを高 DPI 対応にして,ディスプレイの拡大率を 150& にした結果です.
ベクタ画像である TMetafile 画像の場合は,単純に 描画の幅と高さを設定して StretchDraw メソッドで描画すれば,ディスプレイの表示倍率に応じたサイズでの描画ができます.
GetDpiRatio 関数の戻り値を 1.0 にすれば,拡大率を考慮しない場合の確認になります. |
|
図6
拡大率が 150% の場合
|
|
図7
拡大率が 150% の場合
- DPI は 144
- 高 DPI 対応
- 拡大率を考慮した描画
|
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;
|