Delphiでの高DPI対応: 画像の動的管理とイベント処理サンプル

2024年8月10日 17:02

Delphiにおいて、高DPI対応は現代のディスプレイ環境で重要な要素となっています。本記事では、Delphiでの高DPI対応を目的とした画像管理とイベント処理に関する実装例を紹介します。この例では、TImageCollection、TVirtualImageListを活用し、異なるDPIに応じた画像のロードと表示を実現します。
サンプルではありますが適宜修正しつつ順応させてください。
またTVirtualImageとTImageCollectionの組み合わせでもできますがDelphi11.3以降です。

プロジェクト概要

このプロジェクトでは、以下の機能を持つフォームを作成します：

異なるDPIに対応した画像の動的ロード
マウスイベントに応じた画像の切り替え
画像のコレクション管理と仮想イメージリストの活用

主要コンポーネントの説明

TImageCollection: 画像のコレクションを管理するコンポーネントで、異なるDPIに対応する複数の画像を保持できます。
TVirtualImageList: 複数の画像を一元管理し、DPIに応じて適切なサイズの画像を提供します。
TImage: フォーム上に画像を表示するためのコンポーネントです。

プログラムの詳細

unit Unit3;

interface

uses
  Vcl.Forms, Vcl.Controls, Vcl.ImgList, Vcl.VirtualImageList, Vcl.BaseImageCollection, Vcl.ImageCollection, Vcl.ExtCtrls, System.SysUtils,
  System.Classes, Vcl.Graphics, Vcl.Dialogs, System.ImageList;

type
  TForm3 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    Image1: TImage;  // TImageコンポーネントをフォーム上に表示するための変数を宣言
    ImageCollection1: TImageCollection;  // 画像コレクションを管理するための変数を宣言
    VirtualImageList1: TVirtualImageList;  // 仮想イメージリストを管理するための変数を宣言
    FCurrentVirtualImageList: TVirtualImageList;  // 現在の仮想イメージリストを保持するための変数を宣言
    procedure common(ImageCollectionName: string; filepath: string; FilePath96, FilePath144, FilePath192: string; collectionIndex: Integer; VirtualImageListName: string; ImageName: string; ImageListWidth, ImageListHeight, ImageTop, ImageLeft: Integer);
    // 共通処理を行うメソッドを宣言
    procedure AddImageToCollection(ImageCollection: TImageCollection; const FilePath: string; const ImageName: string);
    // 画像をコレクションに追加するメソッドを宣言
    procedure AddImagesFromCollection(ImageCollection: TImageCollection; VirtualImageList: TVirtualImageList);
    // 画像コレクションから仮想イメージリストに画像を追加するメソッドを宣言
    procedure AddDPIImagesToCollection(ImageCollection: TImageCollection; const FilePath96, FilePath144, FilePath192: string; const ImageName: string);
    // 高DPI対応の画像をコレクションに追加するメソッドを宣言
    procedure ImageMouseEnter(Sender: TObject);  // マウスが画像上に入ったときのイベント処理を宣言
    procedure ImageMouseLeave(Sender: TObject);  // マウスが画像から離れたときのイベント処理を宣言
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    // 画像上でマウスボタンが押されたときのイベント処理を宣言
    procedure ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    // 画像上でマウスボタンが離されたときのイベント処理を宣言
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.common(ImageCollectionName: string; filepath: string; FilePath96, FilePath144, FilePath192: string; collectionIndex: Integer; VirtualImageListName: string; ImageName: string; ImageListWidth, ImageListHeight, ImageTop, ImageLeft: Integer);
var
  ImageCollection1: TImageCollection;  // ImageCollection用の変数をローカルで宣言
  VirtualImageList1: TVirtualImageList;  // VirtualImageList用の変数をローカルで宣言
  Image1: TImage;  // TImageコンポーネント用の変数をローカルで宣言
begin
  try
    // 既存のImageCollectionを取得または作成
    ImageCollection1 := FindComponent(ImageCollectionName) as TImageCollection;
    if ImageCollection1 = nil then
    begin
      ImageCollection1 := TImageCollection.Create(Self);  // ImageCollectionが存在しない場合、新たに作成
      ImageCollection1.Name := ImageCollectionName;  // 名前を設定
      ImageCollection1.SetSubComponent(True);  // サブコンポーネントとして設定
    end;

    // 既存のVirtualImageListを取得または作成
    VirtualImageList1 := FindComponent(VirtualImageListName) as TVirtualImageList;
    if VirtualImageList1 = nil then
    begin
      VirtualImageList1 := TVirtualImageList.Create(Self);  // VirtualImageListが存在しない場合、新たに作成
      VirtualImageList1.Name := VirtualImageListName;  // 名前を設定
      VirtualImageList1.SetSubComponent(True);  // サブコンポーネントとして設定
      VirtualImageList1.Width := ImageListWidth;  // 幅を設定
      VirtualImageList1.Height := ImageListHeight;  // 高さを設定
      VirtualImageList1.ImageCollection := ImageCollection1;  // ImageCollectionを関連付け
    end;

    // 既存のImageを取得または作成
    Image1 := FindComponent(ImageName) as TImage;
    if Image1 = nil then
    begin
      Image1 := TImage.Create(Self);  // Imageが存在しない場合、新たに作成
      Image1.Name := ImageName;  // 名前を設定
      Image1.Parent := Self;  // 親フォームを設定
      Image1.SetBounds(ImageLeft, ImageTop, ImageListWidth, ImageListHeight);  // 位置とサイズを設定
      Image1.Picture.Bitmap := TBitmap.Create;  // 新しいBitmapを作成
      Image1.Picture.Bitmap.SetSize(ImageListWidth, ImageListHeight);  // Bitmapのサイズを設定
      // イベントハンドラを設定
      // 背景を白に設定
      Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
      Image1.Picture.Bitmap.Canvas.FillRect(Rect(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height));
    end;

    // 画像をImageCollectionに追加
    if (FilePath96 <> '') or (FilePath144 <> '') or (FilePath192 <> '') then
    begin
      AddDPIImagesToCollection(ImageCollection1, FilePath96, FilePath144, FilePath192, IntToStr(collectionIndex));
    end
    else
    begin
      AddImageToCollection(ImageCollection1, filepath, IntToStr(collectionIndex));
    end;

    // 画像が正しくロードされたか確認
    if ImageCollection1.Images.Count = 0 then
    begin
      ShowMessage('Failed to load image');  // ロード失敗時のメッセージ
      Exit;
    end;

    // 確認用デバッグメッセージ
    ShowMessage('Image loaded successfully: ' + ImageCollection1.Images[collectionIndex].SourceImages[0].Image.Width.ToString + 'x' + ImageCollection1.Images[collectionIndex].SourceImages[0].Image.Height.ToString);

    // ImageCollectionの画像をVirtualImageListに追加
    AddImagesFromCollection(ImageCollection1, VirtualImageList1);

    // VirtualImageListに画像が正しく追加されたか確認
    if VirtualImageList1.Count = 0 then
    begin
      ShowMessage('VirtualImageList is empty');  // 空の場合のメッセージ
      ShowMessage('ImageCollection count: ' + IntToStr(ImageCollection1.Images.Count));  // デバッグメッセージ
      Exit;
    end;

    // VirtualImageListから画像を取得してImageに設定
    if VirtualImageList1.Count > 0 then
      VirtualImageList1.GetBitmap(collectionIndex, Image1.Picture.Bitmap);  // Bitmapを取得して設定

    FCurrentVirtualImageList := VirtualImageList1;  // 現在の仮想イメージリストを保持

    // イベントハンドラを設定
    Image1.OnMouseEnter := ImageMouseEnter;
    Image1.OnMouseLeave := ImageMouseLeave;
    Image1.OnMouseDown := ImageMouseDown;
    Image1.OnMouseUp := ImageMouseUp;
  except
    on E: Exception do
      ShowMessage('Error: ' + E.Message);  // エラーメッセージを表示
  end;
end;

procedure TForm3.AddImageToCollection(ImageCollection: TImageCollection; const FilePath: string; const ImageName: string);
var
  ImageItem: TImageCollectionItem;  // ImageCollectionItemの変数を宣言
  SourceItem: TImageCollectionSourceItem;  // ImageCollectionSourceItemの変数を宣言
begin
  ImageItem := ImageCollection.Images.Add;  // 新しい画像項目をコレクションに追加
  ImageItem.index := strtoint(ImageName);  // 画像のインデックスを設定
  SourceItem := ImageItem.SourceImages.Add;  // 新しいソース画像項目を追加
  SourceItem.Image.LoadFromFile(FilePath);  // ファイルから画像をロード

  // 画像が正しくロードされたか確認
  if SourceItem.Image.Empty then
  begin
    ShowMessage('Failed to load image: ' + FilePath);  // ロード失敗時のメッセージ
    Exit;
  end;
end;

procedure TForm3.AddImagesFromCollection(ImageCollection: TImageCollection; VirtualImageList: TVirtualImageList);
var
  i: Integer;  // ループ用のカウンタを宣言
  ImageItem: TImageCollectionItem;  // ImageCollectionItemの変数を宣言
begin
  VirtualImageList.BeginUpdate;  // VirtualImageListの更新を開始
  try
    for i := 0 to ImageCollection.Images.Count - 1 do
    begin
      ImageItem := ImageCollection.Images[i];  // 各ImageCollectionItemを取得
      VirtualImageList.Add(ImageItem.Name, i);  // VirtualImageListに画像を追加
    end;
  finally
    VirtualImageList.EndUpdate;  // 更新を終了
  end;
end;

procedure TForm3.AddDPIImagesToCollection(ImageCollection: TImageCollection; const FilePath96, FilePath144, FilePath192: string; const ImageName: string);
var
  ImageItem: TImageCollectionItem;  // ImageCollectionItemの変数を宣言
  SourceItem: TImageCollectionSourceItem;  // ImageCollectionSourceItemの変数を宣言
begin
  ImageItem := ImageCollection.Images.Add;  // 新しい画像項目をコレクションに追加
  ImageItem.Name := ImageName;  // 画像名を設定

  if FilePath96 <> '' then
  begin
    SourceItem := ImageItem.SourceImages.Add;  // 新しいソース画像項目を追加
    SourceItem.Image.LoadFromFile(FilePath96);  // 96DPI用の画像をロード
  end;

  if FilePath144 <> '' then
  begin
    SourceItem := ImageItem.SourceImages.Add;  // 新しいソース画像項目を追加
    SourceItem.Image.LoadFromFile(FilePath144);  // 144DPI用の画像をロード
  end;

  if FilePath192 <> '' then
  begin
    SourceItem := ImageItem.SourceImages.Add;  // 新しいソース画像項目を追加
    SourceItem.Image.LoadFromFile(FilePath192);  // 192DPI用の画像をロード
  end;
end;

procedure TForm3.ImageMouseEnter(Sender: TObject);
begin
  (Sender as TImage).Picture.Bitmap := nil;  // 画像をクリア
  FCurrentVirtualImageList.GetBitmap(1, (Sender as TImage).Picture.Bitmap);  // マウスが入った時の画像を設定
end;

procedure TForm3.ImageMouseLeave(Sender: TObject);
begin
  (Sender as TImage).Picture.Bitmap := nil;  // 画像をクリア
  FCurrentVirtualImageList.GetBitmap(0, (Sender as TImage).Picture.Bitmap);  // マウスが離れた時の画像を設定
end;

procedure TForm3.ImageMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  (Sender as TImage).Picture.Bitmap := nil;  // 画像をクリア
  FCurrentVirtualImageList.GetBitmap(2, (Sender as TImage).Picture.Bitmap);  // マウスが押された時の画像を設定
end;

procedure TForm3.ImageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  (Sender as TImage).Picture.Bitmap := nil;  // 画像をクリア
  FCurrentVirtualImageList.GetBitmap(0, (Sender as TImage).Picture.Bitmap);  // マウスが離された時の画像を設定
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  // 各DPIに対応する画像の初期化を行う
  common('ImageCollection1', 'failpath', 'failpath96', 'failpath144', 'failpath192', 0, 'VirtualImageList1', 'Image1', 100, 100, 10, 10);
  common('ImageCollection1', 'failpath', 'failpath96', 'failpath144', 'failpath192', 1, 'VirtualImageList1', 'Image1', 100, 100, 10, 10);
  common('ImageCollection1', 'failpath', 'failpath96', 'failpath144', 'failpath192', 2, 'VirtualImageList1', 'Image1', 100, 100, 10, 10);
end;

end.

実装結果

上記のコードを利用することで、異なるDPI設定に応じた画像のロードおよび表示が可能となります。また、マウスイベントに応じて動的に画像を切り替えることもできます。

この実装により、高DPI対応のアプリケーション開発が容易になり、ユーザーにとって視認性の高いインターフェースを提供することができます。

まとめ

Delphiでの高DPI対応は、現代のアプリケーションにおいて重要な要素です。本記事で紹介した方法を利用して、簡単に高DPI対応のアプリケーションを作成できるようになります。この記事が皆様のDelphi開発における参考となれば幸いです。

この記事が気に入ったらサポートをしてみませんか？