画像の透過合成
画像の合成でクロマキーによる画像合成を取り上げてありますが、Delphi2009以降には、画像合成の為のメソッドが用意されています。
その説明は此処で取り上げるよりも、Ｍｒ．ＸＲＡＹに詳しく説明が載っているのでそちらを参照してください。
単に、ビットマップからビットマップ゛にコピーする場合は、透過の値を追加するだけです。
透明にする色の指定、透明色以外の透過率の指定も出来ます。（クロマキー画像の作成はありません。）
左図は、此処でのプログラムの実行例で、画像合成の為のメソッドは使用していません。
背景画像、透過画像(前景)を開き、配置する位置、透過率を指定して、透過合成ボタンを実行すれば、合成画像が表示されます。
配置する位置は、画像の左上の位置を指定します。マイナスで指定すると、背景画像の左外、上外を指定することになりますが両方の画像が重なる部分があれば、その条件で正しく合成されます。
表示画像のサイズは、背景画像のサイズとなります。
背景画像、透過画像のサイズは自由です、又、透過実行時、両方の画像の重なる部分が無い場合は、メッセージを表示し、背景画像が表示されます。
プログラム
Delphi
2009以降には、半透明で画像を重ね合わせるメソッドがあるのですが、このプログラムでは、あえてそれを使用せず、画像を半透明で合成しています。
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, system.Types, Vcl.ExtDlgs, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
OpenPictureDialog1: TOpenPictureDialog;
Button2: TButton;
Button3: TButton;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
procedure FileOpen(InF : Boolean);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
BaseBM, DrawBM, NewPic: TBitmap;
InF : boolean;
inpf : byte;
const
// ファイル拡張子設定
OpenFileFilter =
'画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.ico;*.wdp'+
'|*.png|*.png' +
'|*.jpg|*.jpg' +
'|*.gif|*.gif' +
'|*.bmp|*.bmp' +
'|*.tif|*.tif' +
'|*.ico|*.ico' +
'|*.wdp|*.wdp';
//-------------------------------------------------
// composition_Bitmap 2枚のビットマップを合成します
// BaseBM 背景のビットマップ
// uperBM BaseBMの上の透過ビットマップ
// X, Y uperBMを描画するBaseBM上の座標
// Alpha uperBMの不透明度
//-------------------------------------------------
function composition_Bitmap(BackBM, UperBM: TBitmap; X, Y: integer; Alpha: Byte): TBitmap;
type
TRGBArray = array [0..0] of Trgbtriple;
PRGBArray =^TRGBArray;
var
PBase, PDraw: PRGBArray; // スキャンラインのキャッシュ用ポインタ
CutBase, CutDraw: TBitmap; // 編集用ビットマップ
Row, Col : integer; // 配列スキャン用
R1, G1, B1: DWord; // 透過ビットマップのRGB値 データーはByteだが演算用にDWord設定
R2, G2, B2: DWord; // 背景ビットマップのRGB値 データーはByteだが演算用にDWord設定
Rect1, Rect2: TRect; // 四角領域
Xi, Yi: integer; // 透過画像範囲先頭位置計算用
begin
Result := BackBM; // 戻り値背景画像
// 裏画像の四角形領域
Rect1 := Rect(0, 0, BackBM.Width, BackBM.Height);
// 透過画像の領域 画像範囲外あり
Rect2 := Rect(X, Y, UperBM.Width + X, UperBM.Height + Y);
// 裏画像の画像の重なる範囲計算 Rect1
if not IntersectRect(Rect1, Rect1, Rect2) then begin
ShowMessage('二つの画像が重なる部分がありません');
Exit;
end;
// NewPic0にBackBMビットマップイメージコピー
NewPic.Assign(BackBM);
// 透過画像の重なる範囲計算 Rect2
Xi := -X; // 左範囲外符号反転
if X >= 0 then Xi := 0; // Xがプラスの場合左側0
Yi := -Y; // 上範囲外符号反転
if Y >= 0 then Yi := 0; // Yがプラスの場合上側0
Rect2 := Rect(Xi, Yi, Rect1.Right - X, Rect1.Bottom - Y);
// 編集用ビットマップ生成
CutBase := TBitmap.Create;
CutDraw := TBitmap.Create;
// 画像の合成
try
CutBase.Width := Rect1.Right - Rect1.Left; // 画像の重なる部分の裏画像幅
CutBase.Height := Rect1.Bottom - Rect1.top; // 画像の重なる部分の裏画像高さ
CutBase.PixelFormat := pf24bit;
CutDraw.Width := Rect1.Right - Rect1.Left; // 画像の重なる部分の透過画像幅
CutDraw.Height := Rect1.Bottom - Rect1.top; // 画像の重なる部分の透過画像高さ
CutDraw.PixelFormat := pf24bit;
// 背景画像から重なる部分の画像コピー
CutBase.Canvas.CopyRect(Rect(0, 0, CutBase.Width, CutBase.Height), Newpic.Canvas, Rect1);
// 透過画像から重なる部分の画コピー
CutDraw.Canvas.CopyRect(Rect(0, 0, CutDraw.Width, CutDraw.Height), UperBM.Canvas, Rect2);
// 重なる部分の透過画像作成
for Col :=0 to CutBase.Height -1 do begin
PBase := CutBase.ScanLine[Col];
PDraw := CutDraw.ScanLine[Col];
for Row :=0 to CutBase.Width -1 do begin
// 背景
R2 := PBase[Row].rgbtRed;
G2 := PBase[Row].rgbtGreen;
B2 := PBase[Row].rgbtBlue;
// 前景
R1 := PDraw[Row].rgbtRed;
G1 := PDraw[Row].rgbtGreen;
B1 := PDraw[Row].rgbtBlue;
// 合成演算
PBase[Row].rgbtRed := byte((R1 - R2) * Alpha div 255 + R2);
PBase[Row].rgbtGreen := byte((G1 - G2) * Alpha div 255 + G2);
PBase[Row].rgbtBlue := byte((B1 - B2) * Alpha div 255 + B2);
end;
end;
// 重なる部分の画像を裏画像にコピー
NewPic.Canvas.CopyRect(Rect1, CutBase.Canvas, rect(0, 0,CutBase.Width, CutBase.Height));
Result := NewPic; // 戻り値合成画像
finally
// 編集用ビットマップの解放
CutBase.Free;
CutDraw.Free;
end;
end;
procedure TForm1.FileOpen(InF : Boolean);
var
WIC : TWICImage;
begin
OpenPictureDialog1.Filter := OpenFileFilter; // ファイルオープンフィルターの設定
if OpenPictureDialog1.Execute then // ファイルが指定されたら
begin
WIC := TWICImage.Create; // TWICImageの生成
try
WIC.LoadFromFile(OpenPictureDialog1.FileName);// 画像の読み込み
// 透過画像読み込み
if InF then begin
DrawBM.Width := WIC.Width; // 画像幅
DrawBM.Height := WIC.Height; // 画像高さ
DrawBM.Canvas.Draw(0, 0, WIC); // DrawでInBitmapに入力画像設定フォーマット24ビットに変換されます
inpf := inpf or 1; // 透過画像読み込み済み設定
end
// 背景画像読み込み
else Begin
BaseBM.Width := WIC.Width; // 画像幅
BaseBM.Height := WIC.Height; // 画像高さ
BaseBM.Canvas.Draw(0, 0, WIC); // DrawでInBitmapに入力画像設定フォーマット24ビットに変換されます
image1.Width := WIC.Width; // 描画Image枠設定
image1.Height := WIC.Height; // 背景画像読み込み済み設定
inpf := inpf or 2;
end;
finally
WIC.Free; // TWICImage 解放
end;
end;
if inpf and 3 = 3 then Button1.Enabled := true; // 裏画像と透過画像が読み込まれたら合成ボタンイネーブル
end;
procedure TForm1.Button1Click(Sender: TObject);
var
X, Y, A, Ch: integer;
begin
val(LabeledEdit1.Text, X, Ch);
if ch <> 0 then begin
application.MessageBox('横位置の値に間違いがあります。','入力ミス', 0);
exit;
end;
val(LabeledEdit2.Text, Y, Ch);
if ch <> 0 then begin
application.MessageBox('縦位置の値に間違いがあります。','入力ミス', 0);
exit;
end;
val(LabeledEdit3.Text, A, Ch);
if ch <> 0 then begin
application.MessageBox('透過率の値に間違いがあります。','入力ミス', 0);
exit;
end;
if (A < 0) or (A > 255) then begin
application.MessageBox('透過率が値が範囲外です。','入力ミス', 0);
exit;
end;
// 画像の合成
Image1.Canvas.Draw(0, 0, composition_Bitmap(BaseBM, DrawBM, X, Y, A));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
InF := False; // 背景画像読み込みフラグ
FileOpen(InF);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
InF := True;; // 透過画像読み込みプラグ
FileOpen(InF);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// ビットマップの解放
BaseBM.Free;
DrawBM.Free;
NewPic.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// ビットマップの生成
NewPic := TBitmap.Create;
BaseBM :=TBitmap.Create;
DrawBM :=TBitmap.Create;
BaseBM.PixelFormat := pf24bit;
DrawBM.PixelFormat := pf24bit;
// 画像読み込みフラグクリア グローバル変数なので無くても可
inpf := 0;
end;
end.
ここでは、Delphi2009以降で使用できる様になった拡張Drawメソッドで、Canvasへの描画時、透過Alphaの指定をして TBitmap.Canvas.Draw(0, 0,
TBitmap, Alpha);半透明の合成画像を作成しています。
Alphaの値が０で透明、２５５で不透明、その間の値が半透明です。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, system.Types, Vcl.ExtDlgs, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
OpenPictureDialog1: TOpenPictureDialog;
Button2: TButton;
Button3: TButton;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
procedure FileOpen(InF : Boolean);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TRGBArray = array [0..0] of Trgbtriple;
PRGBArray =^TRGBArray;
var
BaseBM, DrawBM: TBitmap;
InF : boolean;
inpf : byte;
const
// ファイル拡張子設定
OpenFileFilter =
'画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.ico;*.wdp'+
'|*.png|*.png' +
'|*.jpg|*.jpg' +
'|*.gif|*.gif' +
'|*.bmp|*.bmp' +
'|*.tif|*.tif' +
'|*.ico|*.ico' +
'|*.wdp|*.wdp';
//-------------------------------------------------
// composition_Bitmap 2枚のビットマップを合成します
// X, Y uperBMを描画するBaseBM上の座標
// Alpha uperBMの不透明度
//-------------------------------------------------
procedure composition_Bitmap(NewPic0 ,BackBM, UperBM: TBitmap; X, Y: integer; Alpha: Byte);
var
CutBase, CutDraw: TBitmap; // 編集用ビットマップ
Rect1, Rect2: TRect; // 四角領域
Xi, Yi: integer; // 透過画像範囲先頭位置計算用
begin
NewPic0.Assign(BackBM);
// 裏画像の四角形領域
Rect1 := Rect(0, 0, BackBM.Width, BackBM.Height);
// 透過画像の領域 画像範囲外あり
Rect2 := Rect(X, Y, UperBM.Width + X, UperBM.Height + Y);
// 裏画像の画像の重なる範囲計算 Rect1
if not IntersectRect(Rect1, Rect1, Rect2) then begin
ShowMessage('二つの画像が重なる部分がありません');
Exit;
end;
// 透過画像の重なる範囲計算 Rect2
Xi := -X; // 左範囲外符号反転
if X >= 0 then Xi := 0; // Xがプラスの場合左側0
Yi := -Y; // 上範囲外符号反転
if Y >= 0 then Yi := 0; // Yがプラスの場合上側0
Rect2 := Rect(Xi, Yi, Rect1.Right - X, Rect1.Bottom - Y);
// 編集用ビットマップ生成
CutBase := TBitmap.Create;
CutDraw := TBitmap.Create;
// 画像の合成
try
CutBase.Width := Rect1.Right - Rect1.Left; // 画像の重なる部分の背景画像幅
CutBase.Height := Rect1.Bottom - Rect1.top; // 画像の重なる部分の背景像高さ
CutBase.PixelFormat := pf24bit;
CutDraw.Width := Rect1.Right - Rect1.Left; // 画像の重なる部分の透過画像幅
CutDraw.Height := Rect1.Bottom - Rect1.top; // 画像の重なる部分の透過画像高さ
CutDraw.PixelFormat := pf24bit;
// 背景画像から重なる部分の画像コピー
CutBase.Canvas.CopyRect(Rect(0, 0, CutBase.Width, CutBase.Height), Newpic0.Canvas, Rect1);
// 透過画像から重なる部分の画コピー
CutDraw.Canvas.CopyRect(Rect(0, 0, CutDraw.Width, CutDraw.Height), UperBM.Canvas, Rect2);
// 重なる部分の透過画像作成 Alphaは、透過の値 透過0～255不透過 Delphi2009以降
CutBase.Canvas.Draw(0, 0, CutDraw, Alpha);
NewPic0.Canvas.CopyRect(Rect1, CutBase.Canvas, rect(0, 0, CutBase.Width, CutBase.Height));
finally
// 編集用ビットマップの解放
CutBase.Free;
CutDraw.Free;
end;
end;
procedure TForm1.FileOpen(InF : Boolean);
var
WIC : TWICImage;
begin
OpenPictureDialog1.Filter := OpenFileFilter; // ファイルオープンフィルターの設定
if OpenPictureDialog1.Execute then // ファイルが指定されたら
begin
WIC := TWICImage.Create; // TWICImageの生成
try
WIC.LoadFromFile(OpenPictureDialog1.FileName);// 画像の読み込み
// 透過画像読み込み
if InF then begin
DrawBM.Width := WIC.Width; // 画像幅
DrawBM.Height := WIC.Height; // 画像高さ
DrawBM.Canvas.Draw(0, 0, WIC); // DrawでInBitmapに入力画像設定フォーマット24ビットに変換されます
inpf := inpf or 1; // 透過画像読み込み済み設定
end
// 背景画像読み込み
else Begin
BaseBM.Width := WIC.Width; // 画像幅
BaseBM.Height := WIC.Height; // 画像高さ
BaseBM.Canvas.Draw(0, 0, WIC); // DrawでInBitmapに入力画像設定フォーマット24ビットに変換されます
image1.Width := WIC.Width; // 描画Image枠設定
image1.Height := WIC.Height; // 背景画像読み込み済み設定
inpf := inpf or 2;
end;
finally
WIC.Free; // TWICImage 解放
end;
end;
if inpf and 3 = 3 then Button1.Enabled := true; // 裏画像と透過画像が読み込まれたら合成ボタンイネーブル
end;
procedure TForm1.Button1Click(Sender: TObject);
var
X, Y, A, Ch: integer;
NewPic: TBitmap;
begin
val(LabeledEdit1.Text, X, Ch);
if ch <> 0 then begin
application.MessageBox('横位置の値に間違いがあります。','入力ミス', 0);
exit;
end;
val(LabeledEdit2.Text, Y, Ch);
if ch <> 0 then begin
application.MessageBox('縦位置の値に間違いがあります。','入力ミス', 0);
exit;
end;
val(LabeledEdit3.Text, A, Ch);
if ch <> 0 then begin
application.MessageBox('透過率の値に間違いがあります。','入力ミス', 0);
exit;
end;
if (A < 0) or (A > 255) then begin
application.MessageBox('透過率が値が範囲外です。','入力ミス', 0);
exit;
end;
// 画像の合成
NewPic := TBitmap.Create;
try
composition_Bitmap(NewPic, BaseBM, DrawBM, X, Y, A);
Image1.Canvas.Draw(0, 0, NewPic);
finally
NewPic.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
InF := False; // 背景画像読み込みフラグ
FileOpen(InF);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
InF := True;; // 透過画像読み込みプラグ
FileOpen(InF);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// ビットマップの解放
BaseBM.Free;
DrawBM.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// ビットマップの生成
BaseBM :=TBitmap.Create;
DrawBM :=TBitmap.Create;
BaseBM.PixelFormat := pf24bit;
DrawBM.PixelFormat := pf24bit;
// 画像読み込みフラグクリア グローバル変数なので無くても可
inpf := 0;
end;
end.
次の例は、delphi2009以降で使用可能な、TBitmapのAlphaFormatを使用して、透過、半透過、不透過を行う場合です。
ビットマップを３２ビットフォーマットとして、Reservedバイトに、透過０～２５５不透過の値をいれて、透過処理を行います。
１ピクセル単位毎に指定可能なので、クロマキーの値をReservedバイトに書き込めば、簡単に半透明画像の合成が出来ます。
次の例では、前景画像の左下の色(黒)を透過色とし、それ以外の色は、指定した透過率で画像の合成を行っています。
合成に先立って、画像の合成でクロマキーの使用により、バックがが単色(黒)の前景画像を用意しています。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, system.Types, Vcl.ExtDlgs, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
OpenPictureDialog1: TOpenPictureDialog;
Button2: TButton;
Button3: TButton;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
LabeledEdit3: TLabeledEdit;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
procedure FileOpen(InF : Boolean);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
BaseBM, DrawBM: TBitmap;
InF : boolean;
inpf : byte;
const
// ファイル拡張子設定
OpenFileFilter =
'画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.ico;*.wdp'+
'|*.png|*.png' +
'|*.jpg|*.jpg' +
'|*.gif|*.gif' +
'|*.bmp|*.bmp' +
'|*.tif|*.tif' +
'|*.ico|*.ico' +
'|*.wdp|*.wdp';
//-----------------------------------------------------------------------------
// ビットマップの指定の色のアルファ値を0(透明色)にする関数
// ABitmap : 処理対象のビットマップ．処理したビットマップを返します
// TransColor : 透明にする色
// Alpha : 透明にする色以外の透過率
//-----------------------------------------------------------------------------
procedure TransparentColorToAlpha(ABitmap: TBitmap; TransColor: TColor; Alpha: Byte);
type
TRGBQArray = array [0..0] of RGBQUAD;
PRGBQArray = ^TRGBQArray;
var
R,G,B : Byte;
X, Y : Integer;
SA : PRGBQArray;
begin
ABitmap.Canvas.Lock; // 他のスレッドから使用できないようにします
ABitmap.AlphaFormat := afIgnored; // 予約済みバイトは無視されます
//指定色のR,G,Bの各値の取得
R := GetRValue(TransColor);
G := GetGValue(TransColor);
B := GetBValue(TransColor);
// 透明にする色透過100パーセント それ以外は Alpha値によります
for Y := 0 to ABitmap.Height - 1 do begin
SA := ABitmap.ScanLine[Y];
for X := 0 to ABitmap.Width - 1 do begin
if (R = SA[X].rgbRed) and (G = SA[X].rgbGreen) and (B = SA[X].rgbBlue) then
SA[X].rgbReserved := 0 // 透過率100パーセント
else
SA[X].rgbReserved := Alpha; // Alpha 0～255 透過率100～0
end;
end;
ABitmap.Canvas.Unlock; // 他のスレッドから使用解除
end;
//-------------------------------------------------
// composition_Bitmap 2枚のビットマップを合成します
// X, Y uperBMを描画するBaseBM上の座標
// Alpha uperBMの不透明度
//-------------------------------------------------
procedure composition_Bitmap(NewPic0, BackBM, UperBM: TBitmap; X, Y: integer; Alpha: Byte);
var
CutBase, CutDraw: TBitmap; // 編集用ビットマップ
Rect1, Rect2: TRect; // 四角領域
Xi, Yi: integer; // 透過画像範囲先頭位置計算用
AColor : TColor;
begin
NewPic0.Assign(BackBM);
// 裏画像の四角形領域
Rect1 := Rect(0, 0, BackBM.Width, BackBM.Height);
// 透過画像の領域 画像範囲外あり
Rect2 := Rect(X, Y, UperBM.Width + X, UperBM.Height + Y);
// 裏画像の画像の重なる範囲計算 Rect1
if not IntersectRect(Rect1, Rect1, Rect2) then begin
ShowMessage('二つの画像が重なる部分がありません');
Exit;
end;
// NewPic0にBackBMビットマップイメージコピー
// 透過画像の重なる範囲計算 Rect2
Xi := -X; // 左範囲外符号反転
if X >= 0 then Xi := 0; // Xがプラスの場合左側0
Yi := -Y; // 上範囲外符号反転
if Y >= 0 then Yi := 0; // Yがプラスの場合上側0
Rect2 := Rect(Xi, Yi, Rect1.Right - X, Rect1.Bottom - Y);
// 編集用ビットマップ生成
CutBase := TBitmap.Create;
CutDraw := TBitmap.Create;
// 画像の合成
try
CutBase.Width := Rect1.Right - Rect1.Left; // 画像の重なる部分の背景画像幅
CutBase.Height := Rect1.Bottom - Rect1.top; // 画像の重なる部分の背景像高さ
CutBase.PixelFormat := pf32bit;
CutDraw.Width := Rect1.Right - Rect1.Left; // 画像の重なる部分の透過画像幅
CutDraw.Height := Rect1.Bottom - Rect1.top; // 画像の重なる部分の透過画像高さ
CutDraw.PixelFormat := pf32bit;
// 左下のピクセルの色を透明色とする
AColor := GetPixel(UperBM.Canvas.Handle, 0, UperBM.Height - 1);
// 背景画像から重なる部分の画像コピー
CutBase.Canvas.CopyRect(Rect(0, 0, CutBase.Width, CutBase.Height), Newpic0.Canvas, Rect1);
// 透過画像から重なる部分の画コピー
CutDraw.Canvas.CopyRect(Rect(0, 0, CutDraw.Width, CutDraw.Height), UperBM.Canvas, Rect2);
// 重なる部分の透過画像作成 Alphaは、透過の値 透過0～255不透過 Delphi2009以降
TransparentColorToAlpha(CutDraw, AColor, Alpha);
CutDraw.AlphaFormat := afDefined; // 予約バイトのアルファ値を有効にします
// 画像の重ね合わせ
CutBase.Canvas.Draw(0, 0, CutDraw);
// 画僧の重なる部分を元画像の元の部分にコピー
NewPic0.Canvas.CopyRect(Rect1, CutBase.Canvas, rect(0, 0,CutBase.Width, CutBase.Height));
finally
// 編集用ビットマップの解放
CutBase.Free;
CutDraw.Free;
end;
end;
procedure TForm1.FileOpen(InF : Boolean);
var
WIC : TWICImage;
begin
OpenPictureDialog1.Filter := OpenFileFilter; // ファイルオープンフィルターの設定
if OpenPictureDialog1.Execute then // ファイルが指定されたら
begin
WIC := TWICImage.Create; // TWICImageの生成
try
WIC.LoadFromFile(OpenPictureDialog1.FileName);// 画像の読み込み
// 透過画像読み込み
if InF then begin
DrawBM.Width := WIC.Width; // 画像幅
DrawBM.Height := WIC.Height; // 画像高さ
DrawBM.Canvas.Draw(0, 0, WIC); // DrawでInBitmapに入力画像設定フォーマット24ビットに変換されます
inpf := inpf or 1; // 透過画像読み込み済み設定
end
// 背景画像読み込み
else Begin
BaseBM.Width := WIC.Width; // 画像幅
BaseBM.Height := WIC.Height; // 画像高さ
BaseBM.Canvas.Draw(0, 0, WIC); // DrawでInBitmapに入力画像設定フォーマット24ビットに変換されます
image1.Width := WIC.Width; // 描画Image枠設定
image1.Height := WIC.Height; // 背景画像読み込み済み設定
inpf := inpf or 2;
end;
finally
WIC.Free; // TWICImage 解放
end;
end;
if inpf and 3 = 3 then Button1.Enabled := true; // 裏画像と透過画像が読み込まれたら合成ボタンイネーブル
end;
procedure TForm1.Button1Click(Sender: TObject);
var
X, Y, A, Ch: integer;
NewPic: TBitmap;
begin
val(LabeledEdit1.Text, X, Ch);
if ch <> 0 then begin
application.MessageBox('横位置の値に間違いがあります。','入力ミス', 0);
exit;
end;
val(LabeledEdit2.Text, Y, Ch);
if ch <> 0 then begin
application.MessageBox('縦位置の値に間違いがあります。','入力ミス', 0);
exit;
end;
val(LabeledEdit3.Text, A, Ch);
if ch <> 0 then begin
application.MessageBox('透過率の値に間違いがあります。','入力ミス', 0);
exit;
end;
if (A < 0) or (A > 255) then begin
application.MessageBox('透過率が値が範囲外です。','入力ミス', 0);
exit;
end;
// 画像の合成
Newpic := TBitmap.Create;
try
composition_Bitmap(Newpic, BaseBM, DrawBM, X, Y, A);
Image1.Canvas.Draw(0, 0, NewPic);
finally
NewPic.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
InF := False; // 背景画像読み込みフラグ
FileOpen(InF);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
InF := True;; // 透過画像読み込みプラグ
FileOpen(InF);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
// ビットマップの解放
BaseBM.Free;
DrawBM.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// ビットマップの生成
BaseBM :=TBitmap.Create;
DrawBM :=TBitmap.Create;
BaseBM.PixelFormat := pf32bit;
DrawBM.PixelFormat := pf32bit;
// 画像読み込みフラグクリア グローバル変数なので無くても可
inpf := 0;
end;
end.
透明なフォームと背景透過画像
画像のバック色をフォームの透過色と同じ色とすることで、簡単に画像のバック色を透明にして、ＤeｓｋＴｏｐの画像が透けて見えるようにできます。
// ---------------------------------------------- // FormにTimageコンポーネントを一つ貼り付けます。 // Image1に背景が黒の画像を読み込んでおきます。 //---------------------------------------------- procedure TForm1.FormCreate(Sender: TObject); begin Self.TransparentColorValue := clblack; Self.TransparentColor := True; Self.Color := clblack; Image1.Align := alClient; Image1.Stretch := True; end;
半透明合成.zip