画像(TBitmap)にアンシャープマスク(鮮鋭化)、ガウシアンぼかし(ノイズ除去ぼかし)、ぼかし(平滑化、平均化)、メディアンフィルタ(スパイク[ゴマ塩]ノイズ除去)、グレースケール変換、フィルターを適用する(FMX) ~Delphiでお手軽プログラミング

画像(TBitmap)にアンシャープマスク(鮮鋭化)、ガウシアンぼかし(ノイズ除去ぼかし)、ぼかし(平滑化、平均化)、メディアンフィルタ(スパイク[ゴマ塩]ノイズ除去)、グレースケール変換、フィルターを適用する(FMX) ~Delphiでお手軽プログラミング

(参考)バイキュービック法(bicubic)で拡大縮小する(VCL)
(参考)バイキュービック法(bicubic)で拡大縮小する(FMX)
(参考)バイラテラルフィルタ(bilateral filter)で美肌に加工(VCL)
(参考)バイラテラルフィルタ(bilateral filter)で美肌に加工(FMX)
(参考)ソーベルフィルタ(Sobel filter)で境界(エッジ)検出(VCL)

画像フィルターを使用する為のファイルの準備

本ページの下部のソースコードをコピーして「UFMXMamBasicFilter.pas」ファイルを作成し、 プロジェクトフォルダ内に入れる。

ソースコードの記述

プロジェクトを新規作成(FMXアプリケーション)し、フォーム(Form1)にTImageを2個、TButtonを5個配置する。
Image1のPictureプロパティから、フィルタを適用したい画像をロードしておく。
画像には、スパイクノイズ(ごま塩ノイズ)を意図的に入れたものを使用した
Button1、Button2、Button3、Button4、Button5をダブルクリックして、以下ソースコードを記述する。
unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { private 宣言 }
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses UFMXMamBasicFilter;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //Image1をグレースケールにしてImage2に表示
  MamGrayScale(Image1.Bitmap,Image2.Bitmap);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //Image1にアンシャープマスク(鮮鋭化)を適用してImage2に表示
  MamUnSharp(Image1.Bitmap,Image2.Bitmap,3);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  //Image1にガウシアンぼかし(ノイズ除去ぼかし)を適用してImage2に表示
  MamGaussian(Image1.Bitmap,Image2.Bitmap,TMamGaussian.Gaussian5x5);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  //Image1にぼかし(平滑化、平均化)を適用してImage2に表示
  MamBlur(Image1.Bitmap,Image2.Bitmap,2);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  //Image1にメディアンフィルタ(スパイク[ゴマ塩]ノイズの除去に有効)を
  MamMedian(Image1.Bitmap,Image2.Bitmap,1);
end;

end.

実行する

実行ボタンを押して実行します。(デバッグ実行でもOK)

Button1をクリックすると、Image1写真画像をグレースケール画像に変換してImage2に表示します。

Button2をクリックすると、Image1写真画像にアンシャープマスク(鮮鋭化)を適用してImage2に表示します。

Button3をクリックすると、Image1写真画像にガウシアンぼかし(ノイズ除去ぼかし)を適用してImage2に表示します。

Button4をクリックすると、Image1写真画像にぼかし(平滑化、平均化)を適用してImage2に表示します。

Button5をクリックすると、Image1写真画像にメディアンフィルタ(スパイク[ゴマ塩]ノイズの除去に有効)を適用してImage2に表示します。

「UFMXMamBasicFilter.pas」ファイルのソースコード

unit UFMXMamBasicFilter;

interface

uses System.Types,System.UITypes, System.Math,
     System.Generics.Collections, System.Generics.Defaults,
     FMX.Graphics, FMX.Types;

Type
  TMamGaussian=(Gaussian3x3, Gaussian5x5, Gaussian7x7);
  TMedian=record
    v:Byte;
    x:Integer;
    y:Integer;
  end;

//src画像のグレースケール画像をdestに作成する
procedure MamGrayScale(src,dest:FMX.Graphics.TBitmap);

//src画像にアンシャープマスク(鮮鋭化)を適用しdestに作成
//(Strength:0.1~10.0)
procedure MamUnSharp(src,dest:FMX.Graphics.TBitmap;Strength:Single=1);

//src画像にガウシアンぼかし(ノイズ除去ぼかし)を適用してdestに作成
procedure MamGaussian(src,dest:FMX.Graphics.TBitmap;
  sm:TMamGaussian=TMamGaussian.Gaussian5x5);

//src画像にぼかし(平滑化、平均化)を適用してdestに作成
//(Strength:1~20)
procedure MamBlur(src,dest:FMX.Graphics.TBitmap;Strength:Integer=2);

//メディアンフィルタ(スパイク[ゴマ塩]ノイズの除去に有効)
//(Strength:1~4)
procedure MamMedian(src,dest:FMX.Graphics.TBitmap;Strength:Integer=1);

implementation

Type
  TSRGBA=record B,G,R,A:Single; end;

  TRGBA=record B,G,R,A:Byte; end;
  TRGBAArr=array[0..64535 div 2] of TRGBA;
  PRGBAArr=^TRGBAArr;
  TRGBAArrArr=array[0..64535 div 2] of PRGBAArr;


  TMn=array of array of single;
  TGauss=array of array of single;

const
  //ガウシアンフィルタ係数配列
  gauss3:array[0..2]of array[0..2]of single=
    (
      (1,2,1),(2,4,2),(1,2,1)
    );
  gauss5:array[0..4]of array[0..4]of single=
    (
      ( 1, 4, 6, 4, 1), ( 4,16,24,16, 4), ( 6,24,36,24, 6),
      ( 4,16,24,16, 4), ( 1, 4, 6, 4, 1)
    );
  gauss7:array[0..6]of array[0..6] of single=
    (
      ( 1,  6, 15, 20, 15,  6, 1), ( 6, 36, 90,120, 90, 36, 6),
      (15, 90,225,300,225, 90,15), (20,120,300,400,300,120,20),
      (15, 90,225,300,225, 90,15), ( 6, 36, 90,120, 90, 36, 6),
      ( 1,  6, 15, 20, 15,  6, 1)
    );

//Delphi標準のTArray.Sort(クイックソート)よりも速い
//コムソートを使用する
procedure CombSort(a:TArray<TMedian>);
  //二つの整数の値を入れ替える
  procedure SwapInt(var v1,v2:TMedian);
  var sw:TMedian;
  begin
    sw:=v1;
    v1:=v2;
    v2:=sw;
  end;
var between:Integer;//間隔
    i,l,h:integer;
begin
  l:=Low(a);
  h:=High(a);
  //初期の比較間隔
  between:=System.Math.Floor((h-l+1)/1.3);
  while between>0 do //比較間隔が0になったら終了
  begin
    i:=l;
    while h>=(i+between) do
    begin
      if a[i].v>a[i+between].v then
        SwapInt(a[i],a[i+between]);
      inc(i);
    end;
    //比較間隔を小さくする(1.3で割って切り捨て)
    between:=System.Math.Floor(between/1.3);
  end;
end;


//src画像のグレースケール画像をdestに作成する
procedure MamGrayScale(src,dest:FMX.Graphics.TBitmap);
var v:byte;
    x,y:integer;
    SrcBmp,DestBmp:TBitmap;//src,destの一時画像
    fRect:TRect;
    SrcData,DestData:TBitmapData;
    SrcRGBA,DestRGBA:PRGBAArr;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;

  fRect.Left:=0;
  fRect.Top:=0;
  fRect.Width:=src.Width;
  fRect.Height:=src.Height;

  //PixelFormatはTPixelFormat.BGRAがデフォルト
  SrcBmp:=FMX.Graphics.TBitmap.Create;
  DestBmp:=FMX.Graphics.TBitmap.Create;
  try
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;

    SrcBmp.Map(TMapAccess.Read,SrcData);
    DestBmp.Map(TMapAccess.Write,DestData);
    try
      for y := 0 to SrcBmp.Height-1 do
      begin
        SrcRGBA:=SrcData.GetScanline(y);
        DestRGBA:=DestData.GetScanline(y);
        for x := 0 to fRect.Width-1 do
        begin
          v:=Round(
            0.299*SrcRGBA[x].R+ 0.587*SrcRGBA[x].G+ 0.114*SrcRGBA[x].B
          );
          DestRGBA[x].R:=v;
          DestRGBA[x].G:=v;
          DestRGBA[x].B:=v;
          DestRGBA[x].A:=255;
        end;
      end;
    finally
      SrcBmp.Unmap(SrcData);
      DestBmp.Unmap(DestData);
    end;
    dest.Canvas.BeginScene();
    dest.Canvas.DrawBitmap(DestBmp,fRect,fRect,1,true);
    dest.Canvas.EndScene;
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;
end;

//src画像にアンシャープマスク(鮮鋭化)を適用しdestに作成
//(Strength:0.1~10.0)
procedure MamUnSharp(src,dest:FMX.Graphics.TBitmap;Strength:Single=1);
var m:array of array of Single;
    mn:Integer;
    num:Integer;
    x,y,i,j,xx,yy:Integer;
    fRect:TRect;
    SrcBmp,DestBmp:FMX.Graphics.TBitmap;//src,destの一時画像
    SrcData,DestData:TBitmapData;
    SrcRGBA,DestRGBA:TRGBAArrArr;
    fRGBA:TSRGBA;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;

  if Strength<0.1 then Strength:=0.1;
  if Strength>10 then Strength:=10;

  //行列の作成
  mn:=3;
  SetLength(m,mn);
  for i := Low(m) to High(m) do
    SetLength(m[i],mn);

  fRect.Left:=0;
  fRect.Top:=0;
  fRect.Width:=src.Width;
  fRect.Height:=src.Height;

  //PixelFormatはTPixelFormat.BGRAがデフォルト
  SrcBmp :=FMX.Graphics.TBitmap.Create;
  DestBmp:=FMX.Graphics.TBitmap.Create;
  try
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;
    //ビットマップのデータマップを取得
    SrcBmp.Map(TMapAccess.Read,SrcData);
    DestBmp.Map(TMapAccess.Write,DestData);
    try
      //スキャンラインの一括取得
      for j := 0 to fRect.Height-1 do
      begin
        SrcRGBA[j]:=SrcData.GetScanLine(j);
        DestRGBA[j]:=DestData.GetScanLine(j);
      end;

      for j := 0 to fRect.Height-1 do
      begin
        for i := 0 to fRect.Width-1 do
        begin
          fRGBA.R:=0;
          fRGBA.G:=0;
          fRGBA.B:=0;
          fRGBA.A:=255;
          //UnSharp行列の作成
          num:=0;
          for y := 0 to mn-1 do
          begin
            for x := 0 to mn-1 do
            begin
              xx:=i+x-(mn div 2);
              yy:=j+y-(mn div 2);
              if not ((xx<0) or
                      (xx>=fRect.Width) or
                      (yy<0) or
                      (yy>=fRect.Height)) then
              begin
                num:=num+1;
              end;
            end;
          end;
          for y := Low(m) to High(m) do
            for x := Low(m[y]) to High(m[y]) do
              m[y][x]:=-Strength/num;
          m[1][1]:=1+(num-1)*Strength/num;

          for y := 0 to mn-1 do
          begin
            for x := 0 to mn-1 do
            begin
              xx:=i+x-(mn div 2);
              yy:=j+y-(mn div 2);
              if not ((xx<0) or
                      (xx>=fRect.Width) or
                      (yy<0) or
                      (yy>=fRect.Height)) then
              begin
                fRGBA.R:=fRGBA.R+m[y,x]*SrcRGBA[yy][xx].R;
                fRGBA.G:=fRGBA.G+m[y,x]*SrcRGBA[yy][xx].G;
                fRGBA.B:=fRGBA.B+m[y,x]*SrcRGBA[yy][xx].B;
              end;
            end;
          end;
          if fRGBA.R>255 then fRGBA.R:=255;
          if fRGBA.G>255 then fRGBA.G:=255;
          if fRGBA.B>255 then fRGBA.B:=255;
          if fRGBA.R<0 then fRGBA.R:=0;
          if fRGBA.G<0 then fRGBA.G:=0;
          if fRGBA.B<0 then fRGBA.B:=0;

          DestRGBA[j][i].R:=Round(fRGBA.R);
          DestRGBA[j][i].G:=Round(fRGBA.G);
          DestRGBA[j][i].B:=Round(fRGBA.B);
          DestRGBA[j][i].A:=Round(fRGBA.A);
        end;
      end;
    finally
      SrcBmp.Unmap(SrcData);
      DestBmp.Unmap(DestData);
    end;
    dest.Canvas.BeginScene();
    dest.Canvas.DrawBitmap(DestBmp,fRect,fRect,1,true);
    dest.Canvas.EndScene;
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;
end;

//src画像にガウシアンぼかし(ノイズ除去ぼかし)を適用してdestに作成
procedure MamGaussian(src,dest:FMX.Graphics.TBitmap;
  sm:TMamGaussian=TMamGaussian.Gaussian5x5);
var m:array of array of Single;
    mn:Integer;
    sum:Single;
    x,y,i,j,xx,yy:Integer;
    fRect:TRect;
    SrcBmp,DestBmp:FMX.Graphics.TBitmap;//src,destの一時画像
    SrcData,DestData:TBitmapData;
    SrcRGBA,DestRGBA:TRGBAArrArr;
    fRGBA:TSRGBA;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;

  //行列の作成
  mn:=3;
  if sm=TMamGaussian.Gaussian5x5 then mn:=5;
  if sm=TMamGaussian.Gaussian7x7 then mn:=7;
  SetLength(m,mn);
  for i := Low(m) to High(m) do
    SetLength(m[i],mn);

  fRect.Left:=0;
  fRect.Top:=0;
  fRect.Width:=src.Width;
  fRect.Height:=src.Height;

  //PixelFormatはTPixelFormat.BGRAがデフォルト
  SrcBmp :=FMX.Graphics.TBitmap.Create;
  DestBmp:=FMX.Graphics.TBitmap.Create;
  try
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;
    //ビットマップのデータマップを取得
    SrcBmp.Map(TMapAccess.Read,SrcData);
    DestBmp.Map(TMapAccess.Write,DestData);
    try
      //スキャンラインの一括取得
      for j := 0 to fRect.Height-1 do
      begin
        SrcRGBA[j]:=SrcData.GetScanLine(j);
        DestRGBA[j]:=DestData.GetScanLine(j);
      end;

      for j := 0 to fRect.Height-1 do
      begin
        for i := 0 to fRect.Width-1 do
        begin
          fRGBA.R:=0;
          fRGBA.G:=0;
          fRGBA.B:=0;
          fRGBA.A:=255;
          //UnSharp行列の作成
          sum:=0;
          for y := 0 to mn-1 do
          begin
            for x := 0 to mn-1 do
            begin
              xx:=i+x-(mn div 2);
              yy:=j+y-(mn div 2);
              if not ((xx<0) or
                      (xx>=fRect.Width) or
                      (yy<0) or
                      (yy>=fRect.Height)) then
              begin
              if mn=3 then sum:=sum+gauss3[y][x]
              else if mn=5 then sum:=sum+gauss5[y][x]
              else sum:=sum+gauss7[y][x];
              end;
            end;
          end;
          for y := Low(m) to High(m) do
          begin
            for x := Low(m[y]) to High(m[y]) do
            begin
              if mn=3 then m[y][x]:=gauss3[y][x]/sum
              else if mn=5 then m[y][x]:=gauss5[y][x]/sum
              else m[y][x]:=gauss7[y][x]/sum;
            end;
          end;

          for y := 0 to mn-1 do
          begin
            for x := 0 to mn-1 do
            begin
              xx:=i+x-(mn div 2);
              yy:=j+y-(mn div 2);
              if not ((xx<0) or
                      (xx>=fRect.Width) or
                      (yy<0) or
                      (yy>=fRect.Height)) then
              begin
                fRGBA.R:=fRGBA.R+m[y,x]*SrcRGBA[yy][xx].R;
                fRGBA.G:=fRGBA.G+m[y,x]*SrcRGBA[yy][xx].G;
                fRGBA.B:=fRGBA.B+m[y,x]*SrcRGBA[yy][xx].B;
              end;
            end;
          end;
          if fRGBA.R>255 then fRGBA.R:=255;
          if fRGBA.G>255 then fRGBA.G:=255;
          if fRGBA.B>255 then fRGBA.B:=255;
          if fRGBA.R<0 then fRGBA.R:=0;
          if fRGBA.G<0 then fRGBA.G:=0;
          if fRGBA.B<0 then fRGBA.B:=0;

          DestRGBA[j][i].R:=Round(fRGBA.R);
          DestRGBA[j][i].G:=Round(fRGBA.G);
          DestRGBA[j][i].B:=Round(fRGBA.B);
          DestRGBA[j][i].A:=Round(fRGBA.A);
        end;
      end;
    finally
      SrcBmp.Unmap(SrcData);
      DestBmp.Unmap(DestData);
    end;
    dest.Canvas.BeginScene();
    dest.Canvas.DrawBitmap(DestBmp,fRect,fRect,1,true);
    dest.Canvas.EndScene;
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;
end;

//src画像にぼかし(平滑化、平均化)を適用してdestに作成
//(Strength:1~20)
procedure MamBlur(src,dest:FMX.Graphics.TBitmap;Strength:Integer=2);
var mn:Integer;
    sum:Single;
    x,y,i,j,xx,yy:Integer;
    fRect:TRect;
    SrcBmp,DestBmp:FMX.Graphics.TBitmap;//src,destの一時画像
    SrcData,DestData:TBitmapData;
    SrcRGBA,DestRGBA:TRGBAArrArr;
    fRGBA:TSRGBA;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;

  if Strength<1 then Strength:=1;
  if Strength>20 then Strength:=20;

  mn:=Strength*2+1;

  fRect.Left:=0;
  fRect.Top:=0;
  fRect.Width:=src.Width;
  fRect.Height:=src.Height;

  //PixelFormatはTPixelFormat.BGRAがデフォルト
  SrcBmp :=FMX.Graphics.TBitmap.Create;
  DestBmp:=FMX.Graphics.TBitmap.Create;
  try
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;
    //ビットマップのデータマップを取得
    SrcBmp.Map(TMapAccess.Read,SrcData);
    DestBmp.Map(TMapAccess.Write,DestData);
    try
      //スキャンラインの一括取得
      for j := 0 to fRect.Height-1 do
      begin
        SrcRGBA[j]:=SrcData.GetScanLine(j);
        DestRGBA[j]:=DestData.GetScanLine(j);
      end;

      for j := 0 to fRect.Height-1 do
      begin
        for i := 0 to fRect.Width-1 do
        begin
          fRGBA.R:=0;
          fRGBA.G:=0;
          fRGBA.B:=0;
          fRGBA.A:=255;
          //UnSharp行列の作成
          sum:=0;
          for y := 0 to mn-1 do
          begin
            for x := 0 to mn-1 do
            begin
              xx:=i+x-(mn div 2);
              yy:=j+y-(mn div 2);
              if not ((xx<0) or
                      (xx>=fRect.Width) or
                      (yy<0) or
                      (yy>=fRect.Height)) then
              begin
                sum:=sum+1;
              end;
            end;
          end;
          for y := 0 to mn-1 do
          begin
            for x := 0 to mn-1 do
            begin
              xx:=i+x-(mn div 2);
              yy:=j+y-(mn div 2);
              if not ((xx<0) or
                      (xx>=fRect.Width) or
                      (yy<0) or
                      (yy>=fRect.Height)) then
              begin
                fRGBA.R:=fRGBA.R+SrcRGBA[yy][xx].R/sum;
                fRGBA.G:=fRGBA.G+SrcRGBA[yy][xx].G/sum;
                fRGBA.B:=fRGBA.B+SrcRGBA[yy][xx].B/sum;
              end;
            end;
          end;
          if fRGBA.R>255 then fRGBA.R:=255;
          if fRGBA.G>255 then fRGBA.G:=255;
          if fRGBA.B>255 then fRGBA.B:=255;
          if fRGBA.R<0 then fRGBA.R:=0;
          if fRGBA.G<0 then fRGBA.G:=0;
          if fRGBA.B<0 then fRGBA.B:=0;

          DestRGBA[j][i].R:=Round(fRGBA.R);
          DestRGBA[j][i].G:=Round(fRGBA.G);
          DestRGBA[j][i].B:=Round(fRGBA.B);
          DestRGBA[j][i].A:=Round(fRGBA.A);
        end;
      end;
    finally
      SrcBmp.Unmap(SrcData);
      DestBmp.Unmap(DestData);
    end;
    dest.Canvas.BeginScene();
    dest.Canvas.DrawBitmap(DestBmp,fRect,fRect,1,true);
    dest.Canvas.EndScene;
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;
end;

//メディアンフィルタ(スパイク[ゴマ塩]ノイズの除去に有効)
//(Strength:1~4)
procedure MamMedian(src,dest:FMX.Graphics.TBitmap;Strength:Integer=1);
var mn:Integer;
    Num:Integer;
    x,y,i,j,xx,yy:Integer;
    fRect:TRect;
    SrcBmp,DestBmp,GrayBmp:FMX.Graphics.TBitmap;//src,destの一時画像
    SrcData,DestData,GrayData:TBitmapData;
    SrcRGBA,DestRGBA,GrayRGBA:TRGBAArrArr;
    fRGBA:TSRGBA;
    fMedian:TArray<TMedian>;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;

  if Strength<1 then Strength:=1;
  if Strength>4 then Strength:=4;

  mn:=Strength*2+1;

  fRect.Left:=0;
  fRect.Top:=0;
  fRect.Width:=src.Width;
  fRect.Height:=src.Height;

  //PixelFormatはTPixelFormat.BGRAがデフォルト
  SrcBmp :=FMX.Graphics.TBitmap.Create;
  DestBmp:=FMX.Graphics.TBitmap.Create;
  GrayBmp:=FMX.Graphics.TBitmap.Create;
  try
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    GrayBmp.Width:=fRect.Width;
    GrayBmp.Height:=fRect.Height;
    MamGrayScale(SrcBmp,GrayBmp);
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;
    //ビットマップのデータマップを取得
    SrcBmp.Map(TMapAccess.Read,SrcData);
    DestBmp.Map(TMapAccess.Write,DestData);
    GrayBmp.Map(TMapAccess.Read,GrayData);
    try
      //スキャンラインの一括取得
      for j := 0 to fRect.Height-1 do
      begin
        SrcRGBA[j]:=SrcData.GetScanLine(j);
        DestRGBA[j]:=DestData.GetScanLine(j);
        GrayRGBA[j]:=GrayData.GetScanline(j);
      end;

      for j := 0 to fRect.Height-1 do
      begin
        for i := 0 to fRect.Width-1 do
        begin
          fRGBA.R:=0;
          fRGBA.G:=0;
          fRGBA.B:=0;
          fRGBA.A:=255;
          //UnSharp行列の作成
          Num:=0;
          for y := 0 to mn-1 do
          begin
            for x := 0 to mn-1 do
            begin
              xx:=i+x-(mn div 2);
              yy:=j+y-(mn div 2);
              if not ((xx<0) or
                      (xx>=fRect.Width) or
                      (yy<0) or
                      (yy>=fRect.Height)) then
              begin
                Num:=Num+1;
                SetLength(fMedian,Num);
                fMedian[Num-1].v:=GrayRGBA[yy][xx].R;
                fMedian[Num-1].x:=xx;
                fMedian[Num-1].y:=yy;
              end;
            end;
          end;

          //Delphi標準のTArray.Sort(クイックソート)より速いコムソートを使って
          //配列 TArray<TMedian>を並び替える
          CombSort(fMedian);

          fRGBA.R:=SrcRGBA[fMedian[Num Div 2].y][fMedian[Num Div 2].x].R;
          fRGBA.G:=SrcRGBA[fMedian[Num Div 2].y][fMedian[Num Div 2].x].G;
          fRGBA.B:=SrcRGBA[fMedian[Num Div 2].y][fMedian[Num Div 2].x].B;
          fRGBA.A:=255;

          DestRGBA[j][i].R:=Round(fRGBA.R);
          DestRGBA[j][i].G:=Round(fRGBA.G);
          DestRGBA[j][i].B:=Round(fRGBA.B);
          DestRGBA[j][i].A:=Round(fRGBA.A);
        end;
      end;
    finally
      SrcBmp.Unmap(SrcData);
      DestBmp.Unmap(DestData);
      GrayBmp.Unmap(GrayData);
    end;
    dest.Canvas.BeginScene();
    dest.Canvas.DrawBitmap(DestBmp,fRect,fRect,1,true);
    dest.Canvas.EndScene;
  finally
    SrcBmp.Free;
    DestBmp.Free;
    GrayBmp.Free;
  end;
end;

end.