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.