上記計算式で計算された値で、フィルタリングします。
詳しい内容は、アンシャープマスキングを参照してください。
エッジ強度と勾配方向の計算
ソーベルフィルター
ソーベルフィルターの実行により、エッジの方向と、勾配の強度を計算します。
勾配の強度（ Ｉ ） 勾配の方向角度（ θ ）
エッジの方向は、下図の丸印が、値の大きい部分で、無い場所は値が小さいとすると、値の大きい場所と、フィルターの値の関係で、下図矢印の様に四方向に分類します。
Canny アルゴリズムによるエッジ抽出
John F. Canny 氏により考案された方法で、エッジ検出の性能は一番です。
輪郭抽出の細線化(Ｈｉｌｄｉｔｃｈ)を参照にしてください。
１．ガウシアンフィルターで、平滑化（ボケ画像の生成）
２．エッジ強度と勾配方向の計算（４方向に量子化）
３．細線化処理（Non Maximum Suppression）
４．ヒステリシス閾処理（Hysteresis Threshold）
５．エッジ端点の勾配方向と、周囲６点からエッジ再検索
の手順でエッジの検出を行います。
ガウシアンフィルター
上記計算式で計算された値で、フィルタリングします。
詳しい内容は、アンシャープマスキングを参照してください。
エッジ強度と勾配方向の計算
ソーベルフィルター
ソーベルフィルターの実行により、エッジの方向と、勾配の強度を計算します。
勾配の強度（ Ｉ ）
勾配の方向角度（ θ ）
エッジの方向は、下図の丸印が、値の大きい部分で、無い場所は値が小さいとすると、値の大きい場所と、フィルターの値の関係で、下図矢印の様に四方向に分類します。
arctan2の値によって、３６０度を８等分した方向にします。
０ １ ２ ３
-22.5°～+22.5° +22.5°～+67.5° +67.5°～+112.5° +112.5°～+157.5°
+157.5°～+202.5° +202.5°～+247.5° +247.5°～+292.5° +292.5°～+337.5°(-22.5°)
方向に関して符号なしとし、４方向とします。 （例 左右 右左 は、同じ方向とします。）
arctan2（ｙ，ｘ）の値は
－π ～ ＋π の結果となります。
d := round((ArcTan2(coly, colx) + pi) * 4
/ pi) mod 4;
マイナスの符号をとるため、 π を加算し、４倍して π
で除算し、四捨五入 次いで 4 で割った余りを求めます。
これで、-22.5°～ +337.5°を45°で分割した符号なしの方向を示す値 0～3
となります。
d
:= int((ArcTan2(coly, colx) + pi + pi / 8) * 4 / pi)
mod 4;
四捨五入を行わず切り捨てる場合は、pi / 8 を追加加算後整数化すれば、四捨五入と同じになります。
勾配の強度(
Ｉ ) の最大値は、
上図のような場合が最大値となり、1442
が最大値となります。
実際には、ガウシアンフィルターでボケ画像となる為、最大値になることはありません。
ガウスフィルター半径４、theta値１で最大値は、６８０近辺です。
theta値を非常に小さくすれば、フィルターなしと同じになるので1442となる可能性はあります。
＊＊
説明の都合上 ソーベルフィルターのＹ方向のマイナス方向を下側にしていますが、ここでのサンプルプログラムでは、画像データーをポインターでアクセスする為、画像の下側から上側に向かってアクセスします。
その為、Y方向のフィルターは上下逆に作用するので、斜め勾配方向が逆になります。＊＊
左図はＦの文字を表しています。
メモリー上では、図形の左下を原点として、図形が正立しています。
Ｗｉｎｄｏｗｓの画像の原点は左上となっているので、注意が必要です。
ソーベルフィルターのＹ方向は、メモリー上の図形に対して左図の方向で適用されます。
Ｘ方向に関しては、変化がありません。
ScanLine[Height - 1];は、左下の原点のポインター値を取得することができます。
P[0]が、原点です。
細線化処理
細線化処理は、勾配の方向と、勾配の強度から、勾配の強度のピークとなる点を検出しそこをエッジとする作業です。
ヒステリシス閾処理
閾値一つで、エッジを検出するのは難しいので、閾値を二つ設定して、条件によりエッジを判別します。
大きい値の閾値より大きい勾配強度の場所が有ったら、そこをエッジとし、それに繋がる、低いほうの閾値より大きい値の場所が有れば、エッジとします。
二重検索が発生しない様に、一度検索した場所には、チェック済みフラグセットします。
新しいエッジの場所を見つけると、更にそこにつながる、低いほうの閾値より大きい値の場所を検索します。
見つからなくなったら、次の場所にいどうします。
閾値処理が終了したら、エッジ(255)以外の場所をゼロ(0)にします。
エッジ再検索追加処理
閾値を一つ設定します。
エッジとした場所の端点を検索します。(エッジとして連続して繋がっている端の点です)
その点があったら、その点の周りに、エッジを除いた場所の勾配強度値を調べ指定した閾値より大きい場所が有ったら、その点をエッジとします。
勾配強度を調べるのは、勾配方向と直角方向の六ケ所の位置です、勾配方向の二ヶ所は調べません。
閾値より大きい場所が一か所だったら更に検索を続け、それより多い場合又は無い場合は、次の端点の検索に移ります。
これにより、ヒステリシス閾処理で漏れた、小さい値のエッジを追加します。
サンプルプログラム
サンプルプログラムは、http://codes-sources.commentcamarche.net/source/54560-detection-de-contour-canny からダウンロードしました。
基本的なプロセスには間違いがないのですが、元々のソースは C ではないかと思われ、勾配強度方向の計算に間違いが有ったので修正しました。
勾配強度は、宣言をWordに変更し、ポインタの使用をやめました。
メモリーの節約をするならば、カラーを２４ビット単位にすればよいのですが、あまりにも変更が多いので、３２ビットのまゝとしました。
浮動小数点は、Ｓｉｎｇｌｅ から Ｄｏｕｂｌｅ に変更です。
ガウシアンフィルターに浮動小数点演算を使用していますが、Ｓｉｎｇｌｅ より Ｄｏｕｂｌｅ の方が計算が速いためです。
フィルターの値を１０００倍して整数にしてフィルターの計算しても良いのですが、現在では浮動小数点でもかなり高速なので、計算速度はあまり改善されません。
unit CannyMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ExtDlgs, ComCtrls, Jpeg;
type
TFrmDemoMain = class(TForm)
Panel1: TPanel;
btnDoOpenBMP: TButton;
GroupBox1: TGroupBox;
Panel2: TPanel;
Splitter1: TSplitter;
ScrollBox1: TScrollBox;
imgOriginal: TImage;
ScrollBox2: TScrollBox;
imgResized: TImage;
OpenPictureDialog1: TOpenPictureDialog;
ComboStep: TComboBox;
Label5: TLabel;
Label6: TLabel;
ComboMap: TComboBox;
EAdd: TEdit;
Label7: TLabel;
Button2: TButton;
SavePictureDialog1: TSavePictureDialog;
GroupBox2: TGroupBox;
Label1: TLabel;
Label2: TLabel;
ERadius: TEdit;
ETheta: TEdit;
Button1: TButton;
GroupBox3: TGroupBox;
Label3: TLabel;
Label4: TLabel;
ELow: TEdit;
EHigh: TEdit;
procedure btnDoOpenBMPClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ComboChange(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
FrmDemoMain: TFrmDemoMain;
implementation
uses CannySub;
{$R *.dfm}
// ファイルのオープン jpg とビットマップ
procedure TFrmDemoMain.btnDoOpenBMPClick(Sender: TObject);
var
name: string;
jpg: tjpegimage;
begin
if not OpenPictureDialog1.Execute then exit;
name := OpenPictureDialog1.FileName;
if lowercase(extractfileext(name)) = '.bmp' then
imgOriginal.Picture.Bitmap.LoadFromFile(Name);
if lowercase(extractfileext(name)) ='.jpg' then
begin
jpg:=tjpegimage.Create;
jpg.LoadFromFile(name);
imgOriginal.Picture.Bitmap.Assign(jpg);
jpg.Free;
end;
Button1.Enabled := True;
ComboMap.Enabled := True;
ComboStep.Enabled := True;
end;
// Canny プロセス処理
procedure TFrmDemoMain.Button1Click(Sender: TObject);
var
theta : double;
radius : integer;
l, h : Smallint;
a : Smallint;
check : integer;
begin
Button1.Enabled := False;
Button2.Enabled := False;
ComboMap.Enabled := False;
ComboStep.Enabled := False;
application.ProcessMessages;
if not trystrtoint(ERadius.Text, radius) then begin // ガウシアンフィルター半径
radius := 3;
ERadius.Text := '3';
end;
if radius < 1 then begin
radius := 1;
ERadius.Text := '1';
end;
if radius > 20 then begin
radius := 20;
ERadius.Text := '20';
end;
if not trystrtoFloat(ETheta.Text, theta) then begin // thetaとなってしますがsiguma(σ)が一般的です
theta := 1.0;
ETheta.Text := '1.0';
end;
if theta <= 0 then begin
theta := 1.0;
ETheta.Text := '1.0';
end;
if theta > 10 then begin
theta := 10;
ETheta.Text := '10';
end;
val(ELow.Text, l, Check); // ヒステリシス閾処理の低い方の値
if Check <> 0 then begin
l := 30;
ELow.Text := '30';
end;
if l < 0 then begin
l := 0;
ELow.Text := '0';
end;
if l > 255 then begin
l := 255;
ELow.Text := '255';
end;
val(EHigh.Text, h, Check); // ヒステリシス閾処理の高い方の値
if Check <> 0 then begin
h := 60;
EHigh.Text := '60';
end;
if h < l then begin
h := l;
EHigh.Text := ELow.Text;
end;
if h > 255 then begin
h := 255;
EHigh.Text := '255';
end;
val(EAdd.Text, a, Check); // 追加エッジの閾値
if Check <> 0 then begin
a := 10;
EAdd.Text := '10';
end;
if a < 0 then begin
a := 0;
EAdd.Text := '0';
end;
if a > 1442 then begin
a := 1442;
EAdd.Text := '1442';
end;
// Canny プロセス処理
Canny(imgOriginal.Picture.Bitmap, imgResized.Picture.Bitmap, radius, theta, l, h, a,
ComboMap.ItemIndex, ComboStep.ItemIndex);
imgResized.Invalidate; // 再描画
Button2.Enabled := True;
Button1.Enabled := True;
ComboMap.Enabled := True;
ComboStep.Enabled := True;
end;
// プロセスの選択
procedure TFrmDemoMain.ComboChange(Sender: TObject);
begin
Button1Click(self);
end;
// 初期設定
procedure TFrmDemoMain.FormCreate(Sender: TObject);
begin
Button1.Enabled := False;
Button2.Enabled := False;
ComboMap.Enabled := False;
ComboStep.Enabled := False;
imgOriginal.Picture.Bitmap.PixelFormat := pf32bit;
imgResized.Picture.Bitmap.PixelFormat := pf32bit;
end;
// ファイル保存 Jpg 又は ビットマップ
procedure TFrmDemoMain.Button2Click(Sender: TObject);
var
name: string;
jpg: tjpegimage;
begin
if not SavePictureDialog1.Execute then exit;
name := SavePictureDialog1.FileName;
case SavePictureDialog1.FilterIndex of
1: name := ChangeFileExt(name,'.jpg');
2: name := ChangeFileExt(name,'.bmp');
end;
if Length(ExtractFileName(name)) <= 4 then exit;
if lowercase(extractfileext(name)) = '.bmp' then
imgResized.Picture.Bitmap.SaveToFile(Name);
if lowercase(extractfileext(name)) = '.jpg' then
begin
jpg:=tjpegimage.Create;
jpg.Assign(imgResized.Picture.Bitmap);
jpg.SaveToFile(name);
jpg.Free;
end;
end;
end.
unit CannySub;
interface
uses Windows, Graphics, Math,StrUtils, SysUtils;
procedure Canny(const bm_in: TBitmap; const bm_out: TBitmap;
GaussSize: integer; GaussTheta: double;
lowerThreshold, upperThreshold: byte; addThreshold: Word;
ColorMap, Level: integer);
implementation
type
TLongArray = array[0..0] of Cardinal; // 配列のポインターのみ必要なので長さ[0..0]でＯＫ
// TLongArray = array[0..65535] of integer;
PLongArray = ^TLongArray;
var
Pbm_In, Pbm_Out: PLongArray;
tmp_In : array of Cardinal;
edgeDir : array of Cardinal;
gradient: array of Word; // ソーベル値の保存 最大値は1442
Hyst : array of Cardinal;
WPicth : integer;
Width, Height : integer;
ColorMapMode : integer;
Threshold : Word;
Maxg : Word;
// fonctions diverses...
//==============================================================================
// colormap mode check
function colormapcheck(i: integer): Boolean;
var
ic : integer;
begin
Result := False;
ic := i mod 4;
if ic = 3 then exit; // ４バイト目(フラグバイト)は、モードに関係なく処理しない
if ic = 0 then begin // １バイト目(blue)は、モードに関係なく処理
Result := True; // ColorMapMode = 1 以外は １バイト目(blue)のみ使用します
exit;
end;
if ColorMapMode = 1 then // ColorMapmode RGB 時は全ての色 B, g, r 処理
Result := True;
// if ((ColorMapMode <> 1) and (i mod 4 <> 0)) or (i mod 4 = 3)) then Result := False
// else Result := True;
// 理解しやすい形に書き換えました、実際には上記２行と同じです。
end;
// r g b a byte data to 32bit color data
function RGBA(r, g, b, a: Byte): COLORREF;
begin
Result := (r or (g shl 8) or (b shl 16) or (a shl 24));
end;
// 色相変換
function ArcEnCiel(a: Word): COLORREF;
// gradient の最大値 1140 1140 = 19 * 60
function aconv(ain : Word): byte;
begin
result := 17 * (ain mod 60) shr 2;
end;
begin // B G R
result := RGB(255, 255, 255);
case (a div 60) mod 6 of
0: result := RGB( 255, aconv(a), 0);
1: result := RGB(255 - aconv(a), 255, 0);
2: result := RGB( 0, 255, aconv(a));
3: result := RGB( 0, 255 - aconv(a), 255);
4: result := RGB( aconv(a), 0, 255);
5: result := RGB( 255, 0, 255 - aconv(a));
end;
end;
// rgb to gray scale
function RGBtoGray(c: COLORREF): COLORREF;
var
r, g, b: cardinal;
begin
r := (c and $FF0000) shr 16;
g := (c and $00FF00) shr 8;
b := (c and $0000FF) ;
c := (r + g + b) div 3; // エッジ検出なので平均値を使用します。
// c := (r * 38 + g * 75 + b * 15) shr 7; // NTSC係数変換
result := $010101 * byte(c); // RGB同じ値セット
end;
function getPixel(pt: pointer; xx, yy: integer): COLORREF;
begin
result:= PLongArray(pt)[xx + yy * Width];
end;
procedure SetPixel(pt: pointer; xx, yy: integer; px: COLORREF);
begin
PLongArray(pt)[xx + yy * Width] := px;
end;
function getBytePixel(pt: pointer; xx, yy: integer): Byte;
begin
if xx < 0 then // 範囲がマイナイ側に超える場合一番外側の値で代用
if xx mod 4 = 0 then xx := 0 // 範囲を超えるのはガウシアンフィルター時
else xx := 4 + xx mod 4;
if yy < 0 then yy := 0;
if xx > WPicth - 1 then xx := WPicth - 4 + xx mod 4; // 範囲がプラス側に超える場合一番外側の値で代用
if yy > Height - 1 then yy := Height - 1; // 範囲を超えるのはガウシアンフィルター時
result:= PByteArray(pt)[xx + yy * WPicth];
end;
procedure SetBytePixel(pt: pointer; xx, yy: integer; px: byte);
begin
PByteArray(pt)[xx + yy * WPicth] := px; // Blue バイト書き込み
if ColorMapMode <> 1 then begin // RGB モード以外は r,g,b 同じ値書き込み
PByteArray(pt)[xx + 1 + yy * WPicth] := px;
PByteArray(pt)[xx + 2 + yy * WPicth] := px;
PByteArray(pt)[xx + 3 + yy * WPicth] := 0; // ４バイト目カラーフラグは０ゼロをセット
end;
end;
procedure copyimage(pt_In, pt_Out: pointer);
var
i, j: integer;
begin
for j := 0 to Height - 1 do
for i := 0 to Width - 1 do
SetPixel(pt_Out, i, j, GetPixel(pt_In, i, j));
end;
//==============================================================================
// ソーベル値 傾斜の大きさカラー表示
procedure ColorGradient;
var
i, j: integer;
Msc: double
begin
Msc := 359 / Maxg; // 最大値を359に設定する
for j := 0 to Height - 1 do
for i := 0 to Width - 1 do
SetPixel(Pbm_Out, i, j, Arcenciel(round(gradient[i * 4 + j * WPicth] * Msc)));
end;
// ソーベルによる傾斜方向色表示
procedure ColorDirection;
var
i, j: integer;
dc : integer;
const
// blue red yellow green
EdgeColor: array[0..3] of Tcolor = ($00001, $010000, $010100, $000100);
begin
for j := 0 to Height-1 do
for i := 0 to Width - 1 do begin
dc := gradient[i * 4 + j * WPicth]; // gradient 最大値1140
if dc > 255 then dc := 255; // byte 255
SetPixel(Pbm_Out, i, j, EdgeColor[GetBytePixel(PLongArray(edgeDir), i * 4, j)] * dc);
end;
end;
// passe l'image en niveau de gris
//==============================================================================
procedure MakeGrayScale;
var
i, j: integer;
begin
for j := 0 to Height - 1 do
for i := 0 to Width - 1 do
case ColorMapMode of
0: SetPixel(PLongArray(Tmp_In), i, j, RGBtoGray(GetPixel(Pbm_In, i, j))); // GrayScale
1: SetPixel(PLongArray(Tmp_In), i, j, getPixel(Pbm_In, i, j)); // FRGB
2: SetBytePixel(PLongArray(Tmp_In), i * 4, j, getbytePixel(Pbm_In, i * 4 + 2, j)); // Red
3: SetBytePixel(PLongArray(Tmp_In), i * 4, j, getbytePixel(Pbm_In, i * 4 + 1, j)); // Green
4: SetBytePixel(PLongArray(Tmp_In), i * 4, j, getbytePixel(Pbm_In, i * 4 + 0, j)); // Blue
end;
end;
// applique un flou gaussien
//==============================================================================
procedure GaussianBlur(size: integer; theta: double);
var
i, j, x, y: integer;
col : double;
c : Byte;
theta2 : double;
Gauss : double;
GaussSum: double;
GaussMatrice: array of array of double;
begin
// フィルターサイズが１だったら単純コピー
if size = 1 then begin
for j := 0 to Height - 1 do
for i := 0 to Width - 1 do
SetPixel(Pbm_Out, i, j, getPixel(Pbm_In, i, j));
exit;
end;
// Gauss matrice filter calc
theta2 := 2 * theta * theta;
size := size - 1;
setlength(GaussMatrice, size * 2 + 1);
GaussSum := 0;
for j := -size to size do begin
setlength(GaussMatrice[size + j], size * 2 + 1);
for i := 0 to size do begin
Gauss := exp(-(j * j + i * i) / theta2) / (pi * theta2);
GaussMatrice[size + j, size + i] := Gauss;
GaussSum := GaussSum + Gauss; // 全体が1にならないので合計値計算
if i = 0 then continue; // 零時中心位置なので反対側なし
GaussMatrice[size + j, size - i] := Gauss;
GaussSum := GaussSum + Gauss; // 全体が1にならないので合計値計算
end;
end;
// filterの適用
for j := 0 to Height - 1 do
for i := 0 to WPicth - 1 do
if colormapcheck(i) then begin // 計算の条件確認
col := 0;
for y := -size to size do
for x := -size to size do begin
c := getBytePixel(PLongArray(Tmp_In), i + x * 4, j + y);
col := col + GaussMatrice[size + x, size + y] * c;
end;
SetBytePixel(Pbm_Out, i, j, round(col / GaussSum)); // 合計値で補正 保存
end;
end;
// applique le filtre de Sobel qui recherche les contours suivant X et Y
//==============================================================================
const
Matrice_Sobel_x: array[-1..1, -1..1] of integer = ((-1, 0, 1), (-2, 0, 2), (-1, 0, 1)); // array[ y, x]
Matrice_Sobel_y: array[-1..1, -1..1] of integer = (( 1, 2, 1), ( 0, 0, 0), (-1,-2,-1));
procedure Sobel;
const
angle45 = pi / 4; // angle45 = 45°
var
i, j, x, y: integer;
colx, coly: integer;
c : integer;
angle : Byte;
grad : Word
begin
// on efface le tableau
for j := 0 to Height - 1 do
for i := 0 to WPicth - 1 do
gradient[i + j * WPicth] := 0;
for j := 0 to Height - 1 do
for i := 0 to Width - 1 do
SetPixel(PLongArray(edgeDir), i, j, 0);
Maxg := 0;
for j := 1 to Height - 2 do // ソーベルフィルターサイズ分小さくスキャン
for i := 4 to WPicth - 5 do
if colormapcheck(i) then begin
colx := 0;
coly := 0;
for y := -1 to 1 do
for x := -1 to 1 do begin
c := getBytePixel(Pbm_Out, i + x * 4, j + y);
colx := colx + Matrice_Sobel_x[y, x] * c; // X方向ソーベルフィルター
coly := coly + Matrice_Sobel_y[y, x] * c; // Y方向ソーベルフィルター
end;
grad := Round(Sqrt(colx * colx + coly * coly)); // ソーベルの値保存 最大値1140
gradient[i + j * WPicth] := grad;
if grad > Maxg then Maxg := grad;
angle := round((ArcTan2(coly, colx) + pi) / angle45) mod 4; // 0～3 edge 角度方向係数を求める
SetBytePixel(PLongArray(edgeDir), i, j, angle);
end;
end;
// trace un trait sur chaque contour (Non maximum Suppression)
//==============================================================================
procedure findEdge(x_Shift, y_Shift, x, y:integer);
var
g1, g2, g: Word;
begin
g := gradient[ x + y * WPicth]; // 中央位置の値取得
g1 := gradient[ x + x_Shift + (y + y_Shift) * WPicth]; // プラス位置値取得
g2 := gradient[ x - x_Shift + (y - y_Shift) * WPicth]; // マイナス位置値取得
if (g > g1) and (g > g2) then begin // g 中央の値が一番大きかったら出力画像にその値セット
if g > 255 then g := 255; // ソーベルgradient最大値は1140 byteは255
SetBytePixel(Pbm_Out, x, y, g);
end
else SetBytePixel(Pbm_Out, x, y, 0); // 違ったらゼロをセット
end;
procedure TraceAllEdges;
var
i, j:integer;
begin
for j := 1 to Height - 2 do
for i := 4 to WPicth - 5 do
if colormapcheck(i) then begin
case GetBytePixel(PLongArray(edgeDir), i, j) of // 方向データー取得 方向によってエッジ検出
0: findEdge( 4, 0, i, j); // 右 左
1: findEdge(-4, 1, i, j); // 左上 右下
2: findEdge( 0, 1, i, j); // 上 下
3: findEdge( 4, 1, i, j); // 右上 左下
end;
end;
end;
// cherche les points maxi sur les contours et efface les autres
//==============================================================================
procedure suppressNonMax( i, j: integer; lowerThreshold: byte);
begin
// pas assez blanc
if GetBytePixel(Pbm_Out, i, j) <= lowerThreshold then exit;
// pas checked pos
if GetBytePixel(PLongArray(Hyst), i, j) = 255 then exit;
SetBytePixel(PLongArray(Hyst), i, j, 255);
SetBytePixel(Pbm_Out, i, j, 255);
// 周囲８か所確認
suppressNonMax(i - 4, j - 1, lowerThreshold); // 左下
suppressNonMax(i , j - 1, lowerThreshold); // 下
suppressNonMax(i + 4, j - 1, lowerThreshold); // 右下
suppressNonMax(i - 4, j , lowerThreshold); // 左
suppressNonMax(i + 4, j , lowerThreshold); // 右
suppressNonMax(i - 4, j + 1, lowerThreshold); // 左上
suppressNonMax(i , j + 1, lowerThreshold); // 上
suppressNonMax(i + 4, j + 1, lowerThreshold); // 右上
end;
procedure Hysteresis(lowerThreshold, upperThreshold: byte);
var
i, j: integer;
begin
// on efface le tableau
for j := 0 to Height - 1 do
for i := 0 to Width - 1 do
SetPixel(PLongArray(Hyst), i, j, 0);
// 周囲をチェック済みにします。
// 周囲１ラインはソーベルフィルタの適用をしていないので黒にセット
for j := 0 to Height - 1 do begin
SetPixel(Pbm_Out, 0, j, 0); // 左
SetPixel(Pbm_Out, Width - 1, j, 0); // 右
end;
for i := 0 to Width - 1 do begin
SetPixel(Pbm_Out, i, 0, 0); // 下
SetPixel(Pbm_Out, i, Height - 1, 0); // 上
end;
for j := 0 to Height - 1 do
for i := 0 to WPicth - 1 do
if colormapcheck(i) then begin
// point dej・trait・ on passe au suivant
if GetBytePixel(PLongArray(Hyst), i, j) = 255 then continue;
// pas assez blanc pour le traitement
if GetBytePixel(Pbm_Out, i, j) < upperThreshold then continue;
suppressNonMax( i, j, lowerThreshold);
end;
end;
// 255 以下は ０に
procedure ClearNonWhitePixel;
var
i, j: integer;
c : Byte;
begin
for j := 0 to Height - 1 do
for i := 0 to WPicth - 1 do
if colormapcheck(i) then begin
c := GetBytePixel(Pbm_Out, i, j);
if c < 255 then SetBytePixel(Pbm_Out, i, j, 0);
end;
end;
// AddEgde エッジ検索追加
//==============================================================================
// 周囲８か所チェック ０以外カウント
function CountNeighbors(i, j: integer): Byte;
begin
result := 0;
if GetBytePixel(Pbm_Out, i, j) = 0 then exit;
if GetBytePixel(Pbm_Out, i + 4, j + 1) > 0 then inc(result); // 右上
if GetBytePixel(Pbm_Out, i , j + 1) > 0 then inc(result); // 上
if GetBytePixel(Pbm_Out, i - 4, j + 1) > 0 then inc(result); // 左上
if GetBytePixel(Pbm_Out, i + 4, j ) > 0 then inc(result); // 右
if GetBytePixel(Pbm_Out, i - 4, j ) > 0 then inc(result); // 左
if GetBytePixel(Pbm_Out, i + 4, j - 1) > 0 then inc(result); // 右下
if GetBytePixel(Pbm_Out, i , j - 1) > 0 then inc(result); // 下
if GetBytePixel(Pbm_Out, i - 4, j - 1) > 0 then inc(result); // 左下
end;
type
TMatrisse = array[1..6] of TPoint;
const
Matrisses : array[0..3] of TMatrisse = (
// 4 5 6
((x: -4; y: -1),(x: +0; y: -1),(x: +4; y: -1), // C
(x: -4; y: +1),(x: +0; y: +1),(x: +4; y: +1)), // Matrisse_N_S 1 2 3
// 1 2
((x: +0; y: +1),(x: +4; y: +1),(x: +4; y: +0), // 4 C 3
(x: -4; y: -0),(x: -4; y: -1),(x: -0; y: -1)), // Matrisse_NE_SW 5 6
// 3 6
((x: -4; y: -1),(x: -4; y: +0),(x: -4; y: +1), // 2 C 5
(x: +4; y: -1),(x: +4; y: +0),(x: +4; y: +1)), // Matrisse_E_W 1 4
// 2 3
((x: -4; y: +0),(x: -4; y: +1),(x: -0; y: +1), // 1 C 4
(x: +4; y: -0),(x: +4; y: -1),(x: +0; y: -1)) // Matrisse_NW_SE 6 5
);
procedure findNextEdge(x, y: integer; mat: TMatrisse);
var
dx, dy: integer;
g: array[1..6] of Word;
m, i, j: integer;
begin
m := 0;
for i := 1 to 6 do begin
g[i] := gradient[ x + mat[i].X + (y + mat[i].Y) * WPicth]; // ソーベル値取得
if GetBytePixel(Pbm_Out, x + mat[i].X, y + mat[i].Y) > 0 then g[i] := 0; // 出力値が255 だったらg[l]=０
if g[i] > Threshold then m := 1; // 指定値より大きい値があったらフラグセット
end;
// pas de voisin avec in gradient assez haut
if m = 0 then exit; // 指定値より大きい値がなかったら此処まで
m := 0;
j := 0;
for i := 1 to 6 do
if g[i] > m then begin // 最大値検索
m := g[i];
j := i;
end;
dx := mat[j].X;
dy := mat[j].y;
SetBytePixel(Pbm_Out, x + dx, y + dy, 255); // 最大値の場所を白に
if CountNeighbors(x + dx, y + dy) = 1 then // 周囲に０以外が１か所だったら再帰呼び出し 端点だったら
findNextEdge(x + dx, y + dy, Matrisses[GetBytePixel(PLongArray(edgeDir), x + dx, y + dy)]); // 方向セットエッジ検索
end;
// エッジ再検索
procedure AddEgde;
var
i, j: integer;
begin
for j := 1 to Height - 2 do // ソーベルフィルターサイズ分小さくスキャン
for i := 4 to WPicth - 5 do
if colormapcheck(i) then begin
if CountNeighbors(i , j) = 1 then // i,j の位置が０でなく周囲に一か所０以外があったら 端点だったら
findNextEdge(i, j, Matrisses[GetBytePixel(PLongArray(edgeDir), i, j)]); // 方向セットエッジ検索
end;
end;
//==============================================================================
//==============================================================================
procedure Canny(const bm_in: TBitmap; const bm_out: TBitmap;
GaussSize: integer; GaussTheta: double;
lowerThreshold, upperThreshold: byte; addThreshold: Word;
ColorMap, Level: integer);
begin
// initialisation des variables
Width := bm_In.Width;
Height:= bm_In.Height;
bm_Out.Width := Width; // ハンドルのみ継承されるので条件設定
bm_Out.Height := Height;
bm_In.PixelFormat := pf32bit; // Format変換 ファイルは24bit が多い
bm_Out.PixelFormat := pf32bit; // フォーマット未設定なのでここで設定
WPicth := Width * 4; // 1 Pixel 4 bytes
Pbm_In := bm_In.ScanLine[Height - 1]; // 先頭アドレポインタのセット
Pbm_Out := bm_Out.ScanLine[Height - 1]; // メモリーの方向逆なので注意 [0] ではＮＧ [0]は 最後のライン
setlength( Tmp_In, Width * Height); // 配列の大きさ確保 Cardinal
setlength( edgeDir, Width * Height); // Cardinal
setlength( Hyst, Width * Height); // Cardinal
setlength(gradient, WPicth * Height); // ソーベル値用 Word
ColorMapMode := ColorMap;
Threshold := addThreshold;
// traitement de l'image
MakeGrayScale; // グレースケール化
if level = 0 then begin
copyimage(PLongArray(Tmp_In), Pbm_Out);
exit;
end;
GaussianBlur(GaussSize, GaussTheta); // ガウスフィルターによるぼかし
if level = 1 then exit;
Sobel; // X Ｙ 方向ソーベルフィルター輪郭抽出 ソーベル(微分フィルター)
if level = 2 then begin
ColorGradient; // 勾配(微分結果)色相カラー表示
exit;
end;
if level = 3 then begin
ColorDirection; // 角度カラー表示
exit;
end;
TraceAllEdges; // エッジ抽出 ソーベルの値と方向値からエッジ検索
if level = 4 then exit;
Hysteresis(lowerThreshold, upperThreshold); // アッパースレッドより大きい場所の周囲の
// ロアースレッドより大きい値検束
if level = 5 then exit;
ClearNonWhitePixel; // 255(白)より小さい値はゼロ(黒)に Non maximum Suppression
if level = 6 then exit;
AddEgde; // エッジ追加 指定値より大きいソーベルの値と方向からエッジ再検索
end;
end.
cannytest.zip