バイキュービック法(bicubic)で画像を拡大縮小(VCL) ～Delphiソースコード集

バイキュービック法を使用する為のファイルの準備

本ページの下部のソースコードをコピーして「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.