スキャンラインシードフィル(塗りつぶし)
塗りつぶしを高速で行うスキャンラインシードフィルのプログラムを作成してみました。
元々、Delphiには、塗りつぶしを行うメソッドとして FloodFill があり、わざわざ塗りつぶす為のプログラムを作成する必要は無いのですが、イメージの塗りつぶしが、どの様に行われているのか、アルゴリズムに知るためにプログラムを作成してみました。
塗りつぶしについては、画像輪郭追跡プログラムと 塗りつぶし で、周囲、四方向検索と八方向検索を使用していますが、スキャンラインシードフィルにも、四方向と、八方向があります。
四方向は、一般の塗りつぶし、八方向は、線画部分の塗りつぶしに使用します。
画像輪郭追跡プログラムと 塗りつぶしでは、単純な二次元配列を取り扱いましたが、此処では、TBitmap のラインをポインタ配列として、ビットマップイメージを、２次元配列として取り扱っています。
ポインタなので、アクセス速度は、通常の配列と変わりません。
八方向の塗りつぶしは、一般的には用意されていないので、一番細い線で描かれた線画の塗りつぶしに使用できます。
スキャンラインシードフィル
左図は四方向検索です。
1. 最初に塗りつぶし色を設定して、塗りつぶし開始点を指定します。
2. バッファクリアをします。
3. 塗りつぶし開始点をバッファに追加にします。
4. バッファから座標を取り出し、取り出した座標のバッファを削除します。
5. 座標の左側の領域色を検索し、左端の座標を取り出します。
6. 座標の右側の領域色を検索し、右端の座標を取り出します。
7. 左端の座標から右端の座標まで塗りつぶし色で置き換えます。
8.
塗りつぶしたラインの真下のラインの領域色を塗りつぶした左端と右端の範囲分検索します。
9. 領域色があったら、領域色の座標をバッファに追加します、繋がった領域色は一つの座標をいれます。
10. 塗りつぶしたラインの真上のラインの領域色を塗りつぶした左端と右端の範囲分検索します。
11. 領域色があったら、領域色の座標をバッファに追加します、繋がった領域色は一つの座標をいれます。
12. バッファに座標が残っていたら、4. から繰り返します。
* 真上、真下の領域色検索時、検索範囲内の繋がった領域色は、領域色の一番右側の座標がバッフォに追加され、検索範囲を超えて右側に繋がっている場合は、検索範囲の右端の座標がバッファに追加されます。
八方向検索は、真下、真上のライン検索時、検索範囲を左右それぞれ一つ多くして検索します。
一つ多く検索するので、画像の範囲を超えないように範囲設定をし直す必要があります。、
左図は、プログラムの実行例です。
塗り潰し色の設定は、カラーバーの色の部分をダブルクリックします。
ダブルクリックで設定された色が、右側の四角い領域に表示されます。
塗り潰し色の彩度、明度は、スクロールバーで調整しておきます。
塗り潰し色の設定が済んだら、塗り潰したい場所を選択してダブルクリックすると、その場所に選択色による丸点が表示されると同時に右側にその座標が表示されます。
次にPaintボタンをクリックする事で、指定した領域が塗り潰されます。
左図は八方向検索の実行例で、小さい四角は、1ピクセルを表しています。
斜めの細いラインの場合、1ビクセルの斜め繋がりとなり、四方向検索では塗り潰しが出来ません。
そこで、八方向検索を使用しますが、通常の領域の塗り潰しに使用すると、細いラインで囲まれた領域の場合、斜めの線から外側に塗り潰しが漏れ出します。
図形に応じて、使い分ける必要があります。
ペイントには、四方向検索しか用意されていません。
塗り潰されていない領域の座標を検索し、バッファに保存する方法として、Push、POPを使用する方法と、リングバッファを使用する方法があります。
リングバッファは、
固定長の配列メモリーを使用してメモリー先頭からバッファとして使用し、バッファから取り出すときは、先にバッファに入れたものから取り出して使用します。
メモリーの最後尾に達したら、先頭に戻って利用します。
Push、POPは、可変長のメモリーを利用します。(アセンブラのPush、Popと動作は同じですが、最大量が限定されているわけではありません)
バッファにデーターを入れるときは、追加するデーター分バツファを増やし、そこへ保存します、取り出すときは、最後に保存したデーターから取り出し、取り出した分だけバツファを少なくします。
此処では、一回ごとにバツファの長さを変えると時間がかかるので、塗り潰し開始時、一定長確保しておき、不足するようになったら、長さを加算します。
リングバツファを利用する場合は、どの程度の長さを用意すれば良いかが問題となります、途中でのバツファの長さの変更は出来ません。
画像幅の二倍プラス十個程度 用意すれば良いようですが、ここでのプログラムでは、不足が生じないように三倍としています。
通常は、一桁分ぐらいしか使用されません。
プログラム
次のプログラムは、リングバツファを使用した、四方向検索です。
unit Main;
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.UITypes, System.UIConsts;
type
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
FileOpenBtn: TButton;
OpenPictureDialog1: TOpenPictureDialog;
Image2: TImage;
Label1: TLabel;
Image3: TImage;
Label2: TLabel;
PaintBtn: TButton;
Label3: TLabel;
Label4: TLabel;
ScrollBar1: TScrollBar;
ScrollBar2: TScrollBar;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
procedure FileOpenBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Image2DblClick(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Image1DblClick(Sender: TObject);
procedure PaintBtnClick(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure ScrollBar2Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private 宣言 }
procedure Imageout(Image: TBitmap; magnification: double);
procedure ColorBar;
function PGetColor(X , Y: integer): TAlphaColor;
procedure PSetColor(X , Y: integer; Color: TAlphaColor);
procedure Scanline(left_X, right_X, Y: integer; color: TAlphaColor);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Type
TAlphaArray = array[0..0] of TAlphaColor; // TAlphaColor は Cardinal
PAlphaArray = ^TAlphaArray;
TPosXY = record // バッファ座標
X : integer;
Y : integer;
end;
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 = 512; // 表示枠サイズ
MINX = 0;
MINY = 0;
var
InputDBitmap : TBitmap; // 入力データー表示用ビットマップ
GHeight : Integer; // 入力データー画像高さ
GWidth : Integer; // 入力データー画像幅
MGHeight : Integer; // 入力データー画像高さ
MGWidth : Integer; // 入力データー画像幅
VRect : Trect; // 表示サイズ設定用
InFilename : string; // 入力ファイル名
Scale : double; // 画像の表示スケール
DidScale : double; // マウス座標計算用係数
PA : array of PAlphaArray; // ポインター配列
Xpos, Ypos : Integer; // マウス座標
PaintColor : TAlphaColor; // 塗りつぶし色
DotColor : TAlphaColor; // 塗りつぶし点表示色
Buff : array of TPosXY; // 塗りつぶし座標バッファ
SIndex, EIndex : integer; // バッファインデックス
MAXSIZE : integer; // バッファ最大サイズ
IXpos, IYpos : Integer; // 塗りつぶし開始点
OpenF : Boolean; // ファイルを開いた場合のフラグ
//--------------------------
// カラーバー作図
//--------------------------
procedure TForm1.ColorBar;
var
h : integer;
hue : double;
sat : double;
lat : double;
Cor : TAlphaColor;
begin
sat := ScrollBar1.Position / 100; // 彩度
lat := ScrollBar2.Position / 100; // 明度
for h := 0 to 359 do begin
hue := h / 360;
Cor := HSLtoRGB(hue, sat, lat); // 明度0.5 0.5 が純色
// Cor := RGBtoBGR(Cor);
Image2.Canvas.Pen.Color := Cor and $00FFFFFF;
Image2.Canvas.MoveTo(h, 0);
Image2.Canvas.LineTo(h, image2.Height);
end;
for h := 360 to 369 do begin
Image2.Canvas.Pen.Color := $00FFFFFF;
Image2.Canvas.MoveTo(h, 0);
Image2.Canvas.LineTo(h, image2.Height);
end;
for h := 370 to 380 do begin
Image2.Canvas.Pen.Color := $00000000;
Image2.Canvas.MoveTo(h, 0);
Image2.Canvas.LineTo(h, image2.Height);
end;
PaintColor := clBlack;
DotColor := clBlack;
end;
//------------------------------
// カラーバー彩度の変更
//------------------------------
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
ColorBar;
end;
//------------------------------
// カラーバー明度の変更
//------------------------------
procedure TForm1.ScrollBar2Change(Sender: TObject);
begin
ColorBar;
end;
//--------------------------------------
// 指定座標の色の書き込み
//--------------------------------------
procedure TForm1.PSetColor(X , Y: integer; Color: TAlphaColor);
begin
PA[Y][X] := Color;
end;
//-----------------------------------
// 措定座標の色の取得
//-----------------------------------
function TForm1.PGetColor(X , Y: integer): TAlphaColor;
begin
Result := PA[Y][X] and $00FFFFFF;
end;
//-----------------------------------
// 塗りつぶし開始点の指定
//-----------------------------------
procedure TForm1.Image1DblClick(Sender: TObject);
var
X , Y : integer;
begin
if not OpenF then exit;
X := Trunc(Xpos * DidScale);
Y := Trunc(Ypos * DidScale);
if X < 0 then X := 0;
if X > MGWidth then X := MGWidth;
if Y < 0 then Y := 0;
if Y > MGHeight then Y := MGHeight;
IXpos := X;
IYpos := Y;
Label3.Caption := 'X座標 ' + intTostr(IXpos);
Label4.Caption := 'Y座標 ' + intTostr(IYpos);
PaintBtn.Enabled := True;
Imageout(InputDBitmap, scale); // 出力枠に変倍出力
image1.Canvas.Brush.Color := DotColor;
image1.Canvas.Brush.Style := bsSolid;
image1.Canvas.Pen.Color := DotColor;
image1.Canvas.Pen.Style := psSolid;
image1.Canvas.Ellipse(Xpos - 5, Ypos - 5, Xpos + 5, Ypos + 5);
end;
//--------------------------------------
// 画像の座標取得
//--------------------------------------
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
Xpos := X;
Ypos := Y;
end;
//----------------------------------------------------------------
// カラーバーから色の取得
// TImage からの取り出した色とTBitmapから取り出した色のRGBの順番が
// 違うので RGBtoBGR で変換
//----------------------------------------------------------------
procedure TForm1.Image2DblClick(Sender: TObject);
begin
DotColor := Image2.Canvas.Pixels[Xpos, Ypos] and $00FFFFFF;
Image3.Canvas.Brush.Color := DotColor;
Image3.Canvas.FloodFill(15, 15, clYellow, fsBorder);
// RGBの色の順番変更
PaintColor := RGBtoBGR(DotColor);
end;
//--------------------------
// カラーバーの座標取得
//--------------------------
procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
Xpos := X;
Ypos := Y;
end;
//---------------------------------------------
// シードを検索してバッファに登録します
// left_X, right_X X座標の範囲
// Y ライン位置
// color 領域色
//---------------------------------------------
procedure TForm1.Scanline(left_X, right_X, Y:integer; color: TAlphaColor);
begin
// left_X から right_X の範囲検索します
while left_X <= right_X do begin
// 領域色検索 領域色だったらfor ブレーク
for left_X := left_X to right_X do
if PGetColor(left_X, y) = color then Break;
// 領域色が無かったら while ブレーク
if left_X > right_X then Break;
// 非領域色検索 境界色だったら for ブレーク
for left_X := left_X to right_X do
if PGetColor(left_X, y) <> color then Break;
// バッファに座標書き込み
// left_Xの値が１大きくなるので１マイナスしてバッファにいれます
Buff[EIndex].X := left_X - 1;
Buff[EIndex].Y := Y;
// エンドバッファインデックスインクリメント
inc(EIndex);
// バッファインデックスがバッファの最後を超えたら先頭に戻し
if EIndex = MAXSIZE then EIndex := 0;
end;
end;
//---------------------------------------------
// left_X, Right_X 開始座標
// PaintColor 塗りつぶし色
// color 領域色
//---------------------------------------------
procedure TForm1.PaintBtnClick(Sender: TObject);
var
left_X, Right_X : integer;
Line_Y : integer;
I : integer;
color : TAlphaColor;
MaxI : integer;
begin
// 領域色の取得
color := PGetColor(IXpos, IYpos); // IXpos, IYpos マウス指定位置
// 領域色と塗りつぶし色が同じだったら終了
if color = PaintColor then exit;
// バッファインデックスの初期設定
SIndex := 0;
EIndex := 1;
// バッファに開始点の座標セット
buff[SIndex].X := IXpos;
buff[SIndex].y := IYpos;
MaxI := 0; // バッファ使用量最大値クリア
repeat
// バッファから座標取り出し
left_X := buff[SIndex].X; // X位置取り出し
Right_X := left_X; // 左右位置を同じに
Line_Y := buff[SIndex].Y; // Y位置取り出し
// バッファインデックスインクリメント
inc(SIndex);
// バッファインデックスがバッファの最後を越えたら最初に戻し
if SIndex = MAXSIZE then SIndex := 0;
// 座標の色の取り出し、領域色で無かったら次のバツファへ
// 既に塗りつぶされている場合
if PGetColor(left_X, Line_Y) <> color then continue;
// 右の非領域色検索
while Right_X < MGWidth do begin
if PGetColor(Right_X + 1, Line_Y) <> color then break;
inc(Right_X);
end;
// 左の非領域色検索
while Left_X > 0 do begin
if PGetColor(left_X - 1, Line_Y) <> color then break;
dec(left_X);
end;
// 左から右まで塗りつぶし
for I := Left_X to Right_X do PSetColor(i, Line_Y, PaintColor);
// 真下のラインをスキャン
if Line_Y + 1 <= MGHeight then
scanline(Left_X, Right_X, Line_Y + 1, color);
// 真上のラインをスキャンします
if Line_Y - 1 >= 0 then
scanline(Left_X, Right_X, Line_Y - 1, color);
// バッファの使用量計算表示 リングバッファなので注意が必要です
if EIndex >= SIndex then begin
if MaxI < EIndex - SIndex then MAXI := EIndex - SIndex;
end
else begin
if MaxI < MAXSIZE - SIndex + EIndex then MaxI := MAXSIZE - SIndex + EIndex;
end;
// スタートとエンドバッファインデックスが一致したら終了
until SIndex = EIndex;
label7.Caption := 'バッファ最大使用量 ' + intTostr(MAXI + 1);
Imageout(InputDBitmap, scale); // 出力枠に変倍出力
end;
//------------------------
// 画像データーの変倍出力
//------------------------
procedure TForm1.Imageout(Image: TBitmap; magnification: double);
var
Rect0 : Trect;
MW, MH : Integer;
begin
MW := Round(GWidth * magnification);
MH := Round(GHeight * magnification);
Rect0 := Rect(0, 0, MW, MH);
Image1.Width := MW;
Image1.Height := MH;
Image1.Picture.Bitmap.SetSize(MW, MH);
Image1.Canvas.StretchDraw(Rect0, Image); // 出力枠に変倍出力
end;
//---------------------------
// 画像ファイルオープン
//---------------------------
procedure TForm1.FileOpenBtnClick(Sender: TObject);
var
WIC : TWICImage;
Y : Integer;
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; // 画像幅
InputDBitmap.Width := GWidth;
InputDBitmap.Height := GHeight;
InputDBitmap.Canvas.Draw(0, 0, WIC); // ビットマップに描画フォーマット変換
finally
WIC.Free; // TWICImage 解放
end;
end
else exit;
MGHeight := GHeight - 1; // 入力データー画像高さ
MGWidth := GWidth - 1; // 入力データー画像幅
// 画像表示スケール設定
scale := ImageHWC / GWidth;
if scale > ImageHWC / GHeight then scale := ImageHWC / GHeight;
if scale <> 0 then DidScale := 1 / scale;
// 入力画像表示
Imageout(InputDBitmap, scale); // 出力枠に変倍出力
// y ポインタ配列作成
setlength(pa , GHeight);
for Y := 0 to MGHeight do
PA[Y] := InputDBitmap.ScanLine[Y];
// バッファ配列の確保 画像幅の3倍程度とれば不足は発生しないようです
MAXSIZE := GWidth * 3;
Setlength(buff, MAXSIZE);
OpenF := True;
PaintBtn.Enabled := False;
end;
//------------------------
// 初期設定
//------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Width := ImageHWC;
Image1.Height := ImageHWC;
ScrollBox1.Height := ImageHWC + 5;
ScrollBox1.Width := ImageHWC + 5;
Image1.Top := 0;
Image1.Left := 0;
InputDBitmap := TBitmap.Create;
InputDBitmap.PixelFormat := pf32bit;
Image2.Top := 15;
Image2.Left := 136;
Image2.Width := 380;
Image2.Height := 30;
Image3.Top := 15;
Image3.Left := 620;
Image3.Width := 30;
Image3.Height := 30;
Image3.Canvas.Brush.Color := clBlack;
Image3.Canvas.Brush.Style := bsSolid;
Image3.Canvas.FloodFill(15, 15, clYellow, fsBorder);
ColorBar;
OpenF := False;
PaintBtn.Enabled := False;
end;
//-----------------------
// 終了処理
//-----------------------
procedure TForm1.FormDestroy(Sender: TObject);
begin
InputDBitmap.Free;
end;
end.
次のプログラムは PUSH POP を使用した例です。
PUSH POPの場合、バツファサイズが自動的に調整されるので、長さ設定に注意を払う必要は有りません。
リングバッファと違う部分だけを載せています。
//---------------------------------------------------------------------
// Push Pop がDelphiにないため追加
// 一回毎に長さを変えると時間がかかるので、不足したら一定長さ追加します
// EIndex に対して配列最後の位置は {EIndex - 1}
//---------------------------------------------------------------------
procedure TForm1.Push(X, Y: integer);
begin
inc(EIndex);
// バツファのサイズが不足したらバツファ長くします
if PPSize < EIndex then begin
PPSize := PPSize + ADDSIZE;
setlength(buff, PPSize);
end;
buff[EIndex - 1].X := X;
buff[EIndex - 1].Y := Y;
end;
procedure TForm1.Pop(var X, Y: integer);
begin
X := buff[EIndex - 1].X;
Y := buff[EIndex - 1].Y;
dec(EIndex);
// バツファのサイズを小さくする必要なないので省略してます
// Paintの開始時初期サイズにリセットされます
{
if PPSize - EIndex > ADDSIZE then begin
PPSize := PPSize - ADDSIZE;
setlength(buff, PPSize);
end;
}
end;
//-----------------------------------------------------
// シードを検索して領域色があったらバッファに登録します
// left_X, right_X X座標の範囲
// Y Y座標
// color 領域色
//-----------------------------------------------------
procedure TForm1.Scanline(left_X, right_X, Y:integer; color: TAlphaColor);
begin
while left_X <= right_X do begin
// 領域色検索 領域色だったら ブレーク
while left_X < right_X do begin // right_X - 1 の位置まで検索
if PGetColor(left_X, y) = color then Break; // 領域職だったら検索終了
inc(left_X);
end;
// left_X の位置が非領域色だったら先頭whileブレークこのルーチンここ迄
// 前のwhileでブレークした場合は領域色なのでブレークしない
// 前のwhileでブレークしなかった場合(領域色がない場合)は left_X = right_X
if PGetColor(left_X, y) <> color then Break;
// 非領域色検索 非領域色だったら ブレーク
while left_X <= right_X do begin
if PGetColor(left_X, y) <> color then Break;
inc(left_X);
end;
// 検索範囲に領域色が見つかつたのでバッファに領域座標書き込み
// 前の While で left_X が一つ多くインクリメントされるので１マイナスします
Push(left_X - 1, Y);
end;
end;
//---------------------------------------------
// 塗りつぶし
// left_X, Right_X 開始座標
// PaintColor 塗りつぶし色
// color 領域色
//---------------------------------------------
procedure TForm1.PaintBtnClick(Sender: TObject);
var
left_X, Right_X : integer;
Line_Y : integer;
I : integer;
color : TAlphaColor;
MaxI : integer;
begin
// 領域色の取得
color := PGetColor(IXpos, IYpos);
// 領域色と塗りつぶし色が同じだったら終了
if color = PaintColor then exit;
// バッファインダックスの初期設定
MaxI := 0; // バッファ最大値
EIndex := 0; // バツファ位置
PPSize := ADDSIZE; // 初期バッファサイズセット ADDSIZE=50
setlength(buff, PPSize); // バッファサイズ確保
// バッファに開始点の座標セット
push(IXpos, IYpos);
repeat
// バッファから座標取り出し
pop(left_X, Line_Y);
Right_X := left_X;
// 座標の色の取り出し、領域色で無かったら次のバツファへ
// 既に塗りつぶされている場合
if PGetColor(left_X, Line_Y) <> color then continue;
// 右の非領域色検索
while Right_X < MGWidth do begin
if PGetColor(Right_X + 1, Line_Y) <> color then break;
inc(Right_X);
end;
// 左の非領域色検索
while Left_X > 0 do begin
if PGetColor(left_X - 1, Line_Y) <> color then break;
dec(left_X);
end;
// 左から右まで塗りつぶし
for I := Left_X to Right_X do PSetColor(i, Line_Y, PaintColor);
// 真下のラインをスキャン
if Line_Y + 1 <= MGHeight then scanline(Left_X, Right_X, Line_Y + 1, color);
// 真上のラインをスキャンします
if Line_Y - 1 >= 0 then scanline(Left_X, Right_X, Line_Y - 1, color);
// バッファ最大使用量表示
if MaxI < EIndex then begin
MAXI := EIndex;
label7.Caption := 'バッファ最大使用量 ' + intTostr(MAXI + 1);
end;
// バッファ位置がが０になったら終了
until EIndex = 0;
// 塗りつぶし結果表示
Imageout(InputDBitmap, scale); // 出力枠に変倍出力
end;
次の例は、八方向検索を行うプログラム例です。
領域の検索時、検索範囲に対して、左右とも一つ多く検索することにより、左右斜め上、左右斜めしたの四カ所の検索が追加されます。
ラインの塗り潰しに適しています。
//---------------------------------------------
// 塗りつぶし
// left_X, Right_X 開始座標
// Sleft_X, SRight_X 八方向検索用
// PaintColor 塗りつぶし色
// color 領域色
//---------------------------------------------
procedure TForm1.PaintBtnClick(Sender: TObject);
var
left_X, Right_X : integer;
Line_Y : integer;
I : integer;
color : TAlphaColor;
MaxI : integer;
Sleft_X, SRight_X : integer; // 八方向検索用
begin
// 領域色の取得
color := PGetColor(IXpos, IYpos); // IXpos, IYpos マウス指定位置
// 領域色と塗りつぶし色が同じだったら終了
if color = PaintColor then exit;
// バッファインデックスの初期設定
SIndex := 0;
EIndex := 1;
// バッファに開始点の座標セット
buff[SIndex].X := IXpos;
buff[SIndex].y := IYpos;
MaxI := 0; // バッファ使用量最大値クリア
repeat
// バッファから座標取り出し
left_X := buff[SIndex].X; // X位置取り出し
Right_X := left_X; // 左右位置を同じに
Line_Y := buff[SIndex].Y; // Y位置取り出し
// バッファインデックスインクリメント
inc(SIndex);
// バッファインデックスがバッファの最後を越えたら最初に戻し
if SIndex = MAXSIZE then SIndex := 0;
// 座標の色の取り出し、領域色で無かったら次のバツファへ
// 既に塗りつぶされている場合
if PGetColor(left_X, Line_Y) <> color then continue;
// 右の非領域色検索
while Right_X < MGWidth do begin
if PGetColor(Right_X + 1, Line_Y) <> color then break;
inc(Right_X);
end;
// 左の非領域色検索
while Left_X > 0 do begin
if PGetColor(left_X - 1, Line_Y) <> color then break;
dec(left_X);
end;
// 左から右まで塗りつぶし
for I := Left_X to Right_X do PSetColor(i, Line_Y, PaintColor);
// 八方向検索とするためスキャン範囲の設定左右一つ多くします
if Left_X > 0 then SLeft_X := Left_X - 1
else SLeft_X := Left_X;
if Right_X < MGWidth then SRight_X := Right_X + 1
else SRight_X := Right_X;
// 真下のラインをスキャン
if Line_Y + 1 <= MGHeight then
scanline(SLeft_X, SRight_X, Line_Y + 1, color);
// 真上のラインをスキャンします
if Line_Y - 1 >= 0 then
scanline(SLeft_X, SRight_X, Line_Y - 1, color);
// バッファの使用量計算表示 リングバッファなので注意が必要です
if EIndex >= SIndex then begin
if MaxI < EIndex - SIndex then MAXI := EIndex - SIndex;
end
else begin
if MaxI < MAXSIZE - SIndex + EIndex then MaxI := MAXSIZE - SIndex + EIndex;
end;
// スタートとエンドバッファインデックスが一致したら終了
until SIndex = EIndex;
label7.Caption := 'バッファ最大使用量 ' + intTostr(MAXI + 1);
Imageout(InputDBitmap, scale); // 出力枠に変倍出力
end;
検索の高速化
二重に検索するのを出来る限り少なくしてみました。
バッファはリングバッファの方が、バッファの実使用量が少なくなるので、こちらを検討してみました。
イメージのピクセル単位でのアクセスの場合は、検索を少しでも少なくすれば、高速化の効果が大きいのでしょうが、此処でのプログラムは、配列化しているので、あまり効果は期待できません。
プログラム例として取り上げました。
//---------------------------------------------
// シードを検索してバッファに登録します
// left_X, right_X X座標の範囲
// Sleft_X, Eright_X 検索された領域色の範囲
// Bleft_X 検索開始位置バックアップ
// Y ライン位置
// color 領域色
//---------------------------------------------
procedure TForm1.Scanline(left_X, right_X, Y:integer; color: TAlphaColor);
var
Bleft_X : integer; // 検索先頭位置
Sleft_X : integer; // 左端位置
Eright_X : integer; // 右端位置
begin
// 検索先頭位置保存
Bleft_X := left_X;
// left_X から right_X の範囲検索します
while left_X <= right_X do begin
// 領域色検索 領域色だったらfor ブレーク
for left_X := left_X to right_X do
if PGetColor(left_X, y) = color then Break;
// 領域色が無い場合前のforでleft_Xの値がright_Xより1大きくなり検索終了 while ブレーク
if left_X > right_X then Break;
// 左の位置保存
Sleft_X := left_X;
// 左の位置が検索範囲の先頭で、画像幅左端で無かったら更に左側検索
if Bleft_X = left_X then
// 左の非領域色検索
while Sleft_X > 0 do begin
if PGetColor(Sleft_X - 1, Y) <> color then break;
dec(Sleft_X);
end;
// 非領域色右側検索 境界色だったら for ブレーク
for left_X := left_X to MGWidth do
if PGetColor(left_X, y) <> color then Break;
// 前のforで left_X の値が一つ大きくなるので1マイナス
Eright_X := left_X - 1;
// バッファに座標書き込み
Buff[EIndex].XS := Sleft_X;
Buff[EIndex].XE := ERight_X;
Buff[EIndex].Y := Y;
// エンドバッファインデックスインクリメント
inc(EIndex);
// バッファインデックスがバッファの最後を超えたら先頭に戻し
if EIndex = MAXSIZE then EIndex := 0;
// 保存した右位置が検索範囲右位置と同じか超えていたら検索終了 while ブレーク
if Eright_X >= right_X then Break;
end;
end;
//---------------------------------------------
// left_X, Right_X 開始座標
// PaintColor 塗りつぶし色
// color 領域色
//---------------------------------------------
procedure TForm1.PaintBtnClick(Sender: TObject);
var
left_X, Right_X : integer;
Line_Y : integer;
I : integer;
color : TAlphaColor;
MaxI : integer;
begin
// 領域色の取得
color := PGetColor(IXpos, IYpos); // IXpos, IYpos マウス指定位置
// 領域色と塗りつぶし色が同じだったら終了
if color = PaintColor then exit;
Line_Y := IYpos;
Right_X := IXpos;
left_X := IXpos;
// 右の非領域色検索
while Right_X < MGWidth do begin
if PGetColor(Right_X + 1, Line_Y) <> color then break;
inc(Right_X);
end;
// 左の非領域色検索
while Left_X > 0 do begin
if PGetColor(left_X - 1, Line_Y) <> color then break;
dec(left_X);
end;
// バッファインデックスの初期設定
SIndex := 0;
EIndex := 1;
// バッファに開始点の座標セット
buff[SIndex].XS := left_X;
buff[SIndex].XE := Right_X;
buff[SIndex].y := IYpos;
MaxI := 0; // バッファ使用量最大値クリア
repeat
// バッファから座標取り出し
left_X := buff[SIndex].XS; // XS位置取り出し
Right_X := buff[SIndex].XE; // XE位置取り出し
Line_Y := buff[SIndex].Y; // Y位置取り出し
// バッファインデックスインクリメント
inc(SIndex);
// バッファインデックスがバッファの最後を越えたら最初に戻し
if SIndex = MAXSIZE then SIndex := 0;
// 座標の色の取り出し、領域色で無かったら次のバッファへ
// 既に塗りつぶされている場合 until 迄省略
if PGetColor(left_X, Line_Y) <> color then continue;
// 左から右まで塗りつぶし
for I := Left_X to Right_X do PSetColor(i, Line_Y, PaintColor);
// 真下のラインをスキャンします
if Line_Y + 1 <= MGHeight then
scanline(Left_X, Right_X, Line_Y + 1, color);
// 真上のラインをスキャンします
if Line_Y - 1 >= 0 then
scanline(Left_X, Right_X, Line_Y - 1, color);
// バッファの使用量計算最大値検索 リングバッファなので注意が必要です
if EIndex >= SIndex then begin
if MaxI < EIndex - SIndex then MAXI := EIndex - SIndex;
end
else begin
if MaxI < MAXSIZE - SIndex + EIndex then MaxI := MAXSIZE - SIndex + EIndex;
end;
// スタートとエンドバッファインデックスが一致したら終了
until SIndex = EIndex;
// バッファの使用量表示
label7.Caption := 'バッファ最大使用量 ' + intTostr(MAXI + 1);
Imageout(InputDBitmap, scale); // 出力枠に変倍出力
end;
ダウンロード出来るソースは、四種類全てです。
サンプル画像データーは、ScanLineSeedFillのホルダーに入っています。
ScanLineSeedFill.zip
画像処理一覧へ戻る
最初に戻る