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 にはビットマップとして画像が格納されます.それらの画像をアイコン画像として取得するには 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 に描画
|
リスト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 に直接描画した結果 |
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 に直接描画した結果 |
procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Picture.Assign(nil);
// 透過状態が分かるように背景に市松模様のビットマップ画像を描画
DrawBackGroundImage(Image1.Canvas, FBackImgPath);
// TImage に TBitmap として描画
ImageList1.GetBitmap(1, Image1.Picture.Bitmap);
end;
|