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

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

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

ソースコードの記述

プロジェクトを新規作成（VCLアプリケーション）し、フォーム(Form1)にTImageを2個、TButtonを5個配置する。
Image1のPictureプロパティから、フィルタを適用したい画像をロードしておく。
画像には、スパイクノイズ（ごま塩ノイズ）を意図的に入れたものを使用した

Button1、Button2、Button3、Button4、Button5をダブルクリックして、以下ソースコードを記述する。

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.ExtCtrls,
  Vcl.Imaging.jpeg, VCL.Imaging.pngimage;

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 *.dfm}

uses UMamBasicFilter;

procedure TForm1.Button1Click(Sender: TObject);
var bmp:TBitmap;
begin
  //Image1をグレースケールにしてImage2に表示
  bmp:=TBitmap.Create;
  try
    bmp.Assign(Image1.Picture.Graphic);
    MamGrayScale(bmp,Image2.Picture.Bitmap);
  finally
    bmp.Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var bmp:TBitmap;
begin
  //Image1にアンシャープマスク(鮮鋭化)を適用してImage2に表示
  bmp:=TBitmap.Create;
  try
    bmp.Assign(Image1.Picture.Graphic);
    MamUnSharp(bmp,Image2.Picture.Bitmap,2);
  finally
    bmp.Free;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var bmp:TBitmap;
begin
  //Image1にガウシアンぼかし(ノイズ除去ぼかし)を適用してImage2に表示
  bmp:=TBitmap.Create;
  try
    bmp.Assign(Image1.Picture.Graphic);
MamGaussian(bmp,Image2.Picture.Bitmap,TMamGaussian.Gaussian5x5);
  finally
    bmp.Free;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var bmp:TBitmap;
begin
  //Image1にぼかし(平滑化、平均化)を適用してImage2に表示
  bmp:=TBitmap.Create;
  try
    bmp.Assign(Image1.Picture.Graphic);
    MamBlur(bmp,Image2.Picture.Bitmap,2);
  finally
    bmp.Free;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var bmp:TBitmap;
begin
  //Image1にメディアンフィルタ(スパイク[ゴマ塩]ノイズの除去に有効)を
  //適用してImage2に表示
  bmp:=TBitmap.Create;
  try
    bmp.Assign(Image1.Picture.Graphic);
    MamMedian(bmp,Image2.Picture.Bitmap,1);
  finally
    bmp.Free;
  end;
end;

end.

実行する

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

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

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

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

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

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

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

unit UMamBasicFilter;

interface

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

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

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

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

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

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

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


implementation
Type
  TSRGB=record B,G,R:Single; end;

  TRGB=record B,G,R:Byte; end;
  TRGBArr=array[0..65535] of TRGB;
  PRGBArr=^TRGBArr;
  TRGBArrArr=array[0..65535] of PRGBArr;

  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:VCL.Graphics.TBitmap);
var v:byte;
    x,y:integer;
    SrcBmp,DestBmp:TBitmap;//src,destの一時画像
    fRect:TRect;
    SrcRGB,DestRGB:PRGBArr;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=VCL.Graphics.TBitmap.Create;
  fRect.Left:=0;
  fRect.Top:=0;
  fRect.Width:=src.Width;
  fRect.Height:=src.Height;

  SrcBmp:=VCL.Graphics.TBitmap.Create;
  DestBmp:=VCL.Graphics.TBitmap.Create;
  try
    SrcBmp.PixelFormat:=pf24bit;
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.Draw(0,0,src);
    DestBmp.PixelFormat:=pf24bit;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;
    for y := 0 to SrcBmp.Height-1 do
    begin
      SrcRGB:=SrcBmp.Scanline[y];
      DestRGB:=DestBmp.Scanline[y];
      for x := 0 to fRect.Width-1 do
      begin
        v:=Round(
          0.299*SrcRGB[x].R+ 0.587*SrcRGB[x].G+ 0.114*SrcRGB[x].B
        );
        DestRGB[x].R:=v;
        DestRGB[x].G:=v;
        DestRGB[x].B:=v;
      end;
    end;
    dest.Canvas.Draw(0,0,DestBmp);
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;
end;

//src画像にアンシャープマスク(鮮鋭化)を適用しdestに作成
//(Strength：0.1～10.0)
procedure MamUnSharp(src,dest:VCL.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:VCL.Graphics.TBitmap;//src,destの一時画像
    SrcRGB,DestRGB:TRGBArrArr;
    fSRGB:TSRGB;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=VCL.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;

  SrcBmp :=VCL.Graphics.TBitmap.Create;
  DestBmp:=VCL.Graphics.TBitmap.Create;
  try
    SrcBmp.PixelFormat:=pf24bit;
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.Draw(0,0,src);
    DestBmp.PixelFormat:=pf24bit;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;

    //スキャンラインの一括取得
    for j := 0 to fRect.Height-1 do
    begin
      SrcRGB[j]:=SrcBmp.ScanLine[j];
      DestRGB[j]:=DestBmp.ScanLine[j];
    end;

    for j := 0 to fRect.Height-1 do
    begin
      for i := 0 to fRect.Width-1 do
      begin
        fSRGB.R:=0;
        fSRGB.G:=0;
        fSRGB.B:=0;
        //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
              fSRGB.R:=fSRGB.R+m[y,x]*SrcRGB[yy][xx].R;
              fSRGB.G:=fSRGB.G+m[y,x]*SrcRGB[yy][xx].G;
              fSRGB.B:=fSRGB.B+m[y,x]*SrcRGB[yy][xx].B;
            end;
          end;
        end;
        if fSRGB.R>255 then fSRGB.R:=255;
        if fSRGB.G>255 then fSRGB.G:=255;
        if fSRGB.B>255 then fSRGB.B:=255;
        if fSRGB.R<0 then fSRGB.R:=0;
        if fSRGB.G<0 then fSRGB.G:=0;
        if fSRGB.B<0 then fSRGB.B:=0;

        DestRGB[j][i].R:=Round(fSRGB.R);
        DestRGB[j][i].G:=Round(fSRGB.G);
        DestRGB[j][i].B:=Round(fSRGB.B);
      end;
    end;

    dest.Canvas.Draw(0,0,DestBmp);
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;
end;

//src画像にガウシアンぼかし(ノイズ除去ぼかし)を適用してdestに作成
procedure MamGaussian(src,dest:VCL.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:VCL.Graphics.TBitmap;//src,destの一時画像
    SrcRGB,DestRGB:TRGBArrArr;
    fSRGB:TSRGB;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=VCL.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;

  SrcBmp :=VCL.Graphics.TBitmap.Create;
  DestBmp:=VCL.Graphics.TBitmap.Create;
  try
    SrcBmp.PixelFormat:=pf24bit;
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.Draw(0,0,src);
    DestBmp.PixelFormat:=pf24bit;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;

    //スキャンラインの一括取得
    for j := 0 to fRect.Height-1 do
    begin
      SrcRGB[j]:=SrcBmp.ScanLine[j];
      DestRGB[j]:=DestBmp.ScanLine[j];
    end;

    for j := 0 to fRect.Height-1 do
    begin
      for i := 0 to fRect.Width-1 do
      begin
        fSRGB.R:=0;
        fSRGB.G:=0;
        fSRGB.B:=0;
        //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
              fSRGB.R:=fSRGB.R+m[y,x]*SrcRGB[yy][xx].R;
              fSRGB.G:=fSRGB.G+m[y,x]*SrcRGB[yy][xx].G;
              fSRGB.B:=fSRGB.B+m[y,x]*SrcRGB[yy][xx].B;
            end;
          end;
        end;
        if fSRGB.R>255 then fSRGB.R:=255;
        if fSRGB.G>255 then fSRGB.G:=255;
        if fSRGB.B>255 then fSRGB.B:=255;
        if fSRGB.R<0 then fSRGB.R:=0;
        if fSRGB.G<0 then fSRGB.G:=0;
        if fSRGB.B<0 then fSRGB.B:=0;

        DestRGB[j][i].R:=Round(fSRGB.R);
        DestRGB[j][i].G:=Round(fSRGB.G);
        DestRGB[j][i].B:=Round(fSRGB.B);
      end;
    end;

    dest.Canvas.Draw(0,0,DestBmp);
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;

end;

//src画像にぼかし(平滑化、平均化)を適用してdestに作成
//(Strength:1～20)
procedure MamBlur(src,dest:VCL.Graphics.TBitmap;Strength:Integer=2);
var mn:Integer;
    sum:Single;
    x,y,i,j,xx,yy:Integer;
    fRect:TRect;
    SrcBmp,DestBmp:VCL.Graphics.TBitmap;//src,destの一時画像
    SrcRGB,DestRGB:TRGBArrArr;
    fSRGB:TSRGB;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=VCL.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;

  SrcBmp :=VCL.Graphics.TBitmap.Create;
  DestBmp:=VCL.Graphics.TBitmap.Create;
  try
    SrcBmp.PixelFormat:=pf24bit;
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.Draw(0,0,src);
    DestBmp.PixelFormat:=pf24bit;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;

    //スキャンラインの一括取得
    for j := 0 to fRect.Height-1 do
    begin
      SrcRGB[j]:=SrcBmp.ScanLine[j];
      DestRGB[j]:=DestBmp.ScanLine[j];
    end;

    for j := 0 to fRect.Height-1 do
    begin
      for i := 0 to fRect.Width-1 do
      begin
        fSRGB.R:=0;
        fSRGB.G:=0;
        fSRGB.B:=0;
        //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
              fSRGB.R:=fSRGB.R+SrcRGB[yy][xx].R/sum;
              fSRGB.G:=fSRGB.G+SrcRGB[yy][xx].G/sum;
              fSRGB.B:=fSRGB.B+SrcRGB[yy][xx].B/sum;
            end;
          end;
        end;
        if fSRGB.R>255 then fSRGB.R:=255;
        if fSRGB.G>255 then fSRGB.G:=255;
        if fSRGB.B>255 then fSRGB.B:=255;
        if fSRGB.R<0 then fSRGB.R:=0;
        if fSRGB.G<0 then fSRGB.G:=0;
        if fSRGB.B<0 then fSRGB.B:=0;

        DestRGB[j][i].R:=Round(fSRGB.R);
        DestRGB[j][i].G:=Round(fSRGB.G);
        DestRGB[j][i].B:=Round(fSRGB.B);
      end;
    end;

    dest.Canvas.Draw(0,0,DestBmp);
  finally
    SrcBmp.Free;
    DestBmp.Free;
  end;
end;

//メディアンフィルタ(スパイク[ゴマ塩]ノイズの除去に有効)
//(Strength:1～4)
procedure MamMedian(src,dest:VCL.Graphics.TBitmap;Strength:Integer=1);
var mn:Integer;
    Num:Integer;
    x,y,i,j,xx,yy:Integer;
    fRect:TRect;
    SrcBmp,DestBmp,GrayBmp:VCL.Graphics.TBitmap;//src,destの一時画像
    SrcRGB,DestRGB,GrayRGB:TRGBArrArr;
    fSRGB:TSRGB;
    fMedian:TArray<TMedian>;
begin
  if not assigned(src) then exit;
  if not assigned(dest) then dest:=VCL.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 :=VCL.Graphics.TBitmap.Create;
  DestBmp:=VCL.Graphics.TBitmap.Create;
  GrayBmp:=VCL.Graphics.TBitmap.Create;
  try
    SrcBmp.PixelFormat:=pf24bit;
    SrcBmp.Width :=fRect.Width;
    SrcBmp.Height:=fRect.Height;
    SrcBmp.Canvas.Draw(0,0,src);
    DestBmp.PixelFormat:=pf24bit;
    DestBmp.Width:=fRect.Width;
    DestBmp.Height:=fRect.Height;
    GrayBmp.PixelFormat:=pf24bit;
    GrayBmp.Width:=fRect.Width;
    GrayBmp.Height:=fRect.Height;
    MamGrayScale(SrcBmp,GrayBmp);
    dest.Width:=fRect.Width;
    dest.Height:=fRect.Height;

    //スキャンラインの一括取得
    for j := 0 to fRect.Height-1 do
    begin
      SrcRGB[j]:=SrcBmp.ScanLine[j];
      DestRGB[j]:=DestBmp.ScanLine[j];
      GrayRGB[j]:=GrayBmp.Scanline[j];
    end;

    for j := 0 to fRect.Height-1 do
    begin
      for i := 0 to fRect.Width-1 do
      begin
        fSRGB.R:=0;
        fSRGB.G:=0;
        fSRGB.B:=0;
        //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:=GrayRGB[yy][xx].R;
              fMedian[Num-1].x:=xx;
              fMedian[Num-1].y:=yy;
            end;
          end;
        end;
        CombSort(fMedian);
        fSRGB.R:=SrcRGB[fMedian[Num Div 2].y][fMedian[Num Div 2].x].R;
        fSRGB.G:=SrcRGB[fMedian[Num Div 2].y][fMedian[Num Div 2].x].G;
        fSRGB.B:=SrcRGB[fMedian[Num Div 2].y][fMedian[Num Div 2].x].B;

        DestRGB[j][i].R:=Round(fSRGB.R);
        DestRGB[j][i].G:=Round(fSRGB.G);
        DestRGB[j][i].B:=Round(fSRGB.B);
      end;
    end;

    dest.Canvas.Draw(0,0,DestBmp);
  finally
    SrcBmp.Free;
    DestBmp.Free;
    GrayBmp.Free;
  end;

end;

end.