Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2019年08月21日] [更新 2019年08月21日]　Delphi サンプルプログラム集
   
092_TImageList に格納されている画像を取得
動作確認等 Windows 7 U64(SP1) + Delphi XE5(UP2) Pro VCL-32
092_TImageList_GetImage.zip　[5,769 KB]　2019年08月27日版 (EXE 同梱)






TImageList に格納されている画像を取得


TImageList に格納している画像を取得，あるいは描画するサンプルです．
TImageList にはビットマップとして画像が格納されます．それらの画像をアイコン画像として取得するには GetIcon メソッドを使用します．ビットマップ画像として取得するには GetBitmap メソッドを使用します．指定の TCanvas に描画するには Draw メソッドが使用できます．

TImageList に格納されている画像が 32 ビットのアルファチャンネル情報を持つ場合は，ビットマップ画像として取得する前に TBitmap の前処理が必要です．



添付のプロジェクトのフォームは下図のようになっています．
左側の TImage には，取得した画像を TImage.Picture.Assign で描画します．右側の TImage には取得した画像を Tmage.Canvas.Draw メソッドで描画するようにしています．

1 つ目の TImageList (ImageList1) には，128 x 128 サイズの 32 ビットのアルファチャンネル情報付きの画像を 2 つ格納しています．この ImageList1 の の Width と Height プロパティの値を 128 にして，ColorDepth の値を cd32Bit にしています．
2 つ目の TImageList (ImageList2) には，64 x 64 サイズの 8 ビットの画像を 2 つ格納しています．この ImageList2 の Width と Height プロパティの値を 64 にして，ColorDepth の値を cd8Bit にしています．


TImageList に画像を格納する時は，画像のの色深度 (ビット数) に応じて，TImageList の ColorDepthプロパティの値を指定する必要があります．ColorDepth の値については，上のリンクのオンラインヘルプの記事で確認してください．



図1せ
設計時の画面
  • TImage を 2 つ配置
  • TImageList を 2 つ配置




01_TImageList 内の画像を TIcon 画像として取得


TImageList.GetIcon メソッドを使用して，TIcon 形式のアイコン画像として取得する令です．




図2
TImageList 内の画像を TIcon 形式の画像として取得
  • TImageList 内の画像は 32 bit のアルファチャンネル付きの画像

リスト1
TImageList 内の画像を TIcon 形式の画像として取得		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    FBackImgPath : string;
    procedure DrawBackGroundImage(ACanvas: TCanvas; AFilePath: string);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  透過状態の確認用に背景を指定色で塗り潰す
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Color   := $00B3FFB3;
  FBackImgPath := ExpandFileName('..\BackTexture_01.bmp');
end;

//=============================================================================
//  TImageList から画像を TIcon 画像として取得する例
//  TImageList.GetIcon メソッドを使用
//  Assign と TCanvas.Draw の両方で描画結果を確認
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LIcon : TIcon;
begin
  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  //透過状態が分かるように背景に市松模様のビットマップ画像を描画
  DrawBackGroundImage(Image1.Canvas, FBackImgPath);
  DrawBackGroundImage(Image2.Canvas, FBackImgPath);


  LIcon := TIcon.Create;
  try
    ImageList1.GetIcon(0, LIcon);

    Image1.Picture.Assign(LIcon);
    Image2.Canvas.Draw(0, 0, LIcon);
  finally
    FreeAndNil(LIcon);
  end;
end;

//----------------------------------------------------------------------------
//  TImage の背景として市松模様のブラシを描画
//  TBitmap の透過色と半透明色の確認用
//  この模様が見える部分は透明または半透明の部分ということになる
//----------------------------------------------------------------------------
procedure TForm1.DrawBackGroundImage(ACanvas: TCanvas; AFilePath: string);
var
  LBmpBack : TBitmap;
begin
  LBmpBack := TBitmap.Create;
  try
    LBmpBack.LoadFromFile(AFilePath);
    ACanvas.Brush.Style  := bsSolid;
    ACanvas.Brush.Bitmap := LBmpBack;
    ACanvas.FillRect(ACanvas.ClipRect);
  finally
    FreeAndNil(LBmpBack);
  end;
end;

end.



02_TImageList 内の画像を TBitmap 画像として取得


TImageList.GeBitmap メソッドを使用して，TBitmap 形式のビットマップ画像として取得する令です．
GetBitmap メソッドは，32 ビットのアルファチャンネル付き画像を正常に処理してくれません．そこでこのサンプルでは，完全に透明な TBitmap の画像を作成してから GetBitmap メソッドで画像を取得しています．




図3
TImageList 内の画像を TBitmap 形式の画像として取得
  • TImageList 内の画像は 32 bit のアルファチャンネル付きの画像

TBitmap の前処理をしない場合，32 ビットの画像の取得結果は下図のようになります．透明なピクセルが透明にならすに「白」なっています．そのため ，背景の市松模様の画像が見えていません．




図4
TBitmap の前処理をしない時の 32 ビット画像の取得結果
  • 透明になるべき部分が透明にならない

リスト2
TImageList 内の画像を TBitmap 形式の画像として取得
32 ビットのアルファチャンネル付きの画像の場合は前処理が必要		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    FBackImgPath : string;
    procedure DrawBackGroundImage(ACanvas: TCanvas; AFilePath: string);
  end;

  procedure SetBitmapAlpha(ABitmap: TBitMap);

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  透過状態の確認用に背景を指定色で塗り潰す
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Color   := $00B3FFB3;
  FBackImgPath := ExpandFileName('..\BackTexture_01.bmp');
end;

//=============================================================================
//  TImageList から画像を TBitmap 画像として取得する例
//  Assign と TCanvas.Draw の両方で描画結果を確認
//
//  TImageList に格納されている画像が 32 bit のアルファチャンネル画像の場合は
//  TImageList.GetBitmap で読み込む前に完全に透明な TBitmap にしておく
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  //透過状態が分かるように背景に市松模様のビットマップ画像を描画
  DrawBackGroundImage(Image1.Canvas, FBackImgPath);
  DrawBackGroundImage(Image2.Canvas, FBackImgPath);


  LBitmap := TBitmap.Create;
  try
    // 32 ビットの画像の場合
    // 32 ビットの場合はアルファチャンネル情報ありとみなす 
    if ImageList1.ColorDepth = cd32Bit then begin
      LBitmap.AlphaFormat := afDefined;
      LBitmap.SetSize(ImageList1.Width, ImageList1.Height);
      SetBitmapAlpha(LBitmap);
    end;
    // TImageList に格納されている画像を TBitmap 画像として取得
    ImageList1.GetBitmap(1, LBitmap);

    Image1.Picture.Assign(LBitmap);
    Image2.Canvas.Draw(0, 0, LBitmap);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//----------------------------------------------------------------------------
//  TImage の背景として市松模様のブラシを描画
//  TBitmap の透過色と半透明色の確認用
//  この模様が見える部分は透明または半透明の部分ということになる
//----------------------------------------------------------------------------
procedure TForm1.DrawBackGroundImage(ACanvas: TCanvas; AFilePath: string);
var
  LBmpBack : TBitmap;
begin
  LBmpBack := TBitmap.Create;
  try
    LBmpBack.LoadFromFile(AFilePath);
    ACanvas.Brush.Style  := bsSolid;
    ACanvas.Brush.Bitmap := LBmpBack;
    ACanvas.FillRect(ACanvas.ClipRect);
  finally
    FreeAndNil(LBmpBack);
  end;
end;

//----------------------------------------------------------------------------
//  透明なビットマップ画像の作成
//  アルファチャンネルのビットマップのピクセル値のクリア
//  Red,Gree, Blue, Alphi 値を全て0 にしたビットマップにする
//----------------------------------------------------------------------------
procedure SetBitmapAlpha(ABitmap: TBitMap);
type
  TRGBQArray = array [0..High(Integer) div 4 - 1] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LPosY      : Integer;
  LPosX      : Integer;
  LScanArray : PRGBQArray;
begin
  ABitmap.Canvas.Lock;
  ABitmap.PixelFormat := pf32bit;

  for LPosY := 0 to ABitmap.Height - 1 do begin
    LScanArray := ABitmap.ScanLine[LPosY];
    for LPosX  := 0 to ABitmap.Width - 1 do begin
      LScanArray[LPosX].rgbRed      := 0;
      LScanArray[LPosX].rgbGreen    := 0;
      LScanArray[LPosX].rgbBlue     := 0;
      LScanArray[LPosX].rgbReserved := 0;
    end;
  end;

  ABitmap.Canvas.Unlock;
end;

end.



03_TImageList 内の画像を TIcon として取得して TBitmap に変換


ビットマップ画像として取得したい場合，TImageList.GetIcon メソッドで Icon 形式の画像として取得してから TBitmap 形式の画像に変換すれば 32 ビットのアルファチャンネル付きの画像も正常に取得できます．
TIcon から TBitmap への変換には TIcon.AssignTo メソッドが利用できます．




図5
TImageList 内の画像を TIcon 形式の画像として取得してから TBitmap に変換
  • TImageList 内の画像は 32 bit のアルファチャンネル付きの画像

リスト3
TImageList 内の画像を TIcon 形式の画像として取得してから TBitmap に変換		 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    ImageList1: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    FBackImgPath : string;
    procedure DrawBackGroundImage(ACanvas: TCanvas; AFilePath: string);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  透過状態の確認用に背景を指定色で塗り潰す
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Color   := $00B3FFB3;
  FBackImgPath := ExpandFileName('..\BackTexture_01.bmp');
end;

//=============================================================================
//  TImageList から画像を TBitmap 画像として取得する例
//  Assign と TCanvas.Draw の両方で描画結果を確認
//
//  TIcon 形式の画像として取得してから TBitmap に変換する例
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LIcon : TIcon;
  LBitmap : TBitmap;
begin
  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  //透過状態が分かるように背景に市松模様のビットマップ画像を描画
  DrawBackGroundImage(Image1.Canvas, FBackImgPath);
  DrawBackGroundImage(Image2.Canvas, FBackImgPath);


  LIcon := TIcon.Create;
  LBitmap := TBitmap.Create;
  try
    // TIcon として取得
    ImageList1.GetIcon(1, LIcon);

    // TIcon --> TBitmap 変換
    if ImageList1.ColorDepth = cd32Bit then begin
      LIcon.AssignTo(LBitmap);
    end else begin
      LBitmap.Transparent := True;
      LBitmap.SetSize(LIcon.Width, LIcon.Height);
      LBitmap.Canvas.Draw(0, 0, LIcon);
    end;

    Image1.Picture.Assign(LBitmap);
    Image2.Canvas.Draw(0, 0, LBitmap);
  finally
    FreeAndNil(LIcon);
    FreeAndNil(LBitmap);
  end;
end;

//----------------------------------------------------------------------------
//  TImage の背景として市松模様のブラシを描画
//  TBitmap の透過色と半透明色の確認用
//  この模様が見える部分は透明または半透明の部分ということになる
//----------------------------------------------------------------------------
procedure TForm1.DrawBackGroundImage(ACanvas: TCanvas; AFilePath: string);
var
  LBmpBack : TBitmap;
begin
  LBmpBack := TBitmap.Create;
  try
    LBmpBack.LoadFromFile(AFilePath);
    ACanvas.Brush.Style  := bsSolid;
    ACanvas.Brush.Bitmap := LBmpBack;
    ACanvas.FillRect(ACanvas.ClipRect);
  finally
    FreeAndNil(LBmpBack);
  end;
end;

end.



04_TImageList 内の画像を TImage.Canvas に直接描画


TImageList.Draw メソッドを使用して，TImageList 内の画像を TImage.Canvas に描画する例です．




図6
TImageList.Draw メソッドで TImage に画像を直接描画
  • 左は TImageList 内の最初の画像
  • 右は TImageList 内の 2 番目の画像

リスト4
TImageList.Draw メソッドを使用して TImage.Canvas に直接描画		 
//=============================================================================
//  TImageList の画像を TImage.Canvas に直接描画
//  TImageList.Draw メソッドを使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  //透過状態が分かるように背景に市松模様のビットマップ画像を描画
  DrawBackGroundImage(Image1.Canvas, FBackImgPath);
  DrawBackGroundImage(Image2.Canvas, FBackImgPath);


  ImageList1.Draw(Image1.Canvas, 0, 0, 0);
  ImageList1.Draw(Image2.Canvas, 0, 0, 1);
end;



05_TImageList 内の画像を TBitmap.Canvas に直接描画


TImageList.Draw メソッドを使用して，TImageList 内の画像を TBitmap.Canvas に描画する例です．
TImageList.Draw メソッドは，32 ビットのアルファチャンネル付き画像を正常に処理してくれません．そこでこのサンプルでは，ビットマップとして取得するサンプルで使用した，完全に透明なビットマップ作成用の関数を利用した前処理を行っています．

このサンプルの実行結果としてのビットマップ画像は，複数の画像が横方向に連結された画像となります．これは TImageList に格納されている状態と同じです．




図7
ImageList.Draw メソッドで TBitmap に画像を直接描画
  • 上は TBitmap を TImage.Picture.Assign で描画した結果
  • 下は TBitmap を TImage.Canvas.Draw で描画した結果
  • 2 つの画像が連結された横長のビットマップ画像

リスト5
TImageList.Draw メソッドを使用して TBitmap.Canvas に直接描画
32 ビットのアルファチャンネル付きの画像の場合は前処理が必要		 
//=============================================================================
//  TImageList の画像を TBitmap.Canvas に直接描画
//  TImageList.Draw メソッドを使用
//
//  TBitmap.Canvas に描画する場合は
//  TImageList.Draw で描画する前に完全に透明な TBitmap にしておく
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LBitmap : TBitmap;
begin
  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  //透過状態が分かるように背景に市松模様のビットマップ画像を描画
  DrawBackGroundImage(Image1.Canvas, FBackImgPath);
  DrawBackGroundImage(Image2.Canvas, FBackImgPath);


  LBitmap := TBitmap.Create;
  try
    LBitmap.AlphaFormat := afDefined;

    LBitmap.SetSize(Image1.Width * ImageList1.Count, Image1.Height);
    if ImageList1.ColorDepth = cd32Bit then begin
      SetBitmapAlpha(LBitmap);
    end;

    ImageList1.Draw(LBitmap.Canvas, 0, 0, 0);
    ImageList1.Draw(LBitmap.Canvas, ImageList1.Height, 0, 1);

    Image1.Picture.Assign(LBitmap);
    Image2.Canvas.Draw(0, 0, LBitmap);
  finally
    FreeAndNil(LBitmap);
  end;
end;



06_TImageList 内の画像を PNG 形式の画像として取得


TImageList 内の画像を PNG 形式の画像として取得するメソッド類はありません．
Delphi 2010 で実装された TWICImage クラスを使用して以下のようにして取得できます．まず TIcon 形式の画像として取得します．その TIcon 形式の画像を TWICImage を使用して PNG 形式の画像に変換します．
ここまでのサンプルプログラムでは，TImageList に格納されている色数で画像ょ取得しますが，本サンプルでは全て 32 ビットの PNG 形式の画像としての取得となります．




図8
PNG 形式の画像として取得して TImage に描画
  • 32 ビットのアルファチャンネル付きの画像となる

リスト6
TImageList 内の画像を PNG 形式の画像として取得		 
//=============================================================================
//  TImageList から画像を TIcon 画像として取得する例
//  TImageList.GetIcon メソッドで TIcon 画像として取得
//  取得した TIcon を TWICImage で PNG 形式の画像に変換　
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LIcon      : TIcon;
  LWICImage  : TWICImage;
  LStream    : TMemoryStream;
begin
  Image1.Picture.Assign(nil);
  Image2.Picture.Assign(nil);

  //透過状態が分かるように背景に市松模様のビットマップ画像を描画
  DrawBackGroundImage(Image1.Canvas, FBackImgPath);
  DrawBackGroundImage(Image2.Canvas, FBackImgPath);

  LIcon     := TIcon.Create;
  LWICImage := TWICImage.Create;
  LStream   := TMemoryStream.Create;
  try
    ImageList1.GetIcon(0, LIcon);

    // TIcon を直接または Assign できないのでメモリストリームを利用
    LIcon.SaveToStream(LStream);
    LStream.Position := 0;
    LWICImage.LoadFromStream(LStream);

    // PNG 形式の画像に変換
    // TWICImage ほ保存すると 32 ビットの PNG 画像となる
    LWICImage.ImageFormat := wifPng;
    LWICImage.SaveToFile('000.png');

    Image1.Picture.Assign(LWICImage);
    Image2.Canvas.Draw(0, 0, LWICImage);
  finally
    FreeAndNil(LIcon);
    FreeAndNil(LWICImage);
    FreeAndNil(LStream);
  end;
end;



07_TImageList 内の画像を TImage に直接描画


TImageList 内の画像を TImage に画像として描画するだけであれば，TIcon, TBitmap 等のオブジェクトを取得する必要はありません．
下図は，TImageList.GetIcon メソッドで TImage.Picture.Icon に直接描画した結果です．




図9
TImage.Picture.Icon に直接描画した結果

リスト7 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Assign(nil);

  // 透過状態が分かるように背景に市松模様のビットマップ画像を描画
  DrawBackGroundImage(Image1.Canvas, FBackImgPath);

  // TIMage に TIcon 画像として描画
  ImageList1.GetIcon(0, Image1.Picture.Icon);
end;


T下図は，TImageList.GetBitmap メソッドで TImage.Picture.Bitmap に直接描画した結果です．
TImage.Picture.Bitmap に直接描画すると，透明ピクセルの処理をしてくれるようです．




図10
TImage.Picture.Bitmap に直接描画した結果

リスト8 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Assign(nil);

  // 透過状態が分かるように背景に市松模様のビットマップ画像を描画
  DrawBackGroundImage(Image1.Canvas, FBackImgPath);

  // TImage に TBitmap として描画
  ImageList1.GetBitmap(1, Image1.Picture.Bitmap);
end;