バイキュービック法(bicubic)で画像を拡大縮小(VCL) ～Delphiソースコード集
(参考)バイキュービック法（bicubic）で拡大縮小する(FMX)
(参考)バイラテラルフィルタ（bilateral filter）で美肌に加工(VCL)
(参考)バイラテラルフィルタ（bilateral filter）で美肌に加工(FMX)
(参考)ソーベルフィルタ（Sobel filter）で境界（エッジ）検出(VCL)
バイキュービック法を使用する為のファイルの準備
本ページの下部のソースコードをコピーして「UMamBicubic.pas」ファイルを作成し、 プロジェクトフォルダ内に入れる。ソースコードの記述
プロジェクトを新規作成（VCLアプリケーション）し、フォーム(Form1)にTImageを2個、TButtonを1個配置する。Image1のPictureプロパティから、バイキュービック法で拡大縮小を適用したい画像をロードしておく。
TButton1をダブルクリックして、以下ソースコードを記述する。
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Imaging.jpeg,
Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses UMamBicubic;
procedure TForm1.Button1Click(Sender: TObject);
var bmp,sbmp,dbmp:TBitmap;
begin
bmp:=TBitmap.Create;
bmp.Assign(Image1.Picture.Graphic);
Image2.Picture.Bitmap.Width:=400; //リサイズする幅
Image2.Picture.Bitmap.Height:=400; //リサイズする高さ
MamBicubic(bmp,Image2.Picture.Bitmap,TMamBicubicType.Bicubic4x4);
bmp.free;
end;
end.
実行する
実行ボタンを押して実行します。（デバッグ実行でもOK）Button1をクリックすると、Image1写真画像をバイキュービック法で拡大縮小した画像をImage2に表示します。
「UMamBicubic.pas」ファイルのソースコード
unit UMamBicubic;
interface
uses Vcl.Graphics,System.Math;
Type
TMamBicubicType=(Bicubic4x4,Bicubic6x6);
procedure MamBicubic(source,dest:TBitmap;
BicubicType:TMamBicubicType=TMamBicubicType.Bicubic4x4);
implementation
Type
TRRGB=record B,G,R:Extended; end;
TRGB =record B,G,R:byte; end;
TRGBArr=array[0..32767] of TRGB;
PRGBArr=^TRGBArr;
TRGBArrArr=array[0..32767] of PRGBArr;
//バイキュービック4x4の距離による重み定数
Function MamBicubicWeight4x4(d:Extended):Extended;
const a:Extended=-1.0; //シャープの強さ -0.5(弱) ～ -1.0(強)の値を与える
begin
if d<0 then
begin
result:=0;
end
else if d<=1 then
result:= (a+2)*d*d*d - (a+3)*d*d + 1
else if d<=2 then
result:= a*d*d*d - 5*a*d*d + 8*a*d - 4*a
else
result:=0;
end;
//バイキュービック6x6の距離による重み定数
Function MamBicubicWeight6x6(d:Extended):Extended;
begin
if d<0 then
begin
result:=0;
end
else if d<=1 then
result:= 4*d*d*d/3 - 7*d*d/3 + 1
else if d<2 then
result:= -7*d*d*d/12 + 3*d*d - 59*d/12 + 5/2
else if d<3 then
result:= d*d*d/12 - 2*d*d/3 + 7*d/4 - 3/2
else
result:=0;
end;
//sourceをdestに拡大縮小する。
//適用後画像サイズはdest.width,dest.heightに事前に設定しておく
procedure MamBicubic(source,dest:TBitmap;
BicubicType:TMamBicubicType=TMamBicubicType.Bicubic4x4);
var sw,sh:Extended;//拡大率縮小率
dx,dy:Integer;//dest x,y座標
sx,sy:Extended;//destからsourceへの変換後 x,y座標の小数
tsx,tsy:Integer;//destからsourceへの変換後 x,y座標の整数
tsxx,tsyy:Integer;
x,y:Integer;
w:Extended; //BicubicのWeight
rrgb:TRRGB;
m:array of array of Extended;//4x4 or 6x6
mn:Integer; //4 or 6
saa,daa:TRGBArrArr;
sum:Extended;
begin
if not Assigned(source) then exit;
if not Assigned(dest) then exit;
source.PixelFormat:=pf24bit;
dest.PixelFormat:=pf24bit;
sw:=source.Width /dest.Width ;
sh:=source.Height/dest.Height;
for y := 0 to source.Height-1 do
saa[y]:=source.ScanLine[y];
for y := 0 to dest.Height-1 do
daa[y]:=dest.ScanLine[y];
if BicubicType=TMamBicubicType.Bicubic4x4 then
mn:=4
else
mn:=6;
setlength(m,mn);
for x := 0 to mn-1 do
setlength(m[x],mn);
for dy := 0 to dest.Height-1 do
begin
for dx := 0 to dest.Width-1 do
begin
sx:=dx*sw;
sy:=dy*sh;
tsx:=trunc(sx);
tsy:=trunc(sy);
rrgb.R:=0;
rrgb.G:=0;
rrgb.B:=0;
sum:=0;
for y := 0 to mn-1 do
begin
for x := 0 to mn-1 do
begin
tsxx:=tsx+x-(mn div 2 -1);
tsyy:=tsy+y-(mn div 2 -1);
if not((tsxx<0) or (tsxx>=source.Width) or
(tsyy<0) or (tsyy>=source.Height)) then
begin
if mn=4 then
w:=MamBicubicWeight4x4(
sqrt((tsxx-sx)*(tsxx-sx)+(tsyy-sy)*(tsyy-sy))
)
else
w:=MamBicubicWeight6x6(
sqrt((tsxx-sx)*(tsxx-sx)+(tsyy-sy)*(tsyy-sy))
);
m[x,y]:=w;
sum:=sum+w;
end;
end;
end;
for y := 0 to mn-1 do
begin
for x := 0 to mn-1 do
begin
tsxx:=tsx+x-(mn div 2 -1);
tsyy:=tsy+y-(mn div 2 -1);
if not((tsxx<0) or (tsxx>=source.Width) or
(tsyy<0) or (tsyy>=source.Height)) then
begin
m[x,y]:=m[x,y]/sum;
rrgb.R:=rrgb.R+saa[tsyy,tsxx].R*m[x,y];
rrgb.G:=rrgb.G+saa[tsyy,tsxx].G*m[x,y];
rrgb.B:=rrgb.B+saa[tsyy,tsxx].B*m[x,y];
end;
end;
end;
if rrgb.R>255 then rrgb.R:=255;
if rrgb.G>255 then rrgb.G:=255;
if rrgb.B>255 then rrgb.B:=255;
if rrgb.R<0 then rrgb.R:=0;
if rrgb.G<0 then rrgb.G:=0;
if rrgb.B<0 then rrgb.B:=0;
daa[dy,dx].R:=round(rrgb.R);
daa[dy,dx].G:=round(rrgb.G);
daa[dy,dx].B:=round(rrgb.B);
end;
end;
end;
end.