Delphi Programming / Object Pascal
[掲載 2023年01月03日] [更新 2023年01月03日] Delphi サンプルプログラム集 |
088_TBitmap の画像を TImage に描画 |
動作確認等 |
Windows 10 ビルド 19043 Pro 64 bit + Delphi XE5(UP2) Pro VCL-32 |
|
088_Bitmap_DrawToTImage.zip [3,6 MB] 2023年01月03日版 (EXE 同梱) |
主に TBitmap の画像を TImage に描画するサンプルです.
サンプルプログラム集には,処理の結果として TBitmap の画像を TImage に描画するサンプルはありますが,本ページは,単純にファイルから読み出した TBitmap の画像を表示するたけのサンプルとしています. |
[備考]
TBitmap の TransparentColor も Transparent プロパティも public なプロパティです.実行時にこれらの値を設定して TBitmap の画像を保存しても,これらの値は保存されません.
TransparentColor のデフォルト値は TBitmap.Canvas の左下のピクセルの色となります.Transparent プロパティのデフォルト値は False です.
TBitmap の AlphaFormat も public なプロパティです.デフォルトは afIgnored です. |
01_アルファ値を使用する 32 ビットの TBitmap を TImage に描画 |
Delphi の TBitmap 画像の色深度はデフォルトで 32 ビットです.32 ビットの TBitmap は,各ピクセルの不透明度を指定する 1 バイトのアルファ値を格納するデータ領域を持っていますが,デフォルトではこのデータを使用しません.アルファ値を使用した描画を行うには,AlphaFormat プロパティの値を afDefined にします.AlphaFormat プロパティは public なプロパティです.
本サンプルでは,アルファ値のデータが 0 でないビットマップを読み込んで,TImage に描画します.これは,アルファ値を使用するビットマップということになります.
下図は AlphaFormat プロパティの値を afDefined の場合です.背景の市松模様が見えているピクセルは,A, R, G, B の値が全て 0 のピクセルです.ここれは透明色です.透明色のピクセルが透過状態になります.半透明の色を透過職にすることはできません.
A はアルファ値を意味します. |
|
図1
AlphaFormat が afDefined の場合 |
AlphaFormat プロパティの値を指定しない場合です.
AlphaFormat プロパティの値を指定しない場合は,AlphaFormat プロパティの値を afIgnored にした場合と同じになり,アルファ値を使用しないで描画します.透明色のピクセルの R, G, B の値は 0 です.アルファ値を使用しないので「黒」になります.
これは,24 ビット以下のビットマップ画像ファイルを TBitmap に読み込んだ時と同じです.24 ビット以下のビットマップを読み込んだ時は,TBitmap のビット深さは,そのビットマップのビット深さと同じになります.24 ビット以下のビットマップにはアルファチャンネルはありません. |
|
図2
AlphaFormat を指定しない場合
- AlphaFormat が afIgnored の時と同じになる
- afIgnored はデフォルトの値
|
同じく,AlphaFormat プロパティの値を指定しない場合ですが,Transparent プロパティの値を True にした場合です.
Transparent が True の時,デフォルトでは画像の左下のピクセルの色が透過色になります.AlphaFormat を指定していないのでアルファ値は無効ですから,左下のピクセルの色は「黒」です.したがって,画像の黒のピクセルが透過状態になります.下図で黒く見えるピクセルは,元は半透明のピクセルです.実際には黒ではなく,黒に近い色です.R, G, B の値が 0 に近い色です. |
|
図3
AlphaFormat を指定しないで,Transparent を True にした場合 |
リスト1
アルファ値を使用する 32 ビットの TBitmap を TImage に描画 |
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;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
procedure BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
FImgFilePath : string = '..\Images\images_32bit.bmp';
//=============================================================================
// アルファチャンネル付きの 32 ビットのビットマップを TImage に描画
// TBitmap.AlphaFormat := afDefined にすればよい
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
LBitmap.AlphaFormat := afDefined;
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//=============================================================================
// アルファチャンネル付きの 32 ビットのビットマップを TImage に描画
// TBitmap.AlphaFormat の値を指定しない場合
// TBitmap.AlphaFormat := afIgnored ( デフォルト ) と同じ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//=============================================================================
// アルファチャンネル付きの 32 ビットのビットマップを TImage に描画
// TBitmap.Transparent := True にした場合
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
LBitmap.Transparent := True;
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//-----------------------------------------------------------------------------
// 引数のビットマップを TImage に描画
// 透過状態確認用に,背景を市松模様のビットマップにする
//-----------------------------------------------------------------------------
procedure TForm1.BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
var
LBitmap : TBitmap;
begin
AImage.Picture.Assign(nil);
// TImage32 の背景を市松模様のタイルにする
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile('..\Images\backTexture_02.bmp');
AImage.Canvas.Brush.Style := bsSolid;
AImage.Canvas.Brush.Bitmap := LBitmap;
AImage.Canvas.FillRect(AImage.Canvas.ClipRect);
finally
FreeAndNil(LBitmap);
end;
// ビットマップ画像を描画
AImage.Canvas.Draw(0, 0, ABitmap);
end;
end.
[備考]
32 ビットの,アルファ値が 0 でないビットマップの PixelFormat プロパティの値を pf24bit にした場合,減色処理が行われます.その結果,半透明のピクセルは異なる色になります.
例えば,本項で使用したビットマップ画像の場合,半透明のピクセルは黒に近い色になります. |
02_アルファ値を使用しない 32 ビットの TBitmap を TImage に描画 |
前項と同じで,32 ビットのビットマップを読み込み,TImage に描画しますが,このビットマップは,アルファ値が全て 0 のビットマップです.
24 ビット以下のビットマップの PixelFormat プロパティの値を pf32bit にすると,アルファ値を使用しないビットマップとなります.
下図は,32 ビットのビットマップ画像ファイルを読み込んで,そのまま IImage に描画した結果です.サンプルコードでは ,AlphaFormat プロパティの値を afIgnored にしていますが,これはデフォルト値なので設定しなくても結果は同じです. |
|
図4
TBitmap に,ビットマップ画像ファイルを読み込んで描画 |
Transparent プロパティの値を True にした場合です.
Transparent を True にすると,デフォルトでは画像の左下のピクセルの色が透過色になります.本サンプルで使用した画像では枠線の色です. |
|
図5
Transparent を True にした場合 |
同じく,Transparent プロパティの値を True にする例ですが,透過色を TransparentColor プロパティで指定した結果です.透過色は,枠線内の色にしています. |
|
図6
Transparent を True にした場合
- 透過色は枠線内部の色
- 透過色は TransparentColor で設定
|
下図は AlphaFormat プロパティの値を afDefined にした場合です.透明な画像になります.
本サンプルで使用している TBitmap の画像は,アルファ値が全て 0 です.全てのピクセルで R, G, B の値は 0 ではありません.しかし,AlphaFormat を afDefined にすると,アルファ値を使用して描画します.アルファ値が 0 ということは,不透明度が 0 ということです.つまり,透明ということです. |
|
図7
AlphaFormat を afDefined にした場合
|
リスト2
アルファ値を使用しない 32 ビットの TBitmap を TImage に描画 |
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;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private 宣言 }
procedure BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
FImgFilePath : string = '..\Images\Frame_32bit.bmp';
//=============================================================================
// アルファチャンネルを使用しない 32 ビットのビットマップを TImage に描画
// TBitmap.AlphaFormat := afIgnored ( デフォルト ) にすればよい
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
LBitmap.AlphaFormat := afIgnored;
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//=============================================================================
// アルファチャンネルを使用しない 32 ビットのビットマップを TImage に描画
// TBitmap.Transparent := True にした場合
// 透過色は左下のピクセルの色になる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
LBitmap.Transparent := True;
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//=============================================================================
// アルファチャンネルを使用しない 32 ビットのビットマップを TImage に描画
// 透過色を指定して,TBitmap.Transparent := True にした場合
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
LBitmap.TransparentColor := LBitmap.Canvas.Pixels[5, 5];
LBitmap.Transparent := True;
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//=============================================================================
// アルファチャンネルを使用しない 32 ビットのビットマップを TImage に描画
// TBitmap.AlphaFormat := afDefined ( アルファ値を使用) にした場合
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
LBitmap.AlphaFormat := afDefined;
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//-----------------------------------------------------------------------------
// 引数のビットマップを TImage に描画
// 透過状態確認用に,背景を市松模様のビットマップにする
//-----------------------------------------------------------------------------
procedure TForm1.BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
var
LBitmap : TBitmap;
begin
AImage.Picture.Assign(nil);
// TImage の背景を市松模様のタイルにする
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile('..\Images\backTexture_02.bmp');
AImage.Canvas.Brush.Style := bsSolid;
AImage.Canvas.Brush.Bitmap := LBitmap;
AImage.Canvas.FillRect(AImage.Canvas.ClipRect);
finally
FreeAndNil(LBitmap);
end;
// ビットマップ画像を描画
AImage.Canvas.Draw(0, 0, ABitmap);
end;
end.
03_24 ビット以下の TBitmap 画像を TImage に描画 |
24 ビット以下のビットマップ画像のファイルを読み込んで TImage に描画する場合です.
24 ビット以下の TBitmap にはアルファチャンネルはありません.ピクセルの色は R, G, B の 3 バイトの値で決まります.
下図は,TBitmap に,24 ビットのビットマップ画像を読み込んで TImage に描画した結果です. |
|
図8
24 ビットのビットマップ画像 |
Transparent プロパティの値を True にした場合です.
Transparent を True にすると,デフォルトでは画像の左下のピクセルの色が透過色になり,透過状態になります. |
|
図9
24 ビットのビットマップ画像
|
同じく,Transparent プロパティの値を True にする例ですが,透過色を TransparentColor プロパティで指定した結果です.透過色は,画像左上の四角形のピクセルの色にしています.この色は黒です. |
|
図10
24 ビットのビットマップ画像
- TransparentColor の値を黒にして
- Transparent を True にした場合
|
AlphaFormat プロパティの値を afDefined にした場合です.24 ビット以下の TBitmap では,AlphaFormat を設定しても無効です.AlphaFormat プロパティは,32 ビットの TBitmap 用のプロパティです. |
|
図11
24 ビットのビットマップ画像
|
リスト3
24 ビット以下の TBitmap 画像を TImage に描画 |
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;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private 宣言 }
procedure BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
FImgFilePath : string = '..\Images\simple_24bit.bmp';
//=============================================================================
// 24 ビット以下のビットマップを TImage に描画
// 24 ビット以のビットマップにはアルファチャンネルがない
// TBitmap.AlphaFormat := afIgnored ( デフォルト ) にすればよい
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
LBitmap.AlphaFormat := afIgnored;
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//=============================================================================
// 24 ビット以下のビットマップを TImage に描画
// 24 ビット以のビットマップにはアルファチャンネルがない
// TBitmap.Transparent := True にした場合
// 透過色は左下のピクセルの色になる
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
LBitmap.Transparent := True;
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//=============================================================================
// 24 ビット以下のビットマップを TImage に描画
// 24 ビット以のビットマップにはアルファチャンネルがない
// 透過色を指定して,TBitmap.Transparent := True にした場合
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
LBitmap.TransparentColor := LBitmap.Canvas.Pixels[5, 5];
LBitmap.Transparent := True;
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//=============================================================================
// 24 ビット以下のビットマップを TImage に描画
// 24 ビット以のビットマップにはアルファチャンネルがないので
// TBitmap.AlphaFormat の値は描画に関係ない
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FImgFilePath);
LBitmap.AlphaFormat := afDefined;
BmpDrawTo(LBitmap, Image1);
finally
FreeAndNil(LBitmap);
end;
end;
//-----------------------------------------------------------------------------
// 引数のビットマップを TImage に描画
// 透過状態確認用に,背景を市松模様のビットマップにする
//-----------------------------------------------------------------------------
procedure TForm1.BmpDrawTo(ABitmap: TBitmap; AImage: TImage);
var
LBitmap : TBitmap;
begin
AImage.Picture.Assign(nil);
// TImage の背景を市松模様のタイルにする
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile('..\Images\backTexture_02.bmp');
AImage.Canvas.Brush.Style := bsSolid;
AImage.Canvas.Brush.Bitmap := LBitmap;
AImage.Canvas.FillRect(AImage.Canvas.ClipRect);
finally
FreeAndNil(LBitmap);
end;
// ビットマップ画像を描画
AImage.Canvas.Draw(0, 0, ABitmap);
end;
end.
04_フォルダ内の BMP / PNG / GIF / ICO 画像を TImage に連続描画 |
添付の [Images] フォルダ内には,テスト用の画像があります.その [Imagaes] フォルタ内の画像ファイルを,順番に読み出して表示するサンプルです.
画像は,TImage の左右上下の中央に描画するようにしています. |
|
図12
フォルダ内の画像を順番に表示 |
リスト4
フォルダ内の BMP / PNG / GIF / ICO 画像を順番に,TImage に描画 |
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.Buttons,
Vcl.ExtCtrls;
type
TForm1 = class(TForm)
SpeedButton2: TSpeedButton;
SpeedButton1: TSpeedButton;
Image1: TImage;
Edit1: TEdit;
CheckBox1: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
{ Private 宣言 }
FFileDir : string;
FFileList : TStringList;
procedure DrawBackGouundBmp(AImage: TImage; AWidth, AHeight: Integer);
public
{ Public 宣言 }
end;
function BmpIsUsedAlphaValue(ABitmap: TBitmap): Boolean;
var
Form1: TForm1;
implementation
uses
System.Types,
System.IOUtils,
System.StrUtils,
Vcl.Imaging.pngimage,
Vcl.Imaging.GIFImg;
{$R *.dfm}
const
FExtArray : array [0..3] of string = ('.bmp', '.png', '.gif', '.ico');
//=============================================================================
// フォーム生成時の処理
// 指定ディレクトリ内の指定拡張子のファイルのリストを作成
//
// uses に System.Types,System.IOUtils が必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LFileArray : TStringDynArray;
LFileExe : string;
LIndex : Integer;
begin
CheckBox1.Caption := 'ビットマップの透過色を使用する透過処理';
FFileDir := '..\Images\';
LFileArray := TDirectory.GetFiles(FFileDir, '*.*');
FFileList := TStringList.Create;
for LIndex := 0 to Length(LFileArray) - 1 do begin
LFileExe := ExtractFileExt(LFileArray[LIndex]);
if MatchText(LFileExe, FExtArray) then begin
FFileList.Add(LFileArray[LIndex]);
end;
end;
SpeedButton2Click(SpeedButton2);
end;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FFileList);
end;
//=============================================================================
// 前の画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
SpeedButton2Click(SpeedButton1);
end;
//=============================================================================
// 次の画像ファイルを読み込んで表示
// uses に System.IOUtils, Vcl.Imaging.pngimage, Vcl.Imaging.GIFImg が必要
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
{$WRITEABLECONST ON}
const
LIndex : Integer = -1;
{$WRITEABLECONST OFF}
var
LImgPath : string;
LFileExt : string;
LBitmap : TBitmap;
LPngImg : TPngImage;
LGifImg : TGIFImage;
LIcon : TIcon;
begin
if Sender = SpeedButton2 then begin
Inc(LIndex);
end else
if Sender = SpeedButton1 then begin
Dec(LIndex);
end;
if (LIndex + 1) > FFileList.Count then begin
LIndex := FFileList.Count - 1;
Exit;
end;
if LIndex < 0 then begin
LIndex := 0;
Exit;
end;
while True do begin
LImgPath := FFileList[LIndex];
if FileExists(LImgPath) then Break;
FFileList.Delete(LIndex);
if (LIndex + 1) > FFileList.Count then Exit;
end;
SpeedButton1.Enabled := (LIndex > 0) and (FFileList.Count >= 2);
SpeedButton2.Enabled := ((LIndex + 1) < FFileList.Count) and (FFileList.Count >= 2);
LFileExt := LowerCase(ExtractFileExt(LImgPath));
Edit1.Text := ExtractFileName(LImgPath);
// [前] [次] の機能を正常に動作させるには,
// FExtArray ( 拡張子名の配列) にある拡張子のファイルは全て処理する
// ビットマップ画像ファイルの場合
if LFileExt = '.bmp' then begin
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(LImgPath);
if not BmpIsUsedAlphaValue(LBitmap) then begin
if CheckBox1.Checked then begin
LBitmap.TransparentColor := LBitmap.Canvas.Pixels[0, LBitmap.Height - 1];
LBitmap.Transparent := True;
end;
end;
DrawBackGouundBmp(Image1, LBitmap.Width, LBitmap.Height);
Image1.Canvas.Draw(0, 0, LBitmap);
finally
FreeAndNil(LBitmap);
end;
end else
// PNG 画像ファイルの場合
if LFileExt = '.png' then begin
LPngImg := TPngImage.Create;
try
LPngImg.LoadFromFile(LImgPath);
DrawBackGouundBmp(Image1, LPngImg.Width, LPngImg.Height);
Image1.Canvas.Draw(0, 0, LPngImg);
finally
FreeAndNil(LPngImg);
end;
end else
// GIF 画像ファイルの場合
if LFileExt = '.gif' then begin
LGifImg := TGIFImage.Create;
try
LGifImg.LoadFromFile(LImgPath);
DrawBackGouundBmp(Image1, LGifImg.Width, LGifImg.Height);
Image1.Canvas.Draw(0, 0, LGifImg);
finally
FreeAndNil(LGifImg);
end;
end else
// ICO 画像ファイルの場合
// TIcon 画像は TBitmap に変換
// 32 ビットの TIcon であればそのまま TImage に描画可能
if LFileExt = '.ico' then begin
LBitmap := TBitmap.Create;
LIcon := TIcon.Create;
try
LIcon.LoadFromFile(LImgPath);
LBitmap.Assign(LIcon);
DrawBackGouundBmp(Image1, LBitmap.Width, LBitmap.Height);
Image1.Canvas.Draw(0, 0, LBitmap);
finally
FreeAndNil(LBitmap);
FreeAndNil(LIcon);
end;
end;
end;
//=============================================================================
// CheckBox1 をクリックしたら再描画
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
SpeedButton2Click(nil);
end;
//-----------------------------------------------------------------------------
// 画像の描画領域の背景を市松模様のビットマップ画像にする
// 透過状態の確認用
// 描画位置は TImage の中央
//-----------------------------------------------------------------------------
procedure TForm1.DrawBackGouundBmp(AImage: TImage; AWidth, AHeight: Integer);
var
LBitmap : TBitmap;
begin
AImage.Picture.Assign(nil);
AImage.Picture.Bitmap.SetSize(AWidth, AHeight);
AImage.Center := True;
LBitmap := TBitmap.Create;
try
LBitmap.LoadFromFile(FFileDir + 'backTexture_02.bmp');
AImage.Canvas.Brush.Style := bsSolid;
AImage.Canvas.Brush.Bitmap := LBitmap;
AImage.Canvas.FillRect(AImage.Canvas.ClipRect);
finally
FreeAndNil(LBitmap);
end;
end;
//-----------------------------------------------------------------------------
// アルファチャンネル付きのビットマップかを判定
// アルファチャンネル付きは,描画にアルファを使用していること
//
// 戻り値
//
// True : アルファチャンネルを使用する 32 ビットのビットマップ
// 引数の TBitmap.AlphaFormat の値を afDefined にして返す
//
// False : アルファチャンネルを使用しない 32 ビットのビットマップ
// 引数の TBitmap.AlphaFormat の値を afIgnored にして返す
// 24 ビット以下の時も戻り値も False
//
// 透過ピクセルが透明色の場合,
// TBitmap.TransparentColor の値が $02000000 であるかで判定できるが,
// 判定する前に TransParentColor の値を設定してしまうと区別できない
//-----------------------------------------------------------------------------
function BmpIsUsedAlphaValue(ABitmap: TBitmap): Boolean;
type
TRGBQArray = array [0..4095] of RGBQUAD;
PRGBQArray = ^TRGBQArray;
var
LXPos : integer;
LYPos : Integer;
LBmpScan : PRGBQArray;
LPixelCnt : Integer;
begin
Result := False;
if ABitmap.PixelFormat <> pf32bit then Exit;
ABitmap.Canvas.Lock;
try
ABitmap.AlphaFormat := afIgnored;
LPixelCnt := 0;
for LYPos := 0 to ABitmap.Height - 1 do begin
LBmpScan := ABitmap.ScanLine[LYPos];
for LXPos := 0 to ABitmap.Width - 1 do begin
if (LBmpScan[LXPos].rgbReserved = 0) then Inc(LPixelCnt);
end;
end;
Result := LPixelCnt <> (ABitmap.Width * ABitmap.Height);
if Result then begin
ABitmap.AlphaFormat := afDefined;
end else begin
ABitmap.AlphaFormat := afIgnored;
end;
finally
ABitmap.Canvas.Unlock;
end;
end;
end.
アルファチャンネル付きの TBitmap 画像を TPngImage 画像に変換するのは少し面倒ですが,TPngImage 画像から TBitmap 画像への変換は,以下のように Asssign メソッドで可能です.
|
LPngImg := TPngImage.Create;
LBitmap := TBitmap.Create;
try
LPngImg.LoadFromFile(LImgPath);
LBitmap.Assign(LPngImg);
DrawBackGouundBmp(Image1, LPngImg.Width, LPngImg.Height);
Image1.Canvas.Draw(0, 0, LBitmap);
finally
FreeAndNil(LPngImg);
FreeAndNil(LBitmap);
end;
end;
TGIFImage 画像の透過色は,次のように,TGIFImage.Bitmap.TransparentColor;で取得できます.
このサンプルは,TBitmap 画像の透過色を,TGIFImage 画像の透過色と同じにします. |
LGifImg := TGIFImage.Create;
LBitmap := TBitmap.Create;
try
LGifImg.LoadFromFile(LImgPath);
LBitmap.Assign(LGifImg);
LBitmap.TransparentColor := LGifImg.Bitmap.TransparentColor;
LBitmap.Transparent := True;
DrawBackGouundBmp(Image1, LGifImg.Width, LGifImg.Height);
Image1.Canvas.Draw(0, 0, LBitmap);
finally
FreeAndNil(LGifImg);
FreeAndNil(LBitmap);
end;
|