トップへ(mam-mam.net/)

画像にアンシャープ,ガウシアン,ぼかし,ゴマ塩ノイズ除去(FMX) ～Delphiソースコード集

画像にアンシャープ,ガウシアン,ぼかし,ゴマ塩ノイズ除去(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(var a:Array Of 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;
  dest.SetSize(src.Width,src.Height);
  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.SetSize(fRect.Width,fRect.Height);
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.SetSize(fRect.Width,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,center:Integer;
    x,y,i,j,xx,yy:Integer;
    fRect:TRect;
    SrcBmp,DestBmp:FMX.Graphics.TBitmap;//src,destの一時画像
    SrcData,DestData:TBitmapData;
    SrcRGBA,DestRGBA:TRGBAArrArr;
    fSRGBA:TSRGBA;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;
  dest.SetSize(src.Width,src.Height);

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

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

  mn:=3;
  center:=(mn-1) div 2;
  //アンシャープマスク カーネルの作成
  SetLength(m,mn);
  for y := Low(m) to High(m) do
  begin
    SetLength(m[y],mn);
    for x := Low(m[y]) to High(m[y]) do
    begin
      if (y=center)and(x=center) then
        m[y][x]:=1+8*Strength/9
      else
        m[y][x]:=-Strength/9;
    end;
  end;

  //PixelFormatはTPixelFormat.BGRAがデフォルト
  SrcBmp :=FMX.Graphics.TBitmap.Create;
  DestBmp:=FMX.Graphics.TBitmap.Create;
  try
    SrcBmp.SetSize(fRect.Width,fRect.Height);
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.SetSize(fRect.Width,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
          fSRGBA.R:=0;
          fSRGBA.G:=0;
          fSRGBA.B:=0;
          fSRGBA.A:=255;
          for y := 0 to mn-1 do
          begin
            for x := 0 to mn-1 do
            begin
              yy:=j+(y-center);
              if (yy<0)or(yy>=fRect.Height) then
                yy:=j-(y-center);
              xx:=i+(x-center);
              if (xx<0)or(xx>=fRect.Width) then
                xx:=i-(x-center);
              fSRGBA.R:=fSRGBA.R+m[y][x]*SrcRGBA[yy][xx].R;
              fSRGBA.G:=fSRGBA.G+m[y][x]*SrcRGBA[yy][xx].G;
              fSRGBA.B:=fSRGBA.B+m[y][x]*SrcRGBA[yy][xx].B;
            end;
          end;
          if fSRGBA.R>255 then fSRGBA.R:=255;
          if fSRGBA.G>255 then fSRGBA.G:=255;
          if fSRGBA.B>255 then fSRGBA.B:=255;
          if fSRGBA.R<0 then fSRGBA.R:=0;
          if fSRGBA.G<0 then fSRGBA.G:=0;
          if fSRGBA.B<0 then fSRGBA.B:=0;

          DestRGBA[j][i].R:=Round(fSRGBA.R);
          DestRGBA[j][i].G:=Round(fSRGBA.G);
          DestRGBA[j][i].B:=Round(fSRGBA.B);
          DestRGBA[j][i].A:=Round(fSRGBA.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,center:Integer;
    msum:Single;
    x,y,i,j,xx,yy:Integer;
    fRect:TRect;
    SrcBmp,DestBmp:FMX.Graphics.TBitmap;//src,destの一時画像
    SrcData,DestData:TBitmapData;
    SrcRGBA,DestRGBA:TRGBAArrArr;
    fSRGBA:TSRGBA;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;
  dest.SetSize(src.Width,src.Height);

  //行列の作成
  mn:=3;
  msum:=0;
  if sm=TMamGaussian.Gaussian5x5 then mn:=5;
  if sm=TMamGaussian.Gaussian7x7 then mn:=7;
  SetLength(m,mn);
  for j := Low(m) to High(m) do
  begin
    SetLength(m[j],mn);
    for i := Low(m[j]) to High(m[j]) do
    begin
      if mn=3 then
      begin
        m[j][i]:=gauss3[j][i];
        msum:=msum+gauss3[j][i];
      end
      else if mn=5 then
      begin
        m[j][i]:=gauss5[j][i];
        msum:=msum+gauss5[j][i];
      end
      else
      begin
        m[j][i]:=gauss7[j][i];
        msum:=msum+gauss7[j][i];
      end;
    end;
  end;
  center:=(mn-1) div 2;
  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.SetSize(fRect.Width,fRect.Height);
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.SetSize(fRect.Width,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
          fSRGBA.R:=0;
          fSRGBA.G:=0;
          fSRGBA.B:=0;
          fSRGBA.A:=255;
          //UnSharp行列の作成
          for y := 0 to mn-1 do
          begin
            for x := 0 to mn-1 do
            begin
              yy:=j+(y-center);
              if (yy<0)or(yy>=fRect.Height) then
                yy:=j-(y-center);
              xx:=i+(x-center);
              if (xx<0)or(xx>=fRect.Width) then
                xx:=i-(x-center);
              fSRGBA.R:=fSRGBA.R+m[y,x]*SrcRGBA[yy][xx].R/msum;
              fSRGBA.G:=fSRGBA.G+m[y,x]*SrcRGBA[yy][xx].G/msum;
              fSRGBA.B:=fSRGBA.B+m[y,x]*SrcRGBA[yy][xx].B/msum;
            end;
          end;
          if fSRGBA.R>255 then fSRGBA.R:=255;
          if fSRGBA.G>255 then fSRGBA.G:=255;
          if fSRGBA.B>255 then fSRGBA.B:=255;
          if fsRGBA.R<0 then fSRGBA.R:=0;
          if fSRGBA.G<0 then fSRGBA.G:=0;
          if fSRGBA.B<0 then fSRGBA.B:=0;

          DestRGBA[j][i].R:=Round(fSRGBA.R);
          DestRGBA[j][i].G:=Round(fSRGBA.G);
          DestRGBA[j][i].B:=Round(fSRGBA.B);
          DestRGBA[j][i].A:=Round(fSRGBA.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,center:Integer;
    x,y,i,j,xx,yy:Integer;
    fRect:TRect;
    SrcBmp,DestBmp:FMX.Graphics.TBitmap;//src,destの一時画像
    SrcData,DestData:TBitmapData;
    SrcRGBA,DestRGBA:TRGBAArrArr;
    fSRGBA:TSRGBA;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;
    dest.SetSize(src.Width,src.Height);

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

  mn:=Strength*2+1;
  center:=(mn-1) div 2;

  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.SetSize(fRect.Width,fRect.Height);
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.SetSize(fRect.Width,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
          fSRGBA.R:=0;
          fSRGBA.G:=0;
          fSRGBA.B:=0;
          fSRGBA.A:=255;
          for y := 0 to mn-1 do
          begin
            for x := 0 to mn-1 do
            begin
              yy:=j+(y-center);
              if (yy<0)or(yy>=fRect.Height) then
                yy:=j-(y-center);
              xx:=i+(x-center);
              if (xx<0)or(xx>=fRect.Width) then
                xx:=i-(x-center);
              fSRGBA.R:=fSRGBA.R+SrcRGBA[yy][xx].R/mn/mn;
              fSRGBA.G:=fSRGBA.G+SrcRGBA[yy][xx].G/mn/mn;
              fSRGBA.B:=fSRGBA.B+SrcRGBA[yy][xx].B/mn/mn;
            end;
          end;
          if fSRGBA.R>255 then fSRGBA.R:=255;
          if fSRGBA.G>255 then fSRGBA.G:=255;
          if fSRGBA.B>255 then fSRGBA.B:=255;
          if fSRGBA.R<0 then fSRGBA.R:=0;
          if fSRGBA.G<0 then fSRGBA.G:=0;
          if fSRGBA.B<0 then fSRGBA.B:=0;

          DestRGBA[j][i].R:=Round(fSRGBA.R);
          DestRGBA[j][i].G:=Round(fSRGBA.G);
          DestRGBA[j][i].B:=Round(fSRGBA.B);
          DestRGBA[j][i].A:=Round(fSRGBA.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;
    fMedian:TArray<TMedian>;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=FMX.Graphics.TBitmap.Create;
  dest.SetSize(src.Width,src.Height);

  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.SetSize(fRect.Width,fRect.Height);
    SrcBmp.Canvas.BeginScene();
    SrcBmp.Canvas.DrawBitmap(src,fRect,fRect,1,true);
    SrcBmp.Canvas.EndScene;
    DestBmp.SetSize(fRect.Width,fRect.Height);
    GrayBmp.SetSize(fRect.Width,fRect.Height);
    MamGrayScale(SrcBmp,GrayBmp);
    //ビットマップのデータマップを取得
    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
          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;
          CombSort(fMedian);

          DestRGBA[j][i].R:=SrcRGBA[fMedian[Num Div 2].y][fMedian[Num Div 2].x].R;
          DestRGBA[j][i].G:=SrcRGBA[fMedian[Num Div 2].y][fMedian[Num Div 2].x].G;
          DestRGBA[j][i].B:=SrcRGBA[fMedian[Num Div 2].y][fMedian[Num Div 2].x].B;
          DestRGBA[j][i].A:=255;
        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.