2020/06/04
ＦＦＴルーチンを変更しました。（僅かだが早いものに変更しました。）
2020/04/14
実数部、虚数部をデーター数で割るルーチンの変更
2019/03/22 外周処理の追加
ブレ補正後に現れる、画像内の縞模様を低減するため、外周処理を追加しました。
完全ではありませんが、かなり低減されています。
手振れ写真の補正
FFT Deconvolutionを利用して、手振れ画像の補正を検討してみました。
縞模様の発生を少なくする為の、外周の処理追加
画像の縦横サイズが２nになっていない場合出来る余白を、中間色のグレイにし、
画像の外周をグレイから画像色にブレ補正の幅で変化させています。
通常のDeconvolutionと違うのは、補正データーの作成方法のみです。
FFT Deconvolutionは、レンズのボケ特性にあわせて、ガウス分布でデーターを作成していましたが、手振れの角度を合わせた直線で補正を試みてみました。
速度変動もあるので、それにも合わせた方がよいのですが、速度変動の解析が難しかったので、速度一定としました。
左図は、垂直にブレた場合の補正の実行例です。
マスクサイズの値は、ブレ量に値を合わせます。
Rangeは、補正値を適用するFFT変換した値の下限値です。
レンズのボケ補正の場合は、Range以下の場合０(ゼロ)を適用していましたが、ブレ補正の場合は、１／Range を適用したほうが良いようです。
一応０(ゼロ)と、１／Rangeの選択が出来る様にしました。
角度はブレの方向です。
例では、垂直方向で９ドット、一定の値となっていますが、本来は速度の遅いところは値を大きくして早いところは小さくするような補正が必要かと思います。
完全には、ブレをとれないようですが、解像度はかなり改善されています。
ブレ方向のエッジ部のデーターの関係で、画像に縞模様が発生しています、左図例は画像周辺処理のない場合です。
Rangeの値を調整して、縞模様の発生を少なくしてみました、解像度は若干低下します。
Rangeの値は０．３です。
上図、左がブレ補正前で、中央がブレ補正後です。
一番右が外周をグレイにした後、ブレ補正をした場合で、Rangeの値0.25で、縞模様の発生が少なくなり、解像度も若干、改善されています。
下図、同じ値で、ブレぼかし画像をつくり、それを元へ戻すと結構よく元へ戻っています。
しかし、外周補正を行うと、エッジのデーターが失われる為、逆に縞模様が発生します。
カメラのブレと、ブレを此処のプログラムの計算で作り出した場合の差のようです。
とにかく、手振れの画像は、完全に修正することは困難なので、手振れを発生させないことがやはり一番のようです。
現在のカメラの手振れ画像防止機能は素晴らしい機能です。
望遠レンズの場合は、手振れ補正機能と、出来る限り早いシャッター速度を利用する事です。
現在のカメラのセンサーは、可成り高感度になっていて、少しぐらい暗くてもフラッシュ無しでの撮影が可能です。
それでも、ブレが出てしまった場合、僅かなブレなら、本プログラムでも、結構よく補正できるようです。
プログラム
unit FFT_DconvMain;
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.Types;
type
D2array = array of array of Double;
B2array = array of array of Byte;
TDarray = array[0..0] of Double;
PDarray = ^TDarray;
TForm1 = class(TForm)
FileOpenBtn: TButton;
OpenPictureDialog1: TOpenPictureDialog;
MaskingBtn: TButton;
RadioGroup1: TRadioGroup;
FileSaveBtn: TButton;
SavePictureDialog1: TSavePictureDialog;
SigumaGrid: TStringGrid;
sourceBtn: TButton;
RangeEdit: TLabeledEdit;
Timer1: TTimer;
RepaintBtn: TButton;
ScrollBox1: TScrollBox;
Image1: TImage;
magnificationEdit: TLabeledEdit;
TrimmingBtn: TButton;
Memo1: TMemo;
MaskSizeEdit: TLabeledEdit;
AngleEdit: TLabeledEdit;
FrameBtn: TButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
procedure FileOpenBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure MaskingBtnClick(Sender: TObject);
procedure FileSaveBtnClick(Sender: TObject);
procedure sourceBtnClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure RangeEditChange(Sender: TObject);
procedure RepaintBtnClick(Sender: TObject);
procedure TrimmingBtnClick(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure MaskSizeEditChange(Sender: TObject);
procedure AngleEditChange(Sender: TObject);
procedure FrameBtnClick(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
private
{ Private 宣言 }
procedure FFT2(var a_rl, a_im: D2array; inv, Y_EXP, X_EXP: Integer);
procedure cstb(length: Integer; inv: integer; var sin_tbl, cos_tbl: array of double);
procedure rvmtx(var a, b: D2array; xsize, ysize: Integer);
procedure Imageout(Image: TBitmap);
procedure Trimming;
procedure TrimmingImage;
procedure trimming_imageout(Image: TBitmap);
procedure TestRoutine;
function LineDataset: boolean;
procedure Edge_processing;
procedure fft(a_rl, a_im: PDarray; length: integer; inv: integer;
sin_tbl, cos_tbl: PDarray; m: PMarray);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
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; // 表示枠サイズ
Line_blur = 0;
Deconvolution = 1;
var
InputDBitmap : TBitmap; // 入力データー表示用ビットマップ
OutputBitmap : TBitmap; // 画像表示用ビットマップ
SHeight : Integer; // 入力データー画像高さ
SWidth : Integer; // 入力データー画像幅
GHeight : Integer; // 計算データー画像高さ
GWidth : Integer; // 計算データー画像幅
THeight : Integer; // トリミングデーター画像高さ
TWidth : Integer; // トリミングデーター画像幅
VRect : Trect; // 表示サイズ設定用
InFilename : string; // 入力ファイル名
threshold : Double; // 範囲指定
gaus : integer; // ガウシアン配列サイズ
Gaussian : array of array of double;
X_EXP, Y_EXP : Integer; // 2^n 累乗
TrimmingF : boolean; // トリミングフラグ
TNX, TNY : integer; // トリミング幅,高さ 2^n 累乗
trimTop : integer; // トリム上
trimLeft : integer; // トリム左
trimHeight : integer; // トリム高さ
trimWidth : integer; // トリム幅
TrimScale : double; // トリムスケール
Sctext : string;
const
kr = 0.299; // R 輝度変換係数
kg = 0.587; // G 輝度変換係数
kb = 0.114; // B 輝度変換係数
//------------------------
// 変倍出力
//------------------------
procedure TForm1.Imageout(Image: TBitmap);
var
Rect0 : Trect;
magnification : Double;
Check : Integer;
MW, MH : Integer;
begin
Val(magnificationEdit.Text,magnification,Check);
if Check <> 0 then begin
application.MessageBox('表示倍率入力に間違いがあります。','注意',0);
exit;
end;
MW := Round(Image.Width * magnification);
MH := Round(Image.Height * 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;
//--- rvmtx --- ２次元データの転置 -------------------------------------------
// a: ２次元入力データ1
// b: ２次元出力データ1
// c; ２次元入力データ2
// d; ２次元出力データ2
// xysize: 水平,垂直データ個数
// yxsize: 垂直,水平データ個数
//-----------------------------------------------------------------------------
procedure TForm1.rvmtx(var a, b, c, d: D2array; xysize, yxsize: Integer);
var
i, j: integer;
begin
for i := 0 to yxsize - 1 do
for j := 0 to xysize - 1 do begin
b[j, i] := a[i, j];
d[j, i] := c[i, j];
end;
end;
// ------------------------新 FFT計算 ------------------------------
// a_rl: データ実数部（入出力兼用）
// a_im: データ虚数部（入出力兼用）
// length: データー個数
// inv: 変換フラグ F = -1 変換 F = 1 逆変換
// sin_tbl, cos_tbl sin, cos テーブル
// m 回転子バッファ
// -----------------------------------------------------------------
procedure TForm1.fft(a_rl, a_im: PDarray; length: integer; inv: integer;
sin_tbl, cos_tbl: PDarray; m: PMarray);
var
I, J, nd, ns, L, arg, it, ib: integer;
a, b, t : double;
begin
nd := length div 2; // データ数の1/2
ns := nd; // 2進数の最上位値
while (ns > 0) do begin // 2進数の最上位の値が0になるまで繰り返し
L := 0; // L=0
while L < length do begin // Lの値をlengthまで、
arg := m[L] div 2; // 回転子=前の回転子の値/2 m[0]は常に0
for it := L to L + ns - 1 do begin // itの値をLの値からL+2進数の最上位の値まで繰り返し
ib := it + ns; // ib＝it + 2進数の最上位の値
a := a_rl[ib] * cos_tbl[arg] - a_im[ib] * sin_tbl[arg];
b := a_im[ib] * cos_tbl[arg] + a_rl[ib] * sin_tbl[arg];
a_rl[ib] := a_rl[it] - a;
a_im[ib] := a_im[it] - b;
a_rl[it] := a_rl[it] + a;
a_im[it] := a_im[it] + b;
m[it] := arg; // m[it]に回転子を保存
m[ib] := arg + nd; // m[ib]に回転子 + データ数の1/2 を保存
end;
L := L + ns + ns; // Lの値を0からnまで、2×最上位の値のstepで繰り返し
end;
ns := ns div 2; // 2進数の最上位の値を繰り下げ
end;
if inv = 1 then begin // inv 1 周波数変換 -1 逆変換 2 フィルター
t := 1 / length;
for I := 0 to length - 1 do begin
a_rl[I] := a_rl[I] * t;
a_im[I] := a_im[I] * t;
end;
end;
for I := 0 to length - 1 do begin // データーの並べ替えビット反転処理
if I < m[I] then begin
J := m[I];
t := a_rl[I];
a_rl[I] := a_rl[J];
a_rl[J] := t;
t := a_im[I];
a_im[I] := a_im[J];
a_im[J] := t;
end;
end;
end;
//--- cstb --- SIN,COSテーブル作成 --------------------------------------------
// length: データ個数
// inv: 1: ＤＦＴ, -1: 逆ＤＦＴ
// sin_tbl: SIN計算用テーブル
// cos_tbl: COS計算用テーブル
//-----------------------------------------------------------------------------
procedure TForm1.cstb(length: Integer; inv: Integer; var sin_tbl, cos_tbl: array of double);
var
i : Integer;
xx, arg : Double;
begin
xx := - PI * 2.0 / length;
if inv < 0 then xx := - xx;
for i := 0 to length - 1 do begin
arg := i * xx;
sin_tbl[i] := sin(arg);
cos_tbl[i] := cos(arg);
end;
end;
//--- fft2 --- ２次元ＦＦＴの実行 ---------------------------------------------
// （GWidth，GHeightが２のべき乗の場合に限ります）
// a_rl: データ実数部（入出力兼用）
// a_im: データ虚数部（入出力兼用）
// inv: 1: ＤＦＴ，-1: 逆ＤＦＴ
// fftのルーチンに値を渡すのにポインター @ を使用していますが
// 二次元配列の一行だけを渡す為に使用しています。
// 一次元の配列を渡すのに ポインター @ を使用する必要性はありません。
// 配列の値を渡すのを統一するのに使用しています。
//-----------------------------------------------------------------------------
procedure TForm1.FFT2(var a_rl, a_im: D2array; inv, Y_EXP, X_EXP: Integer);
var
b_rl : D2array; // データ転置作業用配列（実数部）
b_im : D2array; // データ転置作業用配列（虚数部)
hsin_tbl : array of Double; // 水平用SIN計算用テーブル
hcos_tbl : array of Double; // 水平用COS計算用テーブル
vsin_tbl : array of Double; // 垂直用SIN計算用テーブル
vcos_tbl : array of Double; // 垂直用COS計算用テーブル
m_x : M2array; // データーの並べ替えビット反転処理with方向
m_y : M2array; // データーの並べ替えビット反転処理Height方向
i : Integer;
begin
// 配列の確保
SetLength(b_rl, GWidth, GHeight);
SetLength(b_im, GWidth, GHeight);
SetLength(hsin_tbl, GWidth);
SetLength(hcos_tbl, GWidth);
SetLength(vsin_tbl, GHeight);
SetLength(vcos_tbl, GHeight);
SetLength(buf_x, GWidth);
SetLength(buf_y, GHeight);
cstb(GWidth, inv, hsin_tbl, hcos_tbl); // 水平用SIN,COSテーブル作成
cstb(GHeight, inv, vsin_tbl, vcos_tbl); // 垂直用SIN,COSテーブル作成
// 水平方向のＦＦＴ
for i := 0 to GHeight - 1 do
fft(@a_rl[i][0], @a_im[i][0], GWidth, inv, @hsin_tbl[0], @hcos_tbl[0], @m_x[0]);
// ２次元データの転置 X方向とY方向の値を入れ替えます
// fft1coreのscanがX方向にしか出来ない為に行います
rvmtx(a_rl, b_rl, a_im, b_im, GWidth, Gheight);
// 垂直方向のＦＦＴ
for i := 0 to GWidth - 1 do
fft(@b_rl[i][0], @b_im[i][0], GHeight, inv, @vsin_tbl[0], @vcos_tbl[0], @m_y[0]);
// ２次元データの転置 X方向とY方向の値を入れ替えます
// X方向とY方向を入れ替えているので元へ戻します
rvmtx(b_rl, a_rl, b_im, a_im, GHeight, GWidth);
end;
//---------- ブレ補正データーの作成 -----------
// 角度と長さの設定
//---------------------------------------------
function TForm1.LineDataset: boolean;
var
X, Y, CH : integer;
KS, Angle : Double;
Total : Double;
MDIV2, MDIV : integer;
MatSize : integer;
rad, ypos, xpos : Double;
begin
result := False;
val(MaskSizeEdit.Text, gaus, CH);
if CH <> 0 then begin
application.MessageBox('MaskSize 入力に間違いがあります。', 'MaskSize', 0);
exit;
end;
if gaus < 3 then begin
application.MessageBox('MaskSize の値が小さすぎます。', 'MaskSize', 0);
exit;
end;
if (gaus > GWidth div 5) or (gaus > GHeight div 5) then begin
application.MessageBox('MaskSize の値が大き過ぎます。', 'MaskSize', 0);
exit;
end;
if gaus mod 2 = 0 then begin
application.MessageBox('MaskSizeを奇数にしてください。', 'MaskSize', 0);
// exit;
end;
gaus := gaus + 2;
val(AngleEdit.Text, Angle, CH);
if CH <> 0 then begin
application.MessageBox('角度に間違いがあります。', '角度', 0);
exit;
end;
repeat
if Angle < 0 then Angle := Angle + 180;
if Angle >= 180 then Angle := Angle - 180;
until (Angle >= 0) and (Angle < 180);
rad := Angle / 180 * pi;
if rad > 0 then rad := -rad;
setlength(Gaussian, gaus, gaus);
MatSize := gaus;
// ストリンググリッドの設定
SigumaGrid.ClientWidth := (SigumaGrid.DefaultColWidth + 1) * (MatSize + 1) - 1;
SigumaGrid.ColCount := MatSize + 1;
SigumaGrid.ClientHeight := (SigumaGrid.DefaultRowHeight + 1) * (MatSize + 1) - 1;
SigumaGrid.RowCount := MatSize + 1;
// 固定セルにナンバーリング
MDIV2 := MatSize div 2;
MDIV := MDIV2;
if MatSize mod 2 = 0 then MDIV := MDIV2 - 1;
for Y := - MDIV to MDIV2 do SigumaGrid.Cells[0 , Y + MDIV + 1] := intTostr(Y);
for X := - MDIV to MDIV2 do SigumaGrid.Cells[X + MDIV + 1, 0] := intTostr(X);
// マスクデーター計算と表示
Total := gaus - 2;
for Y := - MDIV to MDIV2 do
for X := - MDIV to MDIV2 do begin
Gaussian[X + MDIV, Y + MDIV] := 0;
end;
for X := - MDIV2 +1 to MDIV -1 do begin
ypos := sin(rad) * X;
xpos := cos(rad) * X;
Y := round(ypos);
CH := round(xpos);
Gaussian[Y + MDIV, CH + MDIV] := 1
end;
// フィルターの値変換 合計値が１になるように変換します
for Y := - MDIV to MDIV2 do
for X := - MDIV to MDIV2 do begin
KS := Gaussian[X + MDIV, Y + MDIV] / Total;
Gaussian[X + MDIV, Y + MDIV] := KS;
// グリッドに表示
SigumaGrid.Cells[Y + MDIV + 1, X + MDIV + 1] := FloatTostrF(KS, ffFixed, 6,5);
end;
result := true;
end;
//-------------------------------------------------------------------------------------------------
type
TPrgbarry = array[0..0] of Trgbtriple; // 24ビットカラーレコード 32ビット用はTRGBQuadArray
Prgbarray = ^TPrgbarry; // ポインター
// 配列のポインターが必要なだけなので、長さは1 [0..0]で問題ありません。
var
conv_real : D2array; // フィルター用実数部
conv_image : D2array; // フィルター用虚数部
half_cw : integer;
half_ch : integer;
arBlu : D2array; // データ実数部（入出力兼用)
aiBlu : D2array; // データ虚数部（入出力兼用)
r, i : Double;
PBA : Prgbarray;
DI : Integer;
rdr : Double;
rdi : Double;
//------------------------------
// フィルター計算選択
//------------------------------
procedure TForm1.MaskingBtnClick(Sender: TObject);
begin
MaskingBtn.Enabled := False;
FileOpenBtn.Enabled := False;
FileSaveBtn.Enabled := False;
RepaintBtn.Enabled := False;
sourceBtn.Enabled := False;
TrimmingBtn.Enabled := False;
if TrimmingF then TrimmingImage;
Memo1.Clear;
Memo1.Lines.Add('計算時間');
Memo1.Lines.Add(' Start ' + DateTimeToStr(Now));
Timer1.Enabled := True;
end;
//----------------------------
// 再計算許可
//----------------------------
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
MaskingBtn.Enabled := True;
end;
procedure TForm1.RangeEditChange(Sender: TObject);
begin
MaskingBtn.Enabled := True;
end;
procedure TForm1.MaskSizeEditChange(Sender: TObject);
begin
MaskingBtn.Enabled := True;
end;
procedure TForm1.AngleEditChange(Sender: TObject);
begin
MaskingBtn.Enabled := True;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
MaskingBtn.Enabled := True;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
MaskingBtn.Enabled := True;
end;
//--------------------------------
// ボタン表示更新待ち合わせ
//--------------------------------
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if (RadioGroup1.ItemIndex = Line_blur) or (RadioGroup1.ItemIndex = Deconvolution) then TestRoutine;
FileSaveBtn.Enabled := True;
FileOpenBtn.Enabled := True;
RepaintBtn.Enabled := True;
sourceBtn.Enabled := True;
Memo1.Lines.Add(' End ' + DateTimeToStr(Now));
end;
//-------------------------------------
// Edge processing
// 画像の縁をGray～原色に変化させます
//-------------------------------------
procedure TForm1.Edge_processing;
var
x, y : integer;
mdata : array of double;
gdata : array of byte;
begin
setlength(mdata, gaus);
setlength(gdata, gaus);
for y := 0 to gaus - 1 do begin
mdata[y] := y / gaus;
gdata[gaus - 1 - y] := round((128 / gaus) * y);
end;
for y := 0 to gaus - 1 do
for x := y to SWidth - y - 1 do
begin
arBlu[y, x] := round(arBlu[y, x] * mdata[y] + gdata[y]);
arBlu[Sheight - y - 1, x] := round(arBlu[Sheight - y - 1, x] * mdata[y] + gdata[y]);
end;
for x := 0 to gaus - 1 do
for y := x + 1 to SHeight - x - 2 do
begin
arBlu[y, x] := round(arBlu[y, x] * mdata[x] + gdata[x]);
arBlu[y, Swidth - x - 1] := round(arBlu[y, Swidth - x - 1] * mdata[x] + gdata[x]);
end;
end;
//--------------------------------------
// ボカシ処理 デコンボリューション処理
//--------------------------------------
procedure TForm1.TestRoutine;
var
nx, ny, x, y: integer;
Step : integer;
CH : integer;
Color : byte;
begin
if not LineDataset then exit;
application.ProcessMessages;
val(RangeEdit.Text, threshold, CH);
if CH <> 0 then begin
application.MessageBox('Deconv Range 入力に間違いがあります。', 'Range', 0);
exit;
end;
if threshold <= 0 then begin
application.MessageBox('Deconv Range ゼロ及び負数ではいけません。', 'Range', 0);
exit;
end;
if threshold > 1 then begin
application.MessageBox('Deconv Range 1を超えた場合画像はなくなります。', 'Range', 0);
exit;
end;
// 配列の確保
// 水平方向１ライン毎の先頭ポインターを使用する為 [V Lines, H Lines] になります
setlength(conv_real, GHeight, GWidth);
setlength(conv_image, GHeight, GWidth);
setlength(arBlu, GHeight, GWidth);
setlength(aiBlu, GHeight, GWidth);
// サイズ ２のn乗に書き込み サイズの合わない部分は黒色又は灰色になります
if checkbox2.Checked then Color := 128
else Color := 0;
if (SWidth <> GWidth) or (GHeight <> SHeight) then begin
for y := 0 to Gheight - 1 do begin
PBA := InputDBitmap.ScanLine[Y];
if y < Sheight then begin
for x := SWidth to GWidth - 1 do begin
PBA[x].rgbtBlue := Color;
PBA[x].rgbtGreen := Color;
PBA[x].rgbtRed := Color;
end;
end
else begin
for x := 0 to GWidth - 1 do begin
PBA[x].rgbtBlue := Color;
PBA[x].rgbtGreen := Color;
PBA[x].rgbtRed := Color;
end;
end;
end;
end;
// フィルター配列のクリア
for y := 0 to GHeight - 1 do
for x := 0 to GWidth - 1 do begin
conv_real[y, x] := 0.0; // 実数部
conv_image[y, x] := 0.0; // 虚数部
end;
// 拡張フィルターの設定 実数部値セット
half_cw := gaus div 2;
half_ch := gaus div 2;
if gaus mod 2 = 0 then begin
half_cw := half_cw - 1;
half_ch := half_ch - 1;
end;
for y := 0 to gaus - 1 do
for x := 0 to gaus -1 do begin
nx := GWidth - half_cw + x;
ny := Gheight - half_ch + y;
if nx >= GWidth then nx := nx - GWidth;
if ny >= Gheight then ny := ny - GHeight;
conv_real[ny][nx] := Gaussian[y][x];
end;
// 拡張したフィルターをフーリエ変換します RGB三色共通です
// 注 フィルターの場合、変換時、データー数による除算処理をしないようにします
FFT2(conv_real, conv_image, 2, Y_EXP, X_EXP);
// RGB １色ごとにFFTの計算をします。
for Step := 0 to 2 do begin
// 原画像を読み込み，２次元FFTの入力データに変換します
for y := 0 to Gheight - 1 do begin
PBA := InputDBitmap.ScanLine[Y];
for x := 0 to GWidth - 1 do begin
// カラー用三色分解 実数部
case Step of
0 : arBlu[y, x] := PBA[x].rgbtBlue;
1 : arBlu[y, x] := PBA[x].rgbtGreen;
2 : arBlu[y, x] := PBA[x].rgbtRed;
end;
aiBlu[y, x] := 0.0; // 虚数部
end;
end;
if checkbox2.Checked then Edge_processing;
// ２次元FFTを実行し 原画像を周波数成分に変換します
FFT2(arBlu, aiBlu, 1, Y_EXP, X_EXP);
// ボカシ処理 ---------------------------
if RadioGroup1.ItemIndex = Line_blur then begin
for x := 0 to GWidth - 1 do
for y := 0 to GHeight - 1 do begin
// フィルターの実施
r := arBlu[y][x] * conv_real[y][x] - aiBlu[y][x] * conv_image[y][x];
i := arBlu[y][x] * conv_image[y][x] + aiBlu[y][x] * conv_real[y][x];
arBlu[y][x] := r;
aiBlu[y][x] := i;
end;
end;
//---------------------------------------------------
// デコンボリューション処理 -------------------------
if RadioGroup1.ItemIndex = Deconvolution then begin
for x := 0 to GWidth - 1 do
for y := 0 to GHeight - 1 do begin
// デコンボリューション係数
rdr := abs(conv_real[y][x]);
rdi := abs(conv_image[y][x]);
// ボカシ処理とは逆なので、逆数にします
// thresholdは値が小さすぎた場合逆数の値が大きくなりすぎるので制限する値です
// thresholdはゼロでの除算の防止もします
if rdr > threshold then rdr := 1 / conv_real[y][x]
else begin
if checkbox1.Checked then rdr := 0
else rdr := 1 / threshold;
end;
if rdi > threshold then rdi := 1 / conv_image[y][x]
else begin
if checkbox1.Checked then rdi := 0
else rdi := 1 / threshold;
end;
// デコンボリューションの生成
r := arBlu[y][x] * rdr - aiBlu[y][x] * rdi;
i := arBlu[y][x] * rdi + aiBlu[y][x] * rdr;
arBlu[y][x] := r;
aiBlu[y][x] := i;
end;
end;
//---------------------------------------------------
// 逆FFTを実行して，フィルタ処理された周波数成分を画像に戻します
FFT2(arBlu, aiBlu, -1, Y_EXP, X_EXP);
// 結果を画像データに変換
for Y := 0 to Sheight - 1 do begin
PBA := OutputBitmap.ScanLine[Y];
for X := 0 to SWidth - 1 do begin
DI := Round(arBlu[y][x]);
if DI > 255 then DI := 255;
if DI < 0 then DI := 0;
case Step of
0: PBA[x].rgbtBlue := DI;
1: PBA[x].rgbtGreen := DI;
2: PBA[x].rgbtRed := DI;
end;
end;
end;
end;
Imageout(OutputBitmap); // 出力枠に変倍出力
end;
//--------------
// 元画像の表示
//--------------
procedure TForm1.sourceBtnClick(Sender: TObject);
begin
Imageout(InputDBitmap); // 出力枠に変倍出力
end;
//----------------------------
// 計算結果の再表示
//----------------------------
procedure TForm1.RepaintBtnClick(Sender: TObject);
begin
Imageout(OutputBitmap); // 出力枠に変倍出力
end;
//-----------------------
// 枠内表示倍率設定
//-----------------------
procedure TForm1.FrameBtnClick(Sender: TObject);
begin
magnificationEdit.Text := Sctext;
end;
//--------------------------------------------------
// 開いたファイルの画像表示
//--------------------------------------------------
procedure TForm1.trimming_imageout(Image: TBitmap);
begin
if Image.Width >= Image.Height then begin
Image1.Width := ImageHWC - 6;
image1.Height := round((ImageHWC - 6) * image.Height / Image.Width);
end
else begin
Image1.Height := ImageHWC - 6;
image1.Width := round((ImageHWC - 6) * image.Width / Image.Height);
end;
Image1.Picture.Bitmap.SetSize(Image1.Width, image1.Height);
Image1.Canvas.StretchDraw(Rect(0, 0, Image1.Width, image1.Height), Image); // 出力枠に変倍出力
magnificationEdit.Text := floatTostrF(Image1.Width / Image.Width, ffGeneral, 4, 2);
Sctext := magnificationEdit.Text;
end;
//---------------------------------------------------------------
// 処理画像サイズ縦横を2^nとする時、原画像の縦横を超えない何位で
// 処理画像サイズ縦横を設定し、原画像から取り出します。
// 取り出した部分しか処理されません。
//---------------------------------------------------------------
procedure TForm1.TrimmingBtnClick(Sender: TObject);
begin
Trimming;
end;
var
Drawing : Boolean; // マウス選択枠表示フラグ
Origin : TPoint; // マウススタート位置
EndPoint : TPoint; // マウスアップ位置
NewMove : Boolean; // マウス新移動
//-------------------------------------------------------
// 表示された画像に、2^n サイズの取り出し枠を表示します
//-------------------------------------------------------
procedure TForm1.Trimming;
var
nx : integer;
begin
if TrimmingF then begin
if Drawing then begin
Image1.Canvas.Pen.Mode := pmNotXor; // ペンモード Not Xor
if not NewMove then begin
Image1.Canvas.Rectangle(trimLeft, trimtop, trimWidth + trimLeft, trimHeight + trimTop); // 前の線消去
Image1.Canvas.Pen.Mode := pmCopy; // ペンモード通常に
end;
end;
TrimmingF := False;
Drawing := False;
exit;
end;
if not TrimmingF then TrimmingF := true;
nx := 1;
TNX := 0;
TNY := 0;
// データ幅の２のべき乗を計算
// 元画像と等しいか小さい2^nの画像サイズ取得
repeat
nx := nx * 2;
if (nx <= SWidth) then begin
TWidth := nx; // トリミング幅
inc(TNX);
end;
if (nx <= SHeight) then begin
THeight := nx; // トリミング高さ
inc(TNY);
end;
until (nx >= SWidth) and (nx >= SHeight);
trimTop := 0; // トリム上
trimLeft := 0; // トリム左
TrimScale := Image1.Width / SWidth;
trimHeight := round(THeight * TrimScale); // トリム高さ
trimWidth := round(TWidth * TrimScale); // トリム幅
Image1.Canvas.Brush.Style := bsClear;
Image1.Canvas.Pen.Style := psSolid;
Image1.Canvas.Pen.Color := clred;
Image1.Canvas.Pen.Mode := pmNotXor; // ペンモード Not Xor
Image1.Canvas.Rectangle (trimLeft, trimtop, trimWidth, trimHeight);
Image1.Canvas.Pen.Mode := pmCopy; // ペンモード通常に
NewMove := False;
Drawing := True;
end;
//----------------------------------------------------------
// 取り出し枠で表示された部分から画像を取り出し
// InputDBitmapにセットします。
//----------------------------------------------------------
procedure TForm1.TrimmingImage;
var
X, Y : integer;
T, L : integer;
PBB : Prgbarray;
begin
// 2^nの画像サイズに設定
InputDBitmap.Width := TWidth;
InputDBitmap.Height := THeight;
T := round(trimTop / TrimScale);
L := round(trimLeft / TrimScale);
if SWidth - (L + TWidth) < 0 then L := L - (SWidth - (L + TWidth));
if SHeight - (T + THeight) < 0 then T := T - (SHeight - (T + THeight));
for Y := T to T + THeight - 1 do begin
PBA := OutputBitmap.ScanLine[Y];
PBB := InputDBitmap.ScanLine[Y - T];
for X := L to L + TWidth - 1 do begin
PBB[X - L].rgbtBlue := PBA[X].rgbtBlue;
PBB[X - L].rgbtGreen := PBA[X].rgbtGreen;
PBB[X - L].rgbtRed := PBA[X].rgbtRed;
end;
end;
GWidth := TWidth;
GHeight := THeight;
SWidth := TWidth;
SHeight := THeight;
X_EXP := TNX;
Y_EXP := TNY;
OutputBitmap.Width := GWidth;
OutputBitmap.Height:= GHeight;
// トリミング終了したのでフラグ解除
TrimmingF := False;
// トリミング後の表示サイズ設定
if GWidth >= GHeight then begin
Image1.Width := ImageHWC - 6;
image1.Height := round((ImageHWC - 6) * GHeight / GWidth);
end
else begin
Image1.Height := ImageHWC - 6;
image1.Width := round((ImageHWC - 6) * GWidth / GHeight);
end;
Image1.Picture.Bitmap.SetSize(Image1.Width, image1.Height);
magnificationEdit.Text := floatTostrF(Image1.Width / GWidth, ffGeneral, 4, 2);
Sctext := magnificationEdit.Text;
end;
//---------------------------------------------------------
// 画像取り出し枠移動の為のマウスダウンによる設定
//---------------------------------------------------------
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if not TrimmingF then exit;
Origin := Point(X, Y); // 座標の保存
NewMove := False;
Drawing := True;
end;
//---------------------------------------------------------
// マウスの移動による取り出し枠移動
//---------------------------------------------------------
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
defX, defy : integer;
begin
if Drawing and (Shift = [ssLeft]) then begin
Image1.Canvas.Pen.Mode := pmNotXor; // ペンモード Not Xor
if not NewMove then begin
Image1.Canvas.Rectangle(trimLeft, trimtop, trimWidth + trimLeft, trimHeight + trimTop); // 前の線消去
end;
EndPoint := point(X, Y); // 新しい座標を保存
defX := EndPoint.X - Origin.X;
defY := EndPoint.Y - Origin.Y;
if (trimLeft + defX >= 0) and (trimWidth + trimLeft + defX < image1.Width) then
trimLeft := trimLeft + defX;
if (trimtop + defY >= 0) and (trimHeight + trimTop + defY < image1.Height) then
trimtop := trimtop + defY;
Origin := Point(X, Y);
Image1.Canvas.Rectangle(trimLeft, trimtop, trimWidth + trimLeft, trimHeight + trimTop);
NewMove := False;
Image1.Canvas.Pen.Mode := pmCopy; // ペンモード通常に
end;
end;
//------------------------------------------------
// ファイルのオープン
//------------------------------------------------
procedure TForm1.FileOpenBtnClick(Sender: TObject);
var
WIC : TWICImage;
XF, YF : Boolean;
nx2 : 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); // 画像の読み込み
SHeight := WIC.Height; // 画像高さ取得
SWidth := WIC.Width; // 画像幅
// OutputBitmapに原画像一時保存
OutputBitmap.Width := SWidth;
OutputBitmap.Height := SHeight;
OutputBitmap.Canvas.Draw(0, 0, WIC); // ビットマップに描画フォーマット変換書き込み
//---------------------------------------------------------------
// 原画像サイズより大きい 画像のサイズ ２のn乗に設定
// InputDBitmap に原画像左上基準にコピー
XF := False;
YF := False;
nx2 := 1;
X_EXP := 0;
Y_EXP := 0;
// データ幅の２のべき乗を計算
// 元画像と等しいか大きい2^nの画像サイズ取得
repeat
nx2 := nx2 * 2;
if not XF then inc(X_EXP);
if (nx2 >= SWidth) and (XF = False) then begin
XF := True;
GWidth := nx2;
end;
if not YF then inc(Y_EXP);
if (nx2 >= SHeight) and (YF = False) then begin
YF := True;
GHeight := nx2;
end;
until (nx2 >= SWidth) and (nx2 >= SHeight);
// 2^nの画像サイズに設定
InputDBitmap.Width := GWidth;
InputDBitmap.Height := GHeight;
// 全面黒色設定 Canvas 画像消去
VRect := Rect(0, 0, GWidth, GHeight);
InputDBitmap.Canvas.Brush.Style := bsSolid;
InputDBitmap.Canvas.Brush.Color := clblack;
InputDBitmap.Canvas.FillRect(VRect);
// 左上基準にWIC画像を書き込み
InputDBitmap.Canvas.Draw(0, 0, WIC);
//--------------------------------------------------------------
finally
WIC.Free; // TWICImage 解放
end;
end
else exit;
trimming_imageout(OutputBitmap); // 出力枠合わせてに変倍出力
MaskingBtn.Enabled := True;
// sourceBtn.Enabled := True;
radiogroup1.Enabled := True;
TrimmingBtn.Enabled := True;
TrimmingF := False;
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;
InputDBitmap := TBitmap.Create;
OutputBitmap := TBitmap.Create;
InputDBitmap.PixelFormat := pf24bit;
OutputBitmap.PixelFormat := pf24bit;
radiogroup1.Items.Add('Line blur');
radiogroup1.Items.Add('Deconvolution');
radiogroup1.ItemIndex := 1;
radiogroup1.Enabled := False;
MaskingBtn.Enabled := False;
FileSaveBtn.Enabled := False;
sourceBtn.Enabled := False;
RepaintBtn.Enabled := False;
TrimmingBtn.Enabled := False;
Sctext := '1';
end;
// 終了処理
procedure TForm1.FormDestroy(Sender: TObject);
begin
InputDBitmap.Free;
OutputBitmap.Free;
end;
end.
FFT_Deconvolution.zip