Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2022年11月18日] [更新 2022年11月19日]　Delphi サンプルプログラム集
093_実行時に TImageList に画像を格納
動作確認等 Windows 10 ビルド 19043 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32
093_TImageList_SetImage.zip　[6.5 MB]　2022年11月19日版 (EXE 同梱)






実行時に TImageList に画像を格納


実行時に、TImageList に画像を格納するサンプルです。
TImageList に格納される画像は、TImageList の ColorDepth プロパティに応じたビット深さのビットマップとなります。


TImageList の ColorDepth プロパティの値は、デフォルトでは cdDeviceDependent です。これはデバイス依存の処理です。本ページのサンプルでは。cd32bit にしてテストしています。cd32bit は、32 ビット画像のアルファ値も処理する方式です。
TImageList には、Width, Height プロパティで指定したサイズの画像だけが格納できます。それよりも大きいサイズの画像格納すると、Width, Height プロパティのサイズに分割して格納されます。

TImageList に格納したビットマップ画像を確認するために、本ページのサンプルでは、TListView コントロールに vsIcon として描画するようにしています。



図1
TImagelIst のオブジェクト・インスペクタ
  • ColorDepth の値を cd32bit に変更
    デフォルトは cdDeviceDependent
  • 格納する画像サイズは 128 x 128

本ページのサンプルをコンパイルすると、次のようなメッセージが表示されることがあります。この .vrc ファイルは、TImagelist に画像を格納する処理の際に生成される一時ファイルです。

ファイル "Project1.vrc" を削除しています。




01_TImageList に 32 ビットのビットマップ画像を格納


32 ビットのビットマップ画像を TImageList に格納して、TListView へ描画した結果です。
左の元の画像は、32 ビットのアルファチャンネル付きのビットマップです。透明色が透過ピクセルになります。この場合、TImageList に格納する際に、マスク画像は必要ありません。マスク画像を作成して Add メソッドの引数に渡しても結果は同じです。
右の元の画像は、32 ビットのビットマップですが、アルファ値は使用していません。しがって、事実上 24 ビット色のビットマップ画像と同じです。下図では、マスク画像を使用していないので透過ピクセルはありません。



図2
TListView への描画結果
  • 左の元画像は、
    32 ビットのアルファチャンネル付きのビットマップ
  • 右の元画像は、
    32 ビットのアルファ値を使用しないビットマップ

[Button2] をクリックして、マスク画像を使用した結果が下図です。TBitmap の画像は、特に指定しない場合、左下のピクセルの色が透過色になります。




図3
TListView への描画結果
  • 左の元画像は、
    32 ビットのアルファチャンネル付きのビットマップ
  • 右の元画像は、
    32 ビットのアルファ値を使用しないビットマップ

リスト1
TImageList に 32 ビットのビットマップ画像を格納 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ImgList, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    ListView1: TListView;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  透過状態の確認用に TListView の背景色を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageList1.SetSize(128, 128);
  // Delphi 2009 以降では cd32bit にする
  ImageList1.ColorDepth := cd32Bit;

  ListView1.Items.Clear;
  ListView1.Color := clSilver;
  ListView1.ViewStyle   := vsIcon;
  ListView1.LargeImages := ImageList1;
end;

//=============================================================================
//  32 ビット色のビットマップ画像を格納
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap     : TBitmap;
  LMaskBitmap : TBitmap;
  LIndex      : Integer;
begin
  ListView1.Items.Clear;
  ImageList1.Clear;

  LBitmap     := TBitmap.Create;
  LMaskBitmap := TBitmap.Create;
  try
    // 32 ビットのアルファチャンネル付きビットマップ
    LBitmap.LoadFromFile('..\Images\simple_32bit_AlphaZero.bmp');
    ImageList1.Add(LBitmap, nil);

    // 32 ビットのアルファチャンネルなしのビットマップ
    LBitmap.LoadFromFile('..\Images\simple_32bit.bmp');

    // Sender が nil の時はマスク画像を追加
    if Sender <> nil then begin
      ImageList1.Add(LBitmap, nil);
    end else begin
      LMaskBitmap.Assign(LBitmap);
      LMaskBitmap.Mask(LBitmap.TransparentColor);
      ImageList1.Add(LBitmap, LMaskBitmap);
    end;
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LMaskBitmap);
  end;


  // TListView に TImageList の画像を描画
  for LIndex := 0 to ImageList1.Count - 1 do begin
    ListView1.Items.Add.Caption := 'Image - ' + IntToStr(LIndex);
    ListView1.Items[LIndex].ImageIndex := LIndex;
  end;
end;

//=============================================================================
//  32 ビット色のビットマップ画像を格納
//  マスク画像を使用する処理
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Button1Click(nil);
end;

end.


マスク画像は下図のようになります。黒以外の部分が透過ピクセルとなります。

32 ビットのアルファチャンネル付きのビットマップでは、マスク画像を使用する必要はありませんが、マスク画像を使用しても結果は同じです。
したがって、32 ビットのビットマップの場合、アルファチャンネルを使用していても、使用していなくとも同じ処理で TImageList に格納できます。



図4
マスク画像
  • 黒以外の部分が透過ピクセル
 

//=============================================================================
//  マスク画像を作成して TImage に描画
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  Image1.Picture.Assign(nil);

  LBitmap     := TBitmap.Create;
  try
    // 32 ビットのアルファチャンネルなしのビットマップ
    LBitmap.LoadFromFile('..\Images\simple_32bit.bmp');

    LBitmap.Mask(LBitmap.TransparentColor);
    Image1.Canvas.Draw(0, 0, LBitmap);
  finally
    FreeAndNil(LBitmap);
  end;
end;



02_TImageList に 32 ビット以外のビットマップ画像を格納


32 ビット以外のピッマップ画像の場合も同じです。
以下のサンプルは、8 ビットのビットマップ画像を、TImageList に格納する例です。



図5
マスク画像を使用しない場合
  • 左の元画像は比較用で、
    32 ビットのアルファチャンネル付きのビットマップ
  • 右の元画像は、
    8 ビットのビットマップ画像

図6
マスク画像を使用した場合
  • 左の元画像は比較用で、
    32 ビットのアルファチャンネル付きのビットマップ
  • 右の元画像は、
    8 ビットのビットマップ画像

リスト2
TImageList に 32 ビット以外のビットマップ画像を格納		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ImgList, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    ListView1: TListView;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  透過状態の確認用に TListView の背景色を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageList1.SetSize(128, 128);
  // cd32bit にする
  ImageList1.ColorDepth := cd32Bit;

  ListView1.Items.Clear;
  ListView1.Color := clSilver;
  ListView1.ViewStyle   := vsIcon;
  ListView1.LargeImages := ImageList1;
end;

//=============================================================================
//  24 ビット色以下ののビットマップ画像を格納
//  マスク画像を使用しない場合
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
  LIndex  : Integer;
begin
  ListView1.Items.Clear;
  ImageList1.Clear;

  LBitmap := TBitmap.Create;
  try
    // 32 ビットのアルファチャンネル付きビットマップ ( 比較用 )
    LBitmap.LoadFromFile('..\Images\simple_32bit_AlphaZero.bmp');
    ImageList1.Add(LBitmap, nil);

    // 8 ビット色 (256 色) のビットマップ画像
    LBitmap.LoadFromFile('..\Images\simple_8bit.bmp');
    ImageList1.Add(LBitmap, nil);
  finally
    FreeAndNil(LBitmap);
  end;


  // TListView に TImageList の画像を描画
  for LIndex := 0 to ImageList1.Count - 1 do begin
    ListView1.Items.Add.Caption := 'Image - ' + IntToStr(LIndex);
    ListView1.Items[LIndex].ImageIndex := LIndex;
  end;
end;

//=============================================================================
//  24 ビット色以下ののビットマップ画像を格納
//  マスク画像を使用する場合
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap     : TBitmap;
  LMaskBitmap : TBitmap;
  LTransColor : TColor;
  LIndex      : Integer;
begin
  ListView1.Items.Clear;
  ImageList1.Clear;

  LBitmap     := TBitmap.Create;
  LMaskBitmap := TBitmap.Create;
  try
    // 32 ビットのアルファチャンネル付きビットマップ ( 比較用 )
    LBitmap.LoadFromFile('..\Images\simple_32bit_AlphaZero.bmp');
    ImageList1.Add(LBitmap, nil);

    // 8 ビット色 (256 色) のビットマップ画像
    // マスク画像を作成して Add メソッドの第 2 引数に渡す
    LBitmap.LoadFromFile('..\Images\simple_8bit.bmp');
    LMaskBitmap.Assign(LBitmap);
    LTransColor := LBitmap.Canvas.Pixels[0, LBitmap.Height - 1];
    LMaskBitmap.Mask(LTransColor);
    ImageList1.Add(LBitmap, LMaskBitmap);
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LMaskBitmap);
  end;


  // TListView に TImageList の画像を描画
  for LIndex := 0 to ImageList1.Count - 1 do begin
    ListView1.Items.Add.Caption := 'Image - ' + IntToStr(LIndex);
    ListView1.Items[LIndex].ImageIndex := LIndex;
  end;
end;

end.



03_TImageList に PNG 形式の画像を格納


TPngImage の画像を TImageList に格納する例です。
TPngImage の画像を TBitmap の画像に変換して、それを TImageList に追加します。マスク画像は必要ありません。



図7
PNG 画像を TImageList に格納
  • 左の元画像は比較用で、
    32 ビットのアルファチャンネル付きのビットマップ
  • 右の元画像は、
    32 ビットの PNG 画像

リスト3
TImageList に PNG 形式の画像を格納		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ImgList, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Imaging.pngimage;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  透過状態の確認用に TListView の背景色を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageList1.SetSize(128, 128);
  // cd32bit にする
  ImageList1.ColorDepth := cd32Bit;

  ListView1.Items.Clear;
  ListView1.Color := clSilver;
  ListView1.ViewStyle   := vsIcon;
  ListView1.LargeImages := ImageList1;
end;

//=============================================================================
//  PNG 形式の画像を格納
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap   : TBitmap;
  LPngImage : TPngImage;
  LIndex    : Integer;
begin
  ListView1.Items.Clear;
  ImageList1.Clear;

  LBitmap    := TBitmap.Create;
  LPngImage := TPngImage.Create;
  try
    // 32 ビットのアルファチャンネル付きビットマップ ( 比較用 )
    LBitmap.LoadFromFile('..\Images\simple_32bit_AlphaZero.bmp');
    ImageList1.Add(LBitmap, nil);

    // PNG 画像を読み込んで TBitmap の画像に変換
    // それを TImageList に追加
    LPngImage.LoadFromFile('..\Images\simple_32bit.png');
    LBitmap.Assign(LPngImage);
    ImageList1.Add(LBitmap, nil);
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LPngImage);
  end;


  // TListView に TImageList の画像を描画
  for LIndex := 0 to ImageList1.Count - 1 do begin
    ListView1.Items.Add.Caption := 'Image - ' + IntToStr(LIndex);
    ListView1.Items[LIndex].ImageIndex := LIndex;
  end;
end;

end.



04_TImageList に GIF 形式の画像を格納


TGifImage の画像を TImageList に格納する例です。
TGIfImage の画像を TBitmap の画像に変換して、それを TImageList に追加します。マスク画像を作成して、Add メソッドの第 2 引数に渡します。



図8
GIF 画像を TImageList に格納
  • 左の元画像は比較用で、
    32 ビットのアルファチャンネル付きのビットマップ
  • 右の元画像は GIF 形式の画像

リスト4
TImageList に GIF 形式の画像を格納		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ImgList, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Imaging.GIFImg;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  透過状態の確認用に TListView の背景色を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageList1.SetSize(128, 128);
  // cd32bit にする
  ImageList1.ColorDepth := cd32Bit;

  ListView1.Items.Clear;
  ListView1.Color := clSilver;
  ListView1.ViewStyle   := vsIcon;
  ListView1.LargeImages := ImageList1;
end;

//=============================================================================
//  GIF 形式の画像を格納
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap     : TBitmap;
  LMaskBitmap : TBitmap;
  LGifImage   : TGifImage;
  LIndex      : Integer;
begin
  ListView1.Items.Clear;
  ImageList1.Clear;

  LBitmap     := TBitmap.Create;
  LMaskBitmap := TBitmap.Create;
  LGifImage   := TGifImage.Create;
  try
    // 32 ビットのアルファチャンネル付きビットマップ ( 比較用 )
    LBitmap.LoadFromFile('..\Images\simple_32bit_AlphaZero.bmp');
    ImageList1.Add(LBitmap, nil);


    // GIF 画像を読み込んで TBitmap の画像に変換
    LGifImage.LoadFromFile('..\Images\Simple_8BIT.gif');

    // TBitmap に元の色を反映するために透過状態を解除
    LGifImage.Transparent := False;
    LBitmap.Canvas.Draw(0, 0, LGifImage);
    // マスク画像を作成して Add メソッドの第 2 引数に渡す
    LMaskBitmap.Assign(LBitmap);
    LMaskBitmap.Mask(LGifImage.Bitmap.TransparentColor);
    ImageList1.Add(LBitmap, LMaskBitmap);
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LMaskBitmap);
    FreeAndNil(LGifImage);
  end;


  // TListView に TImageList の画像を描画
  for LIndex := 0 to ImageList1.Count - 1 do begin
    ListView1.Items.Add.Caption := 'Image - ' + IntToStr(LIndex);
    ListView1.Items[LIndex].ImageIndex := LIndex;
  end;
end;

end.



05_TImageList に ICO 形式の画像を格納


TIcon 画像を TImageList に格納する例です。
TIcon 画像は、AddIcon メソッドで TImageList に格納できます。マスク画像を作成する必要はありません。TIcon 画像には、マスク画像が格納されています。 TIcon は、そのマスク画像を使用して透過処理を行います。



図9
ICO 画像を TImageList に格納
  • 左の元画像は比較用で、
    32 ビットのアルファチャンネル付きのビットマップ
  • 右上は 32 ビットのアルファチャンネル付きの TIcon 画像
  • 左下は、24 ビットの TIcon 画像
  • 右下は、8 ビットの TIcon 画像

リスト5
TImageList に ICO 形式の画像を格納		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ImgList, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  透過状態の確認用に TListView の背景色を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageList1.SetSize(128, 128);
  // cd32bit にする
  ImageList1.ColorDepth := cd32Bit;

  ListView1.Items.Clear;
  ListView1.Color := clSilver;
  ListView1.ViewStyle   := vsIcon;
  ListView1.LargeImages := ImageList1;
end;

//=============================================================================
//  ICO 形式の画像を格納
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
  LIcon   : TIcon;
  LIndex  : Integer;
begin
  ListView1.Items.Clear;
  ImageList1.Clear;

  LBitmap := TBitmap.Create;
  LIcon   := TIcon.Create;
  try
    // 32 ビットのアルファチャンネル付きビットマップ ( 比較用 )
    LBitmap.LoadFromFile('..\Images\simple_32bit_AlphaZero.bmp');
    ImageList1.Add(LBitmap, nil);

    // 32 ビット色のアイコン画像を読み込んで AddIcon メソッドで TImageList に追加
    // 32 ビット色のアイコンはアルファチャンネル付きの画僧
    LIcon.LoadFromFile('..\Images\Images_32bIT.ico');
    ImageList1.AddIcon(LIcon);

    // 24 ビット色のアイコン画像を読み込んで AddIcon メソッドで TImageList に追加
    LIcon.LoadFromFile('..\Images\Images_24bIT.ico');
    ImageList1.AddIcon(LIcon);

    // 8 ビット色のアイコン画像を読み込んで AddIcon メソッドで TImageList に追加
    LIcon.LoadFromFile('..\Images\Images_8bIT.ico');
    ImageList1.AddIcon(LIcon);
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LIcon);
  end;


  // TListView に TImageList の画像を描画
  for LIndex := 0 to ImageList1.Count - 1 do begin
    ListView1.Items.Add.Caption := 'Image - ' + IntToStr(LIndex);
    ListView1.Items[LIndex].ImageIndex := LIndex;
  end;
end;

end.



06_ColorDepth プロパティが cd32bit 以外の場合


TImageList.ColorDepth プロパティの値が cd8bit の場合です。
cd8bit の場合は、TImageList に格納した画像は 8 ビットの 256 色の画像になります。24 ビット以上の画像は減色されますが、適切な減色処理が行われるわけではありりません。あらかじめ、適切な減色処理をしておくが必要があります。


下図は、ColorDepth プロパティの値が cd8bit の時に、32 ビットのアルファチャンネル付きの画像を TImageList に格納した結果です。

ColorDepth プロパティの値がデフォルトの cdDeviceDependent の時も、cd24bit の時も結果は同じです。アルファ値の処理は行われません。その結果、ビットマップでは「黒」と「透明色」が区別されないため、実際の「黒」と「透明色」のピクセルがどちらも黒になっています。半透明のピクセルの色は、R, G, B の値によって決まる値になります。

PNG 画像の場合は、背景を白で塗り潰してから描画します。透明ピクセルは、その背景色の「白」ままとなり、半透明のピクセルは背景色との混合色になます。

TIcon の画像の場合は、透過ピクセルは、透過ピクセルという情報に基づいて描画します。その結果、透過ピクセルは透過します。半透明のピクセルは減色処理されて黒に近い色になっています。




図10
元が 32 ビットの画像の場合
  • 全てアルファチャンネル付きの 32 ビット画像
  • 左上はビットマップ画像
  • 右上は TPingImage の画像
  • 左下は TIcon の画像

以下は、ColorDepth が cd8bit の時に、24 ビット以下の画像を TImageList に格納した例です。
このサンプルの、画像を TImageList へ格納する処理は、cd32bit の場合でもそのまま使用できます。つまり、ColorDepth を cd32bit にしておけば、アルファチャンネル付きの画像も、そうでない画像も、画像の質を損なうことなく TImageList に格納できます。



図11
元が 24 ビット以下の画像の場合
  • 左上は 24 ビットのビットマップ画像
  • 右上は TGifImage 画像
  • 左下は 24 ビットの TIcon 画像
  • 右下は 8 ビットの TIcon 画像

リスト6
ColorDepth プロパティが cd8bit の時に、画像を TImageList に格納		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ImgList, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    ListView1: TListView;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Vcl.Imaging.pngimage,
  Vcl.Imaging.GIFImg;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  ColorDepth の値を cd8bit にした場合のテスト
//  この場合、TImageList に格納されるのは 8 ビット色 ( 356 色 ) のビットマップ
//
//  透過状態の確認用に TListView の背景色を設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageList1.SetSize(128, 128);
  ImageList1.ColorDepth := cd8Bit;

  ListView1.Items.Clear;
  ListView1.Color := clSilver;
  ListView1.ViewStyle   := vsIcon;
  ListView1.LargeImages := ImageList1;
end;

//=============================================================================
//  32 ビット色のアルファチャンネル付きの画像を TImageList に格納
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap   : TBitmap;
  LPngImage : TPngImage;
  LIcon     : TIcon;
  LIndex    : Integer;
begin
  ListView1.Items.Clear;
  ImageList1.Clear;

  LBitmap := TBitmap.Create;
  try
    // 32 ビットのアルファチャンネル付きビットマップ
    LBitmap.LoadFromFile('..\Images\images_32bit.bmp');
    ImageList1.Add(LBitmap, nil);
  finally
    FreeAndNil(LBitmap);
  end;

  LBitmap   := TBitmap.Create;
  LPngImage := TPngImage.Create;
  try
    // 32 ビットの PNG 形式画像
    LPngImage.LoadFromFile('..\Images\images_32bit.png');
    LBitmap.Assign(LPngImage);
    ImageList1.Add(LBitmap, nil);
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LPngImage);
  end;

  LIcon := TIcon.Create;
  try
    // 32 ビットのアイコン画像
    LIcon.LoadFromFile('..\Images\Images_32bIT.ico');
    ImageList1.AddIcon(LIcon);
  finally
    FreeAndNil(LIcon);
  end;


  // TListView に TImageList の画像を描画
  for LIndex := 0 to ImageList1.Count - 1 do begin
    ListView1.Items.Add.Caption := 'Image - ' + IntToStr(LIndex);
    ListView1.Items[LIndex].ImageIndex := LIndex;
  end;
end;

//=============================================================================
//  24 ビット色以下の画像を読み込んで TImageList に格納
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LBitmap     : TBitmap;
  LMaskBitmap : TBitmap;
  LGifImage   : TGIFImage;
  LIcon       : TIcon;
  LIndex      : Integer;
begin
  ListView1.Items.Clear;
  ImageList1.Clear;

  LBitmap     := TBitmap.Create;
  LMaskBitmap := TBitmap.Create;
  try
    // 24 ビット色のビットマップ画像
    LBitmap.LoadFromFile('..\Images\simple_24bit.bmp');

    LMaskBitmap.Assign(LBitmap);
    LMaskBitmap.Mask(LBitmap.TransparentColor);
    ImageList1.Add(LBitmap, LMaskBitmap);
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LMaskBitmap);
  end;

  LBitmap     := TBitmap.Create;
  LMaskBitmap := TBitmap.Create;
  LGifImage   := TGIFImage.Create;
  try
    // GIF 形式の画像 ( 256 色 )
    LGifImage.LoadFromFile('..\Images\Simple_8bit.gif');
    LBitmap.SetSize(LGifImage.Width, LGifImage.Height);

    LGifImage.Transparent := False;
    LBitmap.Canvas.Draw(0, 0, LGifImage);
    LMaskBitmap.Assign(LBitmap);
    LMaskBitmap.Mask(LGifImage.Bitmap.TransparentColor);
    ImageList1.Add(LBitmap, LMaskBitmap);
  finally
    FreeAndNil(LBitmap);
    FreeAndNil(LMaskBitmap);
    FreeAndNil(LGifImage);
  end;

  LIcon := TIcon.Create;
  try
    // 24 ビット色のアイコン画像
    LIcon.LoadFromFile('..\Images\Images_24bIt.ico');
    ImageList1.AddIcon(LIcon);

    // 8 ビット色のアイコン画像
    LIcon.LoadFromFile('..\Images\Images_8bIt.ico');
    ImageList1.AddIcon(LIcon);
  finally
    FreeAndNil(LIcon);
  end;


  // TListView に TImageList の画像を描画
  for LIndex := 0 to ImageList1.Count - 1 do begin
    ListView1.Items.Add.Caption := 'Image - ' + IntToStr(LIndex);
    ListView1.Items[LIndex].ImageIndex := LIndex;
  end;
end;

end.



07_TListView における画像間のスペース


TListView.ViewStyle の値を vsIcon にして画像を描画した場合、各画像の間にはスペースがあります。Item 間の間隔、スペースとも言えます。下図はそれを確認した結果です。描画している画像のサイズは 128 x 128 です。枠線のサイズも同じ 128 x 128 です。



図12
デフォルトの画像の描画間隔

この画像間のスペースを、ListView_SetIconSpacing 関数を使用して変更した結果です。



図13
画像の描画間隔を変更

リスト7
TListView における画像間のスペース		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ImgList, Vcl.ComCtrls,
  Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ImageList1: TImageList;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure SetImageSpace;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Winapi.CommCtrl;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  ImageList1.SetSize(128, 128);
  ImageList1.ColorDepth := cd32Bit;

  ListView1.Items.Clear;
  ListView1.ViewStyle   := vsIcon;
  ListView1.LargeImages := ImageList1;
end;

//=============================================================================
//  32 ビット色のビットマップ画像を TImageList iに格納
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
  LIndex  : Integer;
begin
  SetImageSpace;

  ListView1.Items.Clear;
  ImageList1.Clear;

  LBitmap := TBitmap.Create;
  try
    // 128 x128 の四角形の画像を読み込む ( 32 ビット色 )
    LBitmap.LoadFromFile('..\Images\Frame_32bit.bmp');

    // それを TImageList に格納
    ImageList1.Add(LBitmap, nil);
    ImageList1.Add(LBitmap, nil);
    ImageList1.Add(LBitmap, nil);
    ImageList1.Add(LBitmap, nil);
    ImageList1.Add(LBitmap, nil);
    ImageList1.Add(LBitmap, nil);
  finally
    FreeAndNil(LBitmap);
  end;


  // TListView に TImageList の画像を描画
  for LIndex := 0 to ImageList1.Count - 1 do begin
    ListView1.Items.Add.Caption := 'Image - ' + IntToStr(LIndex);
    ListView1.Items[LIndex].ImageIndex := LIndex;
  end;
end;

//-----------------------------------------------------------------------------
//  TListView での画像描画の間隔を変更
//  uses に Winapi.CommCtrl が必要
//-----------------------------------------------------------------------------
procedure TForm1.SetImageSpace;
{$WRITEABLECONST ON}
const
  LImgFlag : Boolean = False;
{$WRITEABLECONST OFF}
var
  LWidth  : WORD;
  LHeight : WORD;
begin
  // トグル動作
  if LImgFlag then begin
    LWidth  := ImageList1.Width + 25;
    LHeight := ImageList1.Height + 25;
  end else begin
    // デフォルトの設定値
    LWidth  := WORD(-1);
    LHeight := WORD(-1);
  end;
  LImgFlag := not LImgFlag;

  // 画像の描画間隔 ( スペース ) を設定
  ListView_SetIconSpacing(ListView1.Handle, LWidth, LHeight);
end;

end.