2020/06/04
ＦＦＴ変換部分の高速化の為、５種類程検討してみました。
高速フーリエ変換によるDeconvolution
DFTを使用したDeconvolutionについては、deconvolution.htmlを参照してください。
又、Deconvolutionについても、そちらを参照してください。
FFT（高速フーリエ変換）を利用すれば、ＤＦＴに比べて１００倍以上高速に演算が出来ます。
問題は、処理サイズが ２Ｎ に限られることです。
そこで、 ２Ｎ になっていない場合、 ２Ｎ のサイズの画像枠にコピーをして処理をするか、２Ｎ サイズ部分を取り出して処理をします。
２Ｎサイズに当てはめた場合は、最大で通常の四倍のメモリーを消費します。
部分的に取り出せば、メモリーの節約出来ますが、必要な部分を全て取り出せるとは限りません。
最近のデジカメの解像度は非常に高く、デジカメの画像をプリントしたり、パソコンで参照する場合、元のデーターの解像度より低くして参照することになり、通常の使用ではDeconvolutionは必要ないでしょう。
ポスターの様な大きなプリントの場合は、Deconvolutionを行うことにより、画像を鮮明にすることが出来ます。
２Ｎサイズで部分的に画像を取り出す場合は、左図Ｔｒｉｍｍｉｎｇボタンをクリックすると、画像の中にトリミング枠が表示されます。
枠のサイズは変更できませんが、位置はマウスで移動が出来ます。
トリミングを取り消す場合は、再度Ｔｒｉｍｍｉｎｇボタンをクリックすると、トリミング枠が消去されます。
Ｍａｓｋｉｎｇボタンをクリックして、演算の実行後は、ファイルから読み込まれたサイズの画像は表示されませんので、元の画像サイズを表示する場合は、再度ファイルから読み込む必要があります。
FFTの計算は、少しでも早い方が良いので、インターネットでプロクラムを集めて組み込んでみました。
周波数解析に組み込んでみたルーチンのうち、計算の遅い複素数使用の計算を除いています。
パソコンの仕様によっても速度が違うのですが、Ｎｏ２のプログラムが安定して速い結果となりました。
Ｎｏ５のプログラムは、画像サイズが小さい時は早く、大きくなると遅くなります。
Ｎｏ４のプログラムは、、小さな画像では遅い結果となるのですが、大きな画像では、Ｎｏ２より少し良い結果となり、その理由はよく判りません。
一番早いのと、遅いので２３％位の差なので、プログラムを変更しても、大きな成果は得られませんでした。
FFT基本ルーチンの演算回数は、５個のプログラムとも同じなので、２３％も差が出ることは、大きな差かもしれません。
Ｎｏ１のプログラムが、元々のプログラムですが、後ろから二番目の早さの結果となりました。
プログラム
unit FftDconvXMain;
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, system.DateUtils;
type
D2array = array of array of Double; // 二次元データー用
TDarray = array[0..0] of Double; // 配列Double
PDarray = ^TDarray; // ポインター 配列Double宣言
M2array = array of integer; // 配列integer
TMarray = array[0..0] of integer; // 配列integer
PMarray = ^TMarray; // ポインター 配列integer宣言
TForm1 = class(TForm)
FileOpenBtn: TButton;
OpenPictureDialog1: TOpenPictureDialog;
MaskingBtn: TButton;
RadioGroup1: TRadioGroup;
FileSaveBtn: TButton;
SavePictureDialog1: TSavePictureDialog;
SigumaGrid: TStringGrid;
SigumaEdit: TLabeledEdit;
sourceBtn: TButton;
UnsharpEdit: TLabeledEdit;
RangeEdit: TLabeledEdit;
Timer1: TTimer;
RepaintBtn: TButton;
ScrollBox1: TScrollBox;
Image1: TImage;
magnificationEdit: TLabeledEdit;
GaussEdit: TLabeledEdit;
TrimmingBtn: TButton;
Memo1: TMemo;
FulBtn: TButton;
RadioGroup2: TRadioGroup;
CheckBox1: 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 SigumaEditChange(Sender: TObject);
procedure RangeEditChange(Sender: TObject);
procedure RepaintBtnClick(Sender: TObject);
procedure UnsharpEditChange(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 FulBtnClick(Sender: TObject);
procedure GaussEditChange(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure RadioGroup2Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
private
{ Private 宣言 }
procedure Start; // stopwatch strat
function Stop: extended; // stopwatch stop
function SigumaMatSet: boolean;
procedure FFT2(var a_rl, a_im: D2array; inv: Integer);
procedure cstb(length: Integer; inv: integer; var sin_tbl, cos_tbl: array of double);
procedure rvmtx(var a, b, c, d: D2array; xysize, yxsize: Integer);
procedure LaplacianMask;
procedure Imageout(Image: TBitmap);
procedure GaussianRoutine;
procedure Trimming;
procedure TrimmingImage;
procedure trimming_imageout(Image: TBitmap);
procedure fft3(a_rl, a_im: PDarray; length, ex, inv: integer;
sin_tbl, cos_tbl: PDarray);
procedure fft1core(a_rl, a_im: PDarray; length, ex: integer;
sin_tbl, cos_tbl, buf: PDarray; inv: integer);
procedure birv(a: PDarray; length, ex: Integer; b: PDarray);
procedure fft(a_rl, a_im: PDarray; var length, inv: integer;
sin_tbl, cos_tbl: PDarray; m: PMarray);
procedure fft4(n, inv: integer; xr, xi, sin_tbl, cos_tbl: PDarray);
procedure fftNo5(var n, ex, inv: integer; xr, xi, sin_tbl, cos_tbl: PDarray);
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; // 表示枠サイズ
gaus = 9; // ガウシアン配列サイズ
Laplacian = 0;
Gaussians = 1;
Deconvolution = 2;
Unsharp = 3;
var
InputDBitmap : TBitmap; // 入力データー表示用ビットマップ
OutputBitmap : TBitmap; // 回転画像表示用ビットマップ
SHeight : Integer; // 入力データー画像高さ
SWidth : Integer; // 入力データー画像幅
GHeight : Integer; // 計算データー画像高さ
GWidth : Integer; // 計算データー画像幅
THeight : Integer; // トリミングデーター画像高さ
TWidth : Integer; // トリミングデーター画像幅
VRect : Trect; // 表示サイズ設定用
InFilename : string; // 入力ファイル名
threshold : Double; // 範囲指定
Gaussian : array[0..gaus - 1, 0..gaus - 1] of double;
OPT : integer; // OPT = 1 光学的ＦＦＴ（直流分が中央）
// OPT = 0 通常のＦＦＴ（直流分が左端）
TrimmingF : boolean; // トリミングフラグ
trimTop : integer; // トリム上
trimLeft : integer; // トリム左
trimHeight : integer; // トリム高さ
trimWidth : integer; // トリム幅
TrimScale : double; // トリムスケール
FopenF : boolean; // 最初の計算フラグ
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計算用テーブル
buf_x : array of Double; // 作業用バッファ（水平方向）
buf_y : array of Double; // 作業用バッファ（垂直方向）
m_x : M2array; // データーの並べ替えビット反転処理with方向
m_y : M2array; // データーの並べ替えビット反転処理Height方向
FFrequency: int64; // ストップウォッチ用 基準クロック
FStart: int64; // スタートカウンター値
FStop: int64; // ストップカウンター値
const
kr = 0.299; // R 輝度変換係数
kg = 0.587; // G 輝度変換係数
kb = 0.114; // B 輝度変換係数
No1 = 0;
No2 = 1;
No3 = 2;
No4 = 3;
No5 = 4;
// ストップウォッチスタート
procedure TForm1.Start;
begin
QueryPerformanceFrequency(FFrequency); // 基準クロック取得
QueryPerformanceCounter(FStart); // スタート時カウンター値
end;
// ストップウォッチ停止
function TForm1.Stop: extended;
begin
QueryPerformanceCounter(FStop); // ストップ時カウンター時
if FFrequency > 0 then // クロックの値を取得出来ていたら時間計算
result := (FStop - FStart) * 1000 / FFrequency
else result := -1;
end;
//------------------------
// 変倍出力
//------------------------
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;
//--- birv --- データの並べ換え -----------------------------------------------
// a: データの配列
// length: データ個数
// ex: データ個数を２の累乗で与えます(2のex乗個）
// b: 作業用バッファ
//-----------------------------------------------------------------------------
procedure TForm1.birv(a: PDarray; length, ex: Integer; b: PDarray);
var
i, ii, k, bit : Integer;
begin
for i := 0 to length - 1 do begin
ii := i;
bit:= 0;
for k := 0 to ex do begin
bit := (ii and 1) or bit;
if k = ex - 1 then break;
bit := bit shl 1;
ii := ii shr 1;
end;
b[i] := a[bit];
end;
for i := 0 to length - 1 do a[i] := b[i];
end;
//--No1- fft1core --- １次元ＦＦＴの計算の核になる部分 ---------------------------
// a_rl: データ実数部（入出力兼用）
// a_im: データ虚数部（入出力兼用）
// ex: データ個数を２の累乗で与えます(2のex乗個）
// sin_tbl: SIN計算用テーブル
// cos_tbl: COS計算用テーブル
//-----------------------------------------------------------------------------
procedure TForm1.fft1core(a_rl, a_im: PDarray; length, ex: integer;
sin_tbl, cos_tbl, buf: PDarray; inv: integer);
var
i, j, k, w, j1, j2 : Integer;
numb, lenb, timb : Integer;
xr, xi, nrml : Double;
begin
numb := 1;
lenb := length;
for i := 0 to ex - 1 do begin
lenb := lenb div 2;
timb := 0;
for j := 0 to numb - 1 do begin
w := 0;
for k := 0 to lenb - 1 do begin
j1 := timb + k;
j2 := j1 + lenb;
xr := a_rl[j1] - a_rl[j2];
xi := a_im[j1] - a_im[j2];
a_rl[j1] := a_rl[j1] + a_rl[j2];
a_im[j1] := a_im[j1] + a_im[j2];
a_rl[j2] := xr * cos_tbl[w] - xi * sin_tbl[w];
a_im[j2] := xr * sin_tbl[w] + xi * cos_tbl[w];
w := w + numb;
end;
timb := timb + 2 * lenb;
end;
numb := numb * 2;
end;
birv(a_rl, length, ex, buf); // 実数データの並べ換え
birv(a_im, length, ex, buf); // 虚数データの並べ換え
if inv = 1 then begin // フィルター及び逆変換はデーター数で除算しません
nrml := 1.0 / length;
for i := 0 to length - 1 do begin
a_rl[i] := a_rl[i] * nrml;
a_im[i] := a_im[i] * nrml;
end;
end;
end;
// ---No2---------------------新 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; var length, 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] shr 1; // 回転子=前の回転子の値/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 shr 1; // 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;
// --No3----------------------新 FFT計算 ------------------------------
// a_rl: データ実数部（入出力兼用）
// a_im: データ虚数部（入出力兼用）
// length: データー個数
// inv: 変換フラグ 0 変換 1 逆変換
// -----------------------------------------------------------------
procedure TForm1.fft3(a_rl, a_im: PDarray; length, ex, inv: integer;
sin_tbl, cos_tbl: PDarray);
var
a, b: double;
g, h, i, j, k, l , p, q: integer;
begin
l := length;
h := 1; // 2^0
for g := 1 to ex do begin
l := l shr 1; // l 数の1/2
k := 0;
for q := 1 to h do begin
p := 0; // 回転子
for i := k to l + k -1 do begin
j := i + l;
a := a_rl[i] - a_rl[j];
b := a_im[i] - a_im[j];
a_rl[i] := a_rl[i] + a_rl[j];
a_im[i] := a_im[i] + a_im[j];
if p = 0 then begin // 回転子ゼロ時は演算の必要なし cos=1 sin=0
a_rl[j] := a;
a_im[j] := b;
end
else begin
a_rl[j] := a * cos_tbl[p] + b * sin_tbl[p];
a_im[j] := b * cos_tbl[p] - a * sin_tbl[p];
end;
p := p + h; // 回転子+h
end;
k := k + l + l; // K + 2l
end;
h := h shl 1; // 2~n 2, 4, 8 ....
end;
j := length shr 1; // j = length / 2;
for i := 1 to length - 1 do begin // ピッ演算子による並び替え
k := length;
if j < i then begin
a := a_rl[i];
a_rl[i] := a_rl[j];
a_rl[j] := a;
b := a_im[i];
a_im[i] := a_im[j];
a_im[j] := b;
end;
k := k shr 1; // k = k / 2
while j >= k do begin
j := j - k;
k := k shr 1; // k = k / 2
if k = 0 then break;
end;
j := j + k;
end;
if inv = 1 then begin // invが0だったら周波数変換 データー数で除算
a := 1 / length; // ０データーを追加した場合追加前のデーター数で除算
for I := 0 to length - 1 do begin
a_rl[I] := a_rl[I] * a;
a_im[I] := a_im[I] * a;
end;
end;
end;
// --No4------------------------- FFT ---------------------------
// a_rl: データ実数部（入出力兼用）
// a_im: データ虚数部（入出力兼用）
// n: データー個数
// inv: 変換フラグ 0 変換 1 逆変換
// -----------------------------------------------------------
procedure TForm1.fft4(n, inv: integer; xr, xi, sin_tbl, cos_tbl: PDarray);
var
a, b: double;
i, ia, ib, j, k, ns, arg : integer;
begin
ns := n div 2;
while ns >= 1 do begin
arg := 0;
j := 0;
while j < n do begin
k := n shr 2; // k = n / 4
for ia := j to j + ns - 1 do begin
ib := ia + ns;
a := xr[ib] * cos_tbl[arg] - xi[ib] * sin_tbl[arg];
b := xr[ib] * sin_tbl[arg] + xi[ib] * cos_tbl[arg];
xr[ib] := xr[ia] - a;
xi[ib] := xi[ia] - b;
xr[ia] := xr[ia] + a;
xi[ia] := xi[ia] + b;
end;
while k <= arg do begin // ループ数多
arg := arg - k;
k := k shr 1; // k = k / 2
if k = 0 then break;
end;
arg := arg + k;
j := j + ns + ns;
end;
ns := ns shr 1; // ns = ns / 2
end;
if inv = 1 then begin
a := 1 / n;
for i := 0 to n - 1 do begin
xr[i] := xr[i] * a;
xi[i] := xi[i] * a;
end;
end;
j := 1; // ビット反転処理
for i := 1 to n - 1 do begin
if i <= j then begin
ia := i - 1;
ib := j - 1;
a := xr[ia];
b := xi[ia];
xr[ia] := xr[ib];
xi[ia] := xi[ib];
xr[ib] := a;
xi[ib] := b;
end;
k := n shr 1; // k = n / 2
while k < j do begin
j := j - k;
k := k shr 1; // k = k / 2
end;
j := j + k;
end;
end;
// ------------------------No5 FFT計算 ------------------------------
// n データー個数
// xr: データ実数部（入出力兼用）
// xi: データ虚数部（入出力兼用）
// -----------------------------------------------------------------
procedure TForm1.fftNo5(var n, ex, inv: integer; xr, xi, sin_tbl, cos_tbl: PDarray);
var
i, j, k, m, j1, j2, dn, w, arg: integer;
t1, t2: double;
begin
dn := n;
w := 1;
for i := 1 to ex do begin
m := dn;
dn := dn div 2;
arg := 0;
for j := 0 to dn - 1 do begin
k := m;
while k <= n do begin
j1 := k - m + j;
j2 := j1 + dn;
t1 := xr[j1] - xr[j2];
t2 := xi[j1] - xi[j2];
xr[j1] := xr[j1] + xr[j2];
xi[j1] := xi[j1] + xi[j2];
xr[j2] := t1 * cos_tbl[arg] + t2 * sin_tbl[arg];
xi[j2] := t2 * cos_tbl[arg] - t1 * sin_tbl[arg];
k := k + m;
end;
arg := arg + w;
end;
w := w shl 1; // w = w * 2
end;
j := 1;
dn := n div 2;
for i := 1 to n - 1 do begin // ビット反転処理
if i < j then begin
j1 := i - 1;
j2 := j - 1;
t1 := xr[j2];
t2 := xi[j2];
xr[j2] := xr[j1];
xi[j2] := xi[j1];
xr[j1] := t1;
xi[j1] := t2;
end;
k := dn;
while k < j do begin
j := j - k;
k := k shr 1; // k = k / 2
end;
j := j + k;
end;
if inv = 1 then begin
t1 := 1 / n;
for i := 0 to n - 1 do begin
xr[i] := xr[i] * t1;
xi[i] := xi[i] * t1;
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: FＦＴ，-1: 逆FＦＴ
// fftのルーチンに値を渡すのにポインター @ を使用していますが
// 二次元配列の一行だけを渡す為に使用しています。
// 一次元の配列を渡すのに ポインター @ を使用する必要性はありません。
// 配列の値を渡すのを統一するのに使用しています。
//-----------------------------------------------------------------------------
procedure TForm1.FFT2(var a_rl, a_im: D2array; inv: 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計算用テーブル
buf_x : array of Double; // 作業用バッファ（水平方向）
buf_y : array of Double; // 作業用バッファ（垂直方向）
m_x : M2array; // データーの並べ替えビット反転処理with方向
m_y : M2array; // データーの並べ替えビット反転処理Height方向
}
i, exw, exh : Integer;
begin
// 配列の確保
if RadioGroup2.ItemIndex = No1 then begin
SetLength(buf_x, GWidth);
SetLength(buf_y, GHeight);
end;
if RadioGroup2.ItemIndex = No2 then begin
SetLength(m_x, GWidth);
SetLength(m_y, GHeight);
end;
SetLength(b_im, GWidth, GHeight);
SetLength(b_rl, GWidth, GHeight);
SetLength(hsin_tbl, GWidth);
SetLength(hcos_tbl, GWidth);
SetLength(vsin_tbl, GHeight);
SetLength(vcos_tbl, GHeight);
exw := round(ln(GWidth) / ln(2));
exh := round(ln(GHeight) / ln(2));
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 begin
if RadioGroup2.ItemIndex = No5 then
fftNo5(GWidth, exw, inv, @a_rl[i][0], @a_im[i][0], @hsin_tbl[0], @hcos_tbl[0]);
if RadioGroup2.ItemIndex = No4 then
fft4(GWidth, inv, @a_rl[i][0], @a_im[i][0], @hsin_tbl[0], @hcos_tbl[0]);
if RadioGroup2.ItemIndex = No3 then
fft3(@a_rl[i][0], @a_im[i][0], GWidth, exw, inv, @hsin_tbl[0], @hcos_tbl[0]);
if RadioGroup2.ItemIndex = No2 then
fft(@a_rl[i][0], @a_im[i][0], GWidth, inv, @hsin_tbl[0], @hcos_tbl[0], @m_x[0]);
if RadioGroup2.ItemIndex = No1 then
fft1core(@a_rl[i][0], @a_im[i][0], GWidth, exw, @hsin_tbl[0], @hcos_tbl[0], @buf_x[0], inv);
end;
// ２次元データの転置 X方向とY方向の値を入れ替えます
// fft1coreのscanがX方向にしか出来ない為に行います
rvmtx(a_rl, b_rl, a_im, b_im, GWidth, Gheight);
// 垂直方向のＦＦＴ
for i := 0 to GWidth - 1 do begin
if RadioGroup2.ItemIndex = No5 then
fftNo5(GHeight, exh, inv, @b_rl[i][0], @b_im[i][0], @vsin_tbl[0], @vcos_tbl[0]);
if RadioGroup2.ItemIndex = No4 then
fft4(GHeight, inv, @b_rl[i][0], @b_im[i][0], @vsin_tbl[0], @vcos_tbl[0]);
if RadioGroup2.ItemIndex = No3 then
fft3(@b_rl[i][0], @b_im[i][0], GHeight, exh, inv, @vsin_tbl[0], @vcos_tbl[0]);
if RadioGroup2.ItemIndex = No2 then
fft(@b_rl[i][0], @b_im[i][0], GHeight, inv, @vsin_tbl[0], @vcos_tbl[0], @m_y[0]);
if RadioGroup2.ItemIndex = No1 then
fft1core(@b_rl[i][0], @b_im[i][0], GHeight, exh, @vsin_tbl[0], @vcos_tbl[0], @buf_y[0], inv);
end;
// ２次元データの転置 X方向とY方向の値を入れ替えます
// X方向とY方向を入れ替えているので元へ戻します
rvmtx(b_rl, a_rl, b_im, a_im, Gheight, GWidth);
// 配列グローバル変数の時は配列開法 ローカルの時は必要なし
Finalize(b_im); // データ転置作業用配列（実数部）
Finalize(b_rl); // データ転置作業用配列（虚数部)
Finalize(m_x); // データーの並べ替えビット反転処理with方向
Finalize(m_y); // データーの並べ替えビット反転処理Height方向
Finalize(hsin_tbl); // 水平用SIN計算用テーブル
Finalize(hcos_tbl); // 水平用COS計算用テーブル
Finalize(vsin_tbl); // 垂直用SIN計算用テーブル
Finalize(vcos_tbl); // 垂直用COS計算用テーブル
Finalize(buf_x); // 作業用バッファ（水平方向）
Finalize(buf_y); // 作業用バッファ（垂直方向）
end;
//-----------------------------
// ガウシアン用データーの計算
//-----------------------------
function TForm1.SigumaMatSet: boolean;
const
MatSize = gaus;
var
X, Y : integer;
KS, Z : Double;
CH : integer;
Total : Double;
MDIV2 : integer;
caution : Pchar;
// シグマ値からガウス分布値の計算
function Maskdatacalc(X, Y : Integer; Z: Double): double;
begin
Result := 1 / 2 / pi / Z / Z * Exp(-(X * X + Y * Y) / 2 / Z / Z); // マスクデーターの計算
end;
begin
Result := False;
Z := 1;
CH := 0;
caution := '注意';
if RadioGroup1.ItemIndex = Gaussians then begin
val(GaussEdit.Text, Z, CH);
caution := 'Gaussian';
end;
if RadioGroup1.ItemIndex = Deconvolution then begin
val(SigumaEdit.Text, Z, CH);
caution := 'Deconvolution';
end;
if RadioGroup1.ItemIndex = Unsharp then begin
val(UnsharpEdit.Text, Z, CH);
caution := 'Unsharp';
end;
if CH <> 0 then begin
application.MessageBox('σ 入力に間違いがあります。', caution, 0);
exit;
end;
if Z <= 0 then begin
application.MessageBox('σ ゼロ 及び ゼロ以下ではいけません。', caution, 0);
exit;
end;
if RadioGroup1.ItemIndex = Deconvolution then begin
val(RangeEdit.Text, threshold, CH);
caution := 'Deconvolution';
if CH <> 0 then begin
application.MessageBox('Deconv Range 入力に間違いがあります。', caution, 0);
exit;
end;
if threshold <= 0 then begin
application.MessageBox('Deconv Range ゼロ及び負数ではいけません。', caution, 0);
exit;
end;
if threshold > 1 then begin
application.MessageBox('Deconv Range 1を超えた場合画像はなくなります。', caution, 0);
exit;
end;
end;
// ストリンググリッドの設定
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;
for Y := - MDIV2 to MDIV2 do SigumaGrid.Cells[0 , Y + MDIV2 + 1] := intTostr(Y);
for X := - MDIV2 to MDIV2 do SigumaGrid.Cells[X + MDIV2 + 1, 0] := intTostr(X);
// σ値によるアンシャープマスクデーター計算と表示
Total := 0;
for Y := - MDIV2 to MDIV2 do
for X := - MDIV2 to MDIV2 do begin
KS := Maskdatacalc( X, Y, Z);
Gaussian[X + MDIV2, Y + MDIV2] := KS;
// 合計計算
Total := Total + KS;
end;
// Gaussianフィルターの値変換 合計値が１になるように変換します
for Y := - MDIV2 to MDIV2 do
for X := - MDIV2 to MDIV2 do begin
KS := Gaussian[X + MDIV2, Y + MDIV2] / Total;
Gaussian[X + MDIV2, Y + MDIV2] := KS;
// グリッドに表示
SigumaGrid.Cells[X + MDIV2 + 1, Y + MDIV2 + 1] := FloatTostrF(KS, ffFixed, 8,6);
end;
application.ProcessMessages;
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; // フィルター幅の1div2
half_ch : integer; // フィルター高さの1div2
arBlu : D2array; // データ実数部（入出力兼用)
aiBlu : D2array; // データ虚数部（入出力兼用)
r, i : Double;
PBA : Prgbarray; // RGBtriple配列のポインター
DI : Integer;
rdr : Double;
rdi : Double;
sttT, stpT : TDateTime; // intervalタイマー
stwT : extended; // stopwatch
//-----------------------------------------------------
// フィルター計算
// タイマーで待ち合わせ後タイマー割込みでフィルター計算
//-----------------------------------------------------
procedure TForm1.MaskingBtnClick(Sender: TObject);
begin
MaskingBtn.Enabled := False;
FileOpenBtn.Enabled := False;
FileSaveBtn.Enabled := False;
RepaintBtn.Enabled := False;
fulbtn.Enabled := False;
sourceBtn.Enabled := False;
TrimmingBtn.Enabled := False;
checkbox1.Enabled := False;
if TrimmingF then TrimmingImage;
Memo1.Clear;
Memo1.Lines.Add('計算時間');
if checkbox1.Checked = False then begin
sttT := Now;
Memo1.Lines.Add(' Start ' + DateTimeToStr(sttT));
end;
Timer1.Enabled := True; // 画面表示待ち合わせタイマースタート
end;
//-----------------------------------------------------
// ボタン表示更新待ち合わせ
// フィルター計算
//-----------------------------------------------------
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if checkbox1.Checked = True then Start;
with RadioGroup1 do begin
if ItemIndex = Laplacian then LaplacianMask;
if (ItemIndex = Gaussians)
or (ItemIndex = Deconvolution)
or (ItemIndex = Unsharp) then GaussianRoutine;
end;
FileSaveBtn.Enabled := True;
FileOpenBtn.Enabled := True;
RepaintBtn.Enabled := True;
fulbtn.Enabled := True;
sourceBtn.Enabled := True;
if checkbox1.Checked = False then begin
stpT := Now;
Memo1.Lines.Add(' End ' + DateTimeToStr(stpT));
Memo1.Lines.Add(' interval sec ' + floatTostr(SecondsBetween(sttT, stpT)));
end
else begin
stwT := Stop;
memo1.Lines.Add('interval');
memo1.Lines.Add(' ' + floatTostr(stwT) + 'msec');
end;
checkbox1.Enabled := True;
end;
//----------------------------
// 再計算許可
//----------------------------
procedure TForm1.SigumaEditChange(Sender: TObject);
begin
if radiogroup1.Enabled then MaskingBtn.Enabled := True;
end;
procedure TForm1.RangeEditChange(Sender: TObject);
begin
if radiogroup1.Enabled then MaskingBtn.Enabled := True;
end;
procedure TForm1.UnsharpEditChange(Sender: TObject);
begin
if radiogroup1.Enabled then MaskingBtn.Enabled := True;
end;
procedure TForm1.GaussEditChange(Sender: TObject);
begin
if radiogroup1.Enabled then MaskingBtn.Enabled := True;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if radiogroup1.Enabled then MaskingBtn.Enabled := True;
end;
procedure TForm1.RadioGroup2Click(Sender: TObject);
begin
MaskingBtn.Enabled := True;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
MaskingBtn.Enabled := True;
end;
//------------------------------------------
// ラプラシアン計算
//------------------------------------------
procedure TForm1.LaplacianMask;
const
// ラプラシアンフィルター
cvnLap = 3;
convLap : array[0..cvnLap - 1, 0..cvnLap - 1] of double = ((1, 1, 1),
(1, -8, 1),
(1, 1, 1));
MatSize = cvnLap;
var
nx, ny, x, y: integer;
MDIV2 : integer;
KS : double;
begin
// ストリンググリッドの設定
SigumaGrid.ColCount := MatSize + 1;
SigumaGrid.RowCount := MatSize + 1;
SigumaGrid.ClientWidth := (SigumaGrid.DefaultColWidth + 1) * (MatSize + 1) - 1;
SigumaGrid.ClientHeight := (SigumaGrid.DefaultRowHeight + 1) * (MatSize + 1) - 1;
// 固定セルにナンバーリング
MDIV2 := MatSize div 2;
for Y := - MDIV2 to MDIV2 do SigumaGrid.Cells[0 , Y + MDIV2 + 1] := intTostr(Y);
for X := - MDIV2 to MDIV2 do SigumaGrid.Cells[X + MDIV2 + 1, 0] := intTostr(X);
// フィルター値表示
for Y := - MDIV2 to MDIV2 do
for X := - MDIV2 to MDIV2 do begin
KS := convLap[X + MDIV2, Y + MDIV2];
// グリッドに表示
SigumaGrid.Cells[X + MDIV2 + 1, Y + MDIV2 + 1] := FloatTostrF(KS, ffFixed, 2,1);
end;
application.ProcessMessages;
// 配列の確保
// 水平方向１ライン毎の先頭ポインターを使用する為 [V Lines, H Lines] になります
setlength(conv_real, GHeight, GWidth);
setlength(conv_image, GHeight, GWidth);
setlength(arBlu, GHeight, GWidth);
setlength(aiBlu, GHeight, GWidth);
// フィルター配列のクリア
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 := cvnLap div 2;
half_ch := cvnLap div 2;
for y := 0 to cvnLap - 1 do
for x := 0 to cvnLap -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] := convLap[y][x];
end;
// 拡張したフィルターをフーリエ変換します
// 注 フィルターの場合、変換時、データー数による除算処理をしないようにします
FFT2(conv_real, conv_image, 2);
// 原画像を読み込みグレー変換
// ２次元FFTの入力データに変換します
for y := 0 to Gheight - 1 do begin
PBA := InputDBitmap.ScanLine[Y];
for x := 0 to GWidth - 1 do begin
// ラプラシアン用グレイ画像生成 輝度変換 実数部
arBlu[y, x] := Round(PBA[x].rgbtBlue * kb
+ PBA[x].rgbtGreen * kg
+ PBA[x].rgbtRed * kr);
aiBlu[y, x] := 0.0; // 虚数部
end;
end;
// ２次元FFTを実行し 原画像を周波数成分に変換します
FFT2(arBlu, aiBlu, 1);
// ガウシアン ラプラシアン フィルター処理
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;
// 逆FFTを実行して，フィルタ処理された周波数成分を画像に戻します
FFT2(arBlu, aiBlu, -1);
// 結果を画像データに変換
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;
PBA[x].rgbtBlue := DI;
PBA[x].rgbtGreen := DI;
PBA[x].rgbtRed := DI;
end;
end;
if FopenF then begin
trimming_imageout(OutputBitmap);
FopenF := False;
end
else Imageout(OutputBitmap); // 出力枠に変倍出力
Finalize(conv_real);
Finalize(conv_image);
Finalize(arBlu);
Finalize(aiBlu);
end;
//------------------------------------------
// ガウスフィルターによるボケ計算 Gaussian
// デコンボリューション Deconvolution
// アンシャープ Unsharp
//------------------------------------------
procedure TForm1.GaussianRoutine;
var
nx, ny, x, y: integer;
Step : integer;
begin
// ガウシアンフィルターデーターの生成
if not SigumaMatSet then exit;
// 配列の確保
// 水平方向１ライン毎の先頭ポインターを使用する為 [V Lines, H Lines] になります
setlength(conv_real, GHeight, GWidth);
setlength(conv_image, GHeight, GWidth);
setlength(arBlu, GHeight, GWidth);
setlength(aiBlu, GHeight, GWidth);
// フィルター配列のクリア
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;
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);
// 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;
// ２次元FFTを実行し 原画像を周波数成分に変換します
FFT2(arBlu, aiBlu, 1);
// ガウシアン ボカシ処理 ---------------------------
if RadioGroup1.ItemIndex = Gaussians 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 rdr := 0;
if rdi > threshold then rdi := 1 / conv_image[y][x]
else rdi := 0;
// デコンボリューションの生成
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;
//---------------------------------------------------
// アンシャープ処理 ---------------------------------
if RadioGroup1.ItemIndex = Unsharp 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];
// 差分計算
r := arBlu[y][x] - r;
i := aiBlu[y][x] - i;
// 元データーに差分加算
arBlu[y][x] := arBlu[y][x] + r;
aiBlu[y][x] := aiBlu[y][x] + i;
end;
end;
//---------------------------------------------------
// 逆FFTを実行して，フィルタ処理された周波数成分を画像に戻します
FFT2(arBlu, aiBlu, -1);
// 結果を画像データに変換
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;
if FopenF then begin // ファイルOpen時表示
trimming_imageout(OutputBitmap); // 出力枠に変倍出力
FopenF := False;
end
else Imageout(OutputBitmap); // 出力枠に変倍出力
Finalize(conv_real);
Finalize(conv_image);
Finalize(arBlu);
Finalize(aiBlu);
end;
//--------------
// 元画像の表示
//--------------
procedure TForm1.sourceBtnClick(Sender: TObject);
begin
Imageout(InputDBitmap); // 出力枠に変倍出力
end;
//----------------------------
// 計算結果の再表示
//----------------------------
procedure TForm1.RepaintBtnClick(Sender: TObject);
begin
Imageout(OutputBitmap); // 出力枠に変倍出力
end;
//--------------------------------------------------
// 開いたファイルの画像表示
//--------------------------------------------------
procedure TForm1.trimming_imageout(Image: TBitmap);
begin
if Image.Width >= Image.Height then begin
Image1.Width := ImageHWC;
image1.Height := round((ImageHWC) * image.Height / Image.Width);
end
else begin
Image1.Height := ImageHWC;
image1.Width := round((ImageHWC) * 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, 6, 4);
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;
// データ幅の２のべき乗を計算
// 元画像と等しいか大きい2^nの画像サイズ取得
repeat
nx := nx * 2;
if (nx <= SWidth) then TWidth := nx; // トリミング幅
if (nx <= SHeight) then THeight := nx; // トリミング高さ
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;
OutputBitmap.Width := GWidth;
OutputBitmap.Height:= GHeight;
// トリミング終了したのでフラグ解除
TrimmingF := False;
Drawing := False;
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;
// データ幅の２のべき乗を計算
// 元画像と等しいか大きい2^nの画像サイズ取得
repeat
nx2 := nx2 * 2;
if (nx2 >= SWidth) and (XF = False) then begin
XF := True;
GWidth := nx2;
end;
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 := clWhite;
InputDBitmap.Canvas.FillRect(VRect);
// サイズ ２のn乗に書き込み サイズの合わない部分は白になります
// 左上基準に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;
checkbox1.Enabled := True;
TrimmingF := False;
FileSaveBtn.Enabled := False;
sourceBtn.Enabled := False;
RepaintBtn.Enabled := False;
fulbtn.Enabled := False;
FopenF := True;
end;
procedure TForm1.FulBtnClick(Sender: TObject);
begin
trimming_imageout(OutputBitmap);
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
top := (Screen.height - Height) div 2;
left := (Screen.Width - Width) div 2;
Timer1.Enabled := False;
Timer1.Interval := 200;
Image1.Width := ImageHWC;
Image1.Height := ImageHWC;
ScrollBox1.Height := ImageHWC + ScrollBox1.BevelWidth * 4;
ScrollBox1.Width := ImageHWC + ScrollBox1.BevelWidth * 4;
Image1.Top := 0;
Image1.Left := 0;
InputDBitmap := TBitmap.Create;
OutputBitmap := TBitmap.Create;
InputDBitmap.PixelFormat := pf24bit;
OutputBitmap.PixelFormat := pf24bit;
radiogroup1.Items.Add('Laplacian');
radiogroup1.Items.Add('Gaussian');
radiogroup1.Items.Add('Deconvolution');
radiogroup1.Items.Add('Unsharp');
radiogroup1.ItemIndex := 2;
radiogroup2.Items.Add('No1');
radiogroup2.Items.Add('No2');
radiogroup2.Items.Add('No3');
radiogroup2.Items.Add('No4');
radiogroup2.Items.Add('No5');
radiogroup2.ItemIndex := 0;
radiogroup1.Enabled := False;
MaskingBtn.Enabled := False;
FileSaveBtn.Enabled := False;
sourceBtn.Enabled := False;
RepaintBtn.Enabled := False;
fulbtn.Enabled := False;
TrimmingBtn.Enabled := False;
checkbox1.Enabled := False;
OPT := 0; // OPT = 1 光学的ＦＦＴ（直流分が中央）
end;
// 終了処理
procedure TForm1.FormDestroy(Sender: TObject);
begin
InputDBitmap.Free; // bitmapの開放
OutputBitmap.Free; // bitmapの開放
end;
end.
FftDeconvolution.zip
画像処理一覧へ戻る
最初に戻る