色指定による画像の抽出
画像の中から、色を指定して、その色の画像を抜き出します。
画像の合成の場合は、クロマキーを作成するため、透過色として色を指定していましたが、此処では、画像の抽出の為、色を指定します。
クロマキーを作成する為の方法が全て利用可能ですが、Delphiに標準で用意されている、RGBtoHSL 変換を利用する方法が一番簡単です。
上図一番左が元画像で、その次が、紫の花だけを指定した場合、次が、緑系だけを指定した場合、更に次の二つは、指定した色を消去した場合です。
バック黒は、クロマキーと同じです。
此処の、元画像はクロマキー用に用意したもので、色相により、画像の分解が容易に出来るような画像になっていますが、実際の写真画像では、綺麗に抜き出す事は難しく、抜き出した画像から、更に不要な部分を消去する作業が必要です。
プログラムは、開いたファイルの画像と、抽出された画像の二つを表示するようになっています。
元画像にマウスカーソルを持っていくと、その部分の色相が色情報として表示されます。
抜き出したい色の上に、マウスカーソルを移動し、ダブルクリックすると、抽出色指定の色相の欄に、マウスカーソルで指定した場所の色相の値が表示されます。
同じ色でも、色相にはバラツキがあるので、色相の範囲を指定します。
必要に応じて、彩度、輝度の下限値の指定をします。
色相は、０～３６０ですが、彩度、輝度は０～1の範囲です。
抽出反転にチェックを入れると、指定した色のみ、消去します。
黒塗りにチェックを入れると、消去を白塗りから、黒塗りに変更されます。
色相の判定
色相を指定して、画像を抜き出す場合、色相は０～360°のリング環として表わされるので、色相によって判定方法に注意が必要です。
左図、黄色の場合は色相の下限値に対して、上限値が大きくなりますが、青色の場合は、下限値に対して、上限値の方が値が小さくなってしまいます。
下限値より上限値が大きい場合は、
(下限値 ≦ 値) and (値 ≦ 上限値) で判定し
下限値より上限値が小さい場合は
(上限値 ≦ 値) or (値 ≦ 下限値) で判定します。
RGBtoHSL
変換の場合は、青が０°となりまずが、RGBtoHSV 変換の場合は、赤が０°となります。
色相は単に、０°の位置がズレるだけですが、輝度に関しては、少し意味合いが変わってくるので注意が必要です。
プログラム
unit ExtractionMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtDlgs, Vcl.StdCtrls, Vcl.ExtCtrls, system.Math,
system.UITypes, Vcl.Grids, System.UIConsts;
type
D2array = array of array of Double;
TForm1 = class(TForm)
FileOpenBtn: TButton;
OpenPictureDialog1: TOpenPictureDialog;
ExtractBtn: TButton;
FileSaveBtn: TButton;
SavePictureDialog1: TSavePictureDialog;
Timer1: TTimer;
ScrollBox1: TScrollBox;
Image1: TImage;
ScrollBox2: TScrollBox;
Image2: TImage;
GroupBox1: TGroupBox;
PointXEdit: TLabeledEdit;
PointYEdit: TLabeledEdit;
HueEdit: TLabeledEdit;
GroupBox2: TGroupBox;
ExtHueEdit: TLabeledEdit;
RangeEdit: TLabeledEdit;
CheckBox1: TCheckBox;
LightEdit: TLabeledEdit;
SatEdit: TLabeledEdit;
CheckBox2: TCheckBox;
procedure FileOpenBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ExtractBtnClick(Sender: TObject);
procedure FileSaveBtnClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1DblClick(Sender: TObject);
private
{ Private 宣言 }
procedure Imageout(Image: TBitmap; ImageNo: integer; magnification: double);
procedure Extraction;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TAlphaarry = array[0..0] of TAlphaColor; // TAlphaColor配列Cadinal
PAlphaarray = ^TAlphaarry; // 配列のポインター
const
OpenFileFilter =
'画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.ico;*.wdp'+
'|*.png|*.png' +
'|*.jpg|*.jpg' +
'|*.gif|*.gif' +
'|*.bmp|*.bmp' +
'|*.tif|*.tif' +
'|*.ico|*.ico' +
'|*.wdp|*.wdp';
SaveFileFilter =
'画像ファイル|*.png;*.jpg;*.gif;*.bmp;*.tif;*.wdp' +
'|*.png|*.png' +
'|*.jpg|*.jpg' +
'|*.gif|*.gif' +
'|*.bmp|*.bmp' +
'|*.tif|*.tif' +
'|*.wdp|*.wdp';
ImageHWC = 440; // 表示枠サイズ
Laplacian = 0;
Gaussians = 1;
Deconvolution = 2;
Unsharp = 3;
var
InputDBitmap : TBitmap; // 入力データー表示用ビットマップ
OutputBitmap : TBitmap; // 回転画像表示用ビットマップ
GHeight : Integer; // 入力データー画像高さ
GWidth : Integer; // 入力データー画像幅
VRect : Trect; // 表示サイズ設定用
InFilename : string; // 入力ファイル名
HueMat : D2array;
SatMat : D2array;
LitMat : D2array;
Xpos, Ypos : Integer;
// 指定画像部の色相取り出し抽出用データーにセット
procedure TForm1.Image1DblClick(Sender: TObject);
begin
ExtHueEdit.Text := FloatTostrF(HueMat[Ypos, Xpos], ffFixed, 4, 1);
end;
// マウスの位置の色相データー表示
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Xpos := X;
Ypos := Y;
PointXEdit.Text := intTostr(Xpos);
PointYEdit.Text := intTostr(Ypos);
HueEdit.Text := FloatTostrF(HueMat[Ypos, Xpos], ffFixed, 4, 1);
end;
//------------------------
// 変倍出力
//------------------------
procedure TForm1.Imageout(Image: TBitmap; ImageNo: integer; magnification: double);
var
Rect0 : Trect;
MW, MH : Integer;
begin
MW := Round(GWidth * magnification);
MH := Round(GHeight * magnification);
Rect0 := Rect(0, 0, MW, MH);
if ImageNo = 1 then begin
Image1.Width := MW;
Image1.Height := MH;
Image1.Picture.Bitmap.SetSize(MW, MH);
Image1.Canvas.StretchDraw(Rect0, Image); // 出力枠に変倍出力
end;
if ImageNo = 2 then begin
Image2.Width := MW;
Image2.Height := MH;
Image2.Picture.Bitmap.SetSize(MW, MH);
Image2.Canvas.StretchDraw(Rect0, Image); // 出力枠に変倍出力
end;
end;
//--------------------------------------
// フィルター計算タイマー遅延
// ボタンの表示切り替えVCL実行の時間待ち
//--------------------------------------
procedure TForm1.ExtractBtnClick(Sender: TObject);
begin
FileOpenBtn.Enabled := False;
FileSaveBtn.Enabled := False;
Timer1.Enabled := True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
Extraction;
FileSaveBtn.Enabled := True;
FileOpenBtn.Enabled := True;
end;
//-------------------------------------
// Color Extraction
// 指定色の取り出し
//-------------------------------------
procedure TForm1.Extraction;
const
Wp = 4;
var
Hsl, HSLHi, HSLLo : double;
Hsd : double;
X, Y : integer;
Inp : PAlphaarray;
Oup : PAlphaarray;
Hue : Double;
Huef : Boolean;
CAlpha : TAlphaColor;
SatTH : double;
LitTH : double;
begin
val(ExtHueEdit.Text, Hsl, X);
if X <> 0 then begin
Application.MessageBox('色相角度の入力値に誤りがあります。','色相',0);
exit;
end;
if (Hsl < 0) or (Hsl > 360) then begin
Application.MessageBox('色相角度の範囲は０≦色相≦３６０です。','色相',0);
exit;
end;
val(RangeEdit.Text, Hsd, X);
if X <> 0 then begin
Application.MessageBox('色相範囲の入力値に誤りがあります。','範囲',0);
exit;
end;
if (Hsd < 0) or (Hsd > 180) then begin
Application.MessageBox('範囲角度の範囲は０≦範囲≦１８０です。','範囲',0);
exit;
end;
val(SatEdit.Text, SatTH, X);
if X <> 0 then begin
Application.MessageBox('彩度の入力値に誤りがあります。','彩度',0);
exit;
end;
if (SatTH < 0) or (SatTH > 1) then begin
Application.MessageBox('彩度閾値の範囲は０≦閾値≦１です。','彩度',0);
exit;
end;
val(LightEdit.Text, LitTH, X);
if X <> 0 then begin
Application.MessageBox('輝度閾値の入力値に誤りがあります。','輝度',0);
exit;
end;
if (LitTH < 0) or (LitTH > 1) then begin
Application.MessageBox('輝度閾値の範囲は０≦閾値≦１です。','輝度',0);
exit;
end;
// 指定された色相、彩度、輝度により画像の抽出
HSLHi := Hsl + Hsd; // 色相上限
if HSLHi > 360 then HSLHi := HSLHi - 360;
HSLLo := Hsl - Hsd; // 色相下限
if HSLLo < 0 then HSLLo := HSLLo + 360;
for Y := 0 to Gheight - 1 do begin
Inp := InputDBitmap.ScanLine[Y];
Oup := OutputBitmap.ScanLine[Y];
for X := 0 to GWidth - 1 do begin
Huef := False;
Hue := HueMat[Y, X];
// 色相が指定された範囲に入っているか確認フラグセット
if HSLHi >= HSLLo then begin
if (Hue <= HSLHi) and (Hue >= HSLLo) then Huef := True;
end
else begin
if (Hue < HSLHi) or (Hue > HSLLo) then Huef := True;
end;
// 彩度確認
if SatTH > SatMat[Y, X] then Huef := False;
// 輝度確認
if LitTH > LitMat[Y, X] then Huef := False;
// 抜き出すので無ければ符号斑点
if CheckBox1.Checked then Huef := not Huef;
// True であれば指定部画像データー取り出し
if Huef then CAlpha := inp[X]
else begin
// 指定部以外を白にするか黒にするかセット
if CheckBox2.Checked then CAlpha := $00000000
else CAlpha := $00FFFFFF;
end;
// 出力用イメージに書き込み
Oup[X] := CAlpha;
end;
end;
Imageout(OutputBitmap, 2, 1); // 出力枠に変倍出力
end;
//---------------------------------------------------
// ファイルのオープンと色相データー変換
//---------------------------------------------------
procedure TForm1.FileOpenBtnClick(Sender: TObject);
var
WIC : TWICImage;
X, Y : Integer;
PBA : PAlphaarray;
CAlpha : TAlphaColor;
hf, Sf, Lf : single;
begin
VRect := Rect(0, 0, Image1.Width, Image1.Height);
Image1.Canvas.Brush.Style := bsSolid;
Image1.Canvas.Brush.Color := clBtnface;
Image1.Canvas.FillRect(VRect); // Canvas 画像消去
OpenPictureDialog1.Filter := OpenFileFilter; // ファイルオープンフィルターの設定
if OpenPictureDialog1.Execute = true then // ファイルが指定されたら
begin
WIC := TWICImage.Create; // TWICImageの生成
try
InFilename := OpenPictureDialog1.FileName; // ファイル名の取得
WIC.LoadFromFile(InFilename); // 画像の読み込み
GHeight := WIC.Height; // 画像高さ取得
GWidth := WIC.Width; // 画像幅
Image1.Width := GWidth;
Image1.Height:= GHeight;
Image1.Picture.Bitmap.SetSize(GWidth, GHeight);
InputDBitmap.Width := GWidth;
InputDBitmap.Height := GHeight;
InputDBitmap.Canvas.Draw(0, 0, WIC); // ビットマップに描画フォーマット変換
Image2.Picture.Bitmap.SetSize(GWidth, GHeight);
finally
WIC.Free; // TWICImage 解放
end;
end
else exit;
OutputBitmap.Width := GWidth;
OutputBitmap.Height := GHeight;
// 色相、彩度、輝度の配列確保
setLength(HueMat, GHeight, GWidth);
setLength(SatMat, GHeight, GWidth);
setLength(LitMat, GHeight, GWidth);
// RGB to HSL 変換
for Y := 0 to Gheight - 1 do begin
PBA := InputDBitmap.ScanLine[Y];
for X := 0 to GWidth - 1 do begin
CAlpha := PBA[X]; // TAlphaColorの取得
RGBtoHSL(CAlpha, Hf, Sf, lf); // HSL 変換
HueMat[Y, X] := Hf * 360;
SatMat[Y, X] := Sf;
LitMat[Y, X] := lf;
end;
end;
Imageout(InputDBitmap, 1, 1); // 出力枠に変倍出力
ExtractBtn.Enabled := True;
end;
//------------------------------
// 画像のファイルへの保存
//------------------------------
procedure TForm1.FileSaveBtnClick(Sender: TObject);
var
WIC : TWicImage;
WICF : TWicImageFormat;
Fname : String;
ExeStr : String;
FnameTop: String;
Findex : integer;
function WFormatSet: Boolean; // 拡張子によるファイルフォーマット設定
begin
Result := false;
ExeStr := LowerCase(ExeStr);
if ExeStr = '.jpg' then begin WICF := Wifjpeg; Result := True; end;
if ExeStr = '.jpeg' then begin WICF := Wifjpeg; Result := True; end;
if ExeStr = '.tif' then begin WICF := Wiftiff; Result := True; end;
if ExeStr = '.tiff' then begin WICF := Wiftiff; Result := True; end;
if ExeStr = '.png' then begin WICF := Wifpng; Result := True; end;
if ExeStr = '.gif' then begin WICF := Wifgif; Result := True; end;
if ExeStr = '.bmp' then begin WICF := Wifbmp; Result := True; end;
if ExeStr = '.wdp' then begin WICF := WifWMPhoto; Result := True; end;
if ExeStr = '.hdp' then begin WICF := WifWMPhoto; Result := True; end;
end;
begin
SavePictureDialog1.Filter := SaveFileFilter;
// SavePictureDialog1.DefaultExt := GraphicExtension(TWicImage);
if not SavePictureDialog1.Execute then exit;
ExeStr := ExtractFileExt(SavePictureDialog1.FileName);
if ExeStr = '' then begin // 拡張子がなかったら
Findex := SavePictureDialog1.FilterIndex; // FilterIndexによる拡張子の設定
case Findex of
1, 3 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.jpg'); // 拡張子の設定
2 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.png'); // 拡張子の設定
4 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.gif'); // 拡張子の設定
5 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.bmp'); // 拡張子の設定
6 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.tif'); // 拡張子の設定
7 : Fname := ChangeFileExt(SavePictureDialog1.FileName,'.wdp'); // 拡張子の設定
end;
end
else
Fname := SavePictureDialog1.FileName;
ExeStr := ExtractFileExt(Fname); // 拡張子だけ取り出し
if not WFormatSet then begin // 拡張子によるファイルフォーマット設定と確認
application.MessageBox('ファイルの拡張子が間違っています。','注意', 0);
exit;
end;
FnameTop := ExtractFileName(Fname); // ファイル名だけ取り出し
if Length(FnameTop) = Length(ExeStr) then begin // ファイル名の長さ確認
application.MessageBox('ファイル名がありません。','注意', 0);
exit;
end;
if FileExists(Fname) then // ファイル名によるファイル検索
if MessageDlg('既に同じ名前のファイルがあります上書きしますか ' + ExtractFileName(Fname) + '?',
mtConfirmation, [mbYes, mbNo], 0, mbNo) = IDNo then exit;
WIC := TWicImage.Create; // TWicImage生成
try
WIC.Assign(OutputBitmap); // TWicImageにビットマップデーター割り付け
WIC.ImageFormat := WICF; // 保存フォーマットセット
WIC.SaveTofile(Fname); // ファイルの書き出し
finally
WIC.Free; // TWicImage解放
end;
end;
//----------------
// 初期設定
//----------------
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled := False;
Image1.Width := ImageHWC div 2;
Image1.Height := ImageHWC div 2;
ScrollBox1.Height := ImageHWC;
ScrollBox1.Width := ImageHWC;
Image1.Top := 0;
Image1.Left := 0;
Image2.Width := ImageHWC div 2;
Image2.Height := ImageHWC div 2;
ScrollBox2.Height := ImageHWC;
ScrollBox2.Width := ImageHWC;
Image2.Top := 0;
Image2.Left := 0;
InputDBitmap := TBitmap.Create;
OutputBitmap := TBitmap.Create;
InputDBitmap.PixelFormat := pf32bit;
OutputBitmap.PixelFormat := pf32bit;
ExtractBtn.Enabled := False;
FileSaveBtn.Enabled := False;
end;
//----------------
// 終了処理
//----------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
InputDBitmap.Free;
OutputBitmap.Free;
end;
end.
ColorExtraction.zip
画像処理一覧へ戻る
最初に戻る