图形叠加问题

Question

现有几十幅尺寸相同、内容相似但包含随机噪点的JPG图形，我想把这些全部叠加起来以消除这些噪点，提高图形的清晰程度，请问如何通过编程高速有效的解决这个问题？

Answer 1

你怎么知道哪些是噪点??你顶多搞模糊得算法试试看看，再可以用清晰得算法；总之，你把图片放到photoshop中，用这些效果处理一下，看如何调整效果最好，再编码实现；算法到处都是现成得，你找不到得话可以找我

Answer 2

去噪点可以采用"中值滤波"得算法试试看效果；
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
    procedure SelectionSort(var a: array of integer);  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  RvalueArray, GvalueArray, BvalueArray: array[0..8] of integer;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
  bmp1, bmp2: Tbitmap;
  p1, p2, p3, p4: pbytearray;
  i, j: integer;
begin
  //设置双缓冲
  self.DoubleBuffered := true;
  //创建两个位图实例
  bmp1 := Tbitmap.Create;
  bmp2 := Tbitmap.Create;
  //加在位图
  bmp1.Assign(image1.Picture.Bitmap);
  //设置位图的象素格式
  bmp1.PixelFormat := pf24bit;
  //位图的大小
  bmp1.Width := image1.Picture.Graphic.Width;
  bmp1.Height := image1.Picture.Graphic.Height;
  //加载备份的位图
  bmp2.Assign(image1.Picture.Bitmap);
  bmp2.PixelFormat := pf24bit;
  for j := 1 to bmp1.Height - 2 do
  begin
    //三条扫描线
    p1 := bmp1.ScanLine[j];
    p2 := bmp2.ScanLine[j - 1];
    p3 := bmp2.ScanLine[j];
    p4 := bmp2.ScanLine[j + 1];
    for i := 1 to bmp1.Width - 2 do
    begin
      //对存储9个R分量的数组进行赋值
      RvalueArray[0] := p2[3 * (i - 1) + 2];
      RvalueArray[1] := p2[3 * i + 2];
      RvalueArray[2] := p2[3 * (i + 1) + 2];
      RvalueArray[3] := p3[3 * (i - 1) + 2];
      RvalueArray[4] := p3[3 * i + 2];
      RvalueArray[5] := p3[3 * (i + 1) + 2];
      RvalueArray[6] := p4[3 * (i - 1) + 2];
      RvalueArray[7] := p4[3 * i + 2];
      RvalueArray[8] := p4[3 * (i + 1) + 2];
      //调用排序过程
      SelectionSort(RvalueArray);
      //获取R分量的中间值
      p1[3 * i + 2] := RvalueArray[4];
      //对存储9个G分量的数组进行赋值
      GvalueArray[0] := p2[3 * (i - 1) + 1];
      GvalueArray[1] := p2[3 * i + 1];
      GvalueArray[2] := p2[3 * (i + 1) + 1];
      GvalueArray[3] := p3[3 * (i - 1) + 1];
      GvalueArray[4] := p3[3 * i + 1];
      GvalueArray[5] := p3[3 * (i + 1) + 1];
      GvalueArray[6] := p4[3 * (i - 1) + 1];
      GvalueArray[7] := p4[3 * i + 1];
      GvalueArray[8] := p4[3 * (i + 1) + 1];
      //调用选择排序
      SelectionSort(RvalueArray);
      //获取G分量的中间值
      p1[3 * i + 1] := RvalueArray[4];
      //对存储9个B分量的数组进行赋值
      BvalueArray[0] := p2[3 * (i - 1)];
      BvalueArray[1] := p2[3 * i];
      BvalueArray[2] := p2[3 * (i + 1)];
      BvalueArray[3] := p3[3 * (i - 1)];
      BvalueArray[4] := p3[3 * i];
      BvalueArray[5] := p3[3 * (i + 1)];
      BvalueArray[6] := p4[3 * (i - 1)];
      BvalueArray[7] := p4[3 * i];
      BvalueArray[8] := p4[3 * (i + 1)];
      //调用选择排序过程
      SelectionSort(RvalueArray);
      //获取G分量的中间值
      p1[3 * i] := RvalueArray[4];
    end;
  end;
  Image2.Picture.Bitmap.Assign(Bmp1);
  Bmp1.Free;
  bmp2.Free;
end;
//选择排序过程procedure TForm1.SelectionSort(var a: array of integer);
var
  i, j, t: integer;
begin
  for i := low(a) to high(a) - 1 do
    for j := high(a) downto i + 1 do
      if a[i] > a[j] then
      begin
        //交换值(a[i], a[j], i, j);
        t := a[i];
        a[i] := a[j];
        a[j] := t;
      end;
end;end.

Answer 3

我的问题不是模糊处理的问题，而是类似于
http://www.xjltp.com/5_ziyuan/wangwen/6.htm
中提到的通过叠加图片来减少噪点，只不过我要处理的是显微照片，图片的信噪比往往不能达到要求，通过叠加平均的方法保留图像中的有用信息，降低图像的噪声，应该是一种有效的方法。

Answer 4

有个思路（不知道对不对），傅立叶变换，减去均值，将结果叠加到一幅图的FFT变换上，再反变换
应该会很慢！

Answer 5

发几个样图给我试试[email protected]

Answer 6

哦；看到了http://www.xjltp.com/5_ziyuan/wangwen/6.htm这个有个简单得办法，不知道行不行；你试试看；首先有一个底图；然后加入若干张同样图形不同噪点得图，加入得图全部都是50%得透明度；看看效果；

Answer 7

if not DXDraw.CanDraw then
    Exit;  DXDraw.Surface.Fill(0);  ImageList.Items[0].DrawAlpha(DXDraw.surface, Rect(0, 0, 640, 480), 0, 255);
  ImageList.Items[1].DrawAlpha(DXDraw.surface, Rect(0, 0, 640, 480), 0, 127);
  ImageList.Items[2].DrawAlpha(DXDraw.surface, Rect(0, 0, 640, 480), 0, 127);
  ImageList.Items[3].DrawAlpha(DXDraw.surface, Rect(0, 0, 640, 480), 0, 127);
  ImageList.Items[4].DrawAlpha(DXDraw.surface, Rect(0, 0, 640, 480), 0, 127);
  DXDraw.Flip;这个是用delphix做得一个尝试，可能根本无法解决你得问题；期待标准答案

Answer 8

在efg的网站上找到一个PerlinNoiseEx，可能有用，正在考虑中{---<              Perlin Noise Demo                 >---}{
  This example shows how to render cloud/fog alike
  images("perlin noise"). The example isn磘 the
  most memory friendly way to code the routine, but
  this way enables the user in a fast way, to see how
  the individual layers look before mixing them.
  Another thing to have in mind with this ex. is
  that the standard Random function is used - and not
  a special function which always returns the same value
  given the same input - Procedural rendering is therefore
  not possible.  Instead of 'div' and/or 'sqr', 'shr' has been used whenever
  possible (to gain speed). x shr 2 is equal to i.e. x div 2^2.  Copyright (C) 2000 Michael Hansen. All Rights Reserved.
  Questions & bad code manner complaints:
  EMail: [email protected]}unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, ExtCtrls,
  ComCtrls;type
  TForm1 = class(TForm)
    Draw: TButton;
    NoiseGen: TButton;
    NoiseRadio: TRadioGroup;
    SmoothRadio: TRadioGroup;
    Bevel1: TBevel;
    ViewCombo: TComboBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    UpDown1: TUpDown;
    procedure FormCreate(Sender: TObject);
    procedure DrawClick(Sender: TObject);
    procedure NoiseGenClick(Sender: TObject);
    procedure Mix;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure NoiseRadioClick(Sender: TObject);
    procedure SmoothRadioClick(Sender: TObject);
    procedure ViewComboChange(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation
type
  TRGBTripleArray = array[0..32767] of TRGBTriple;
var
  Bitmap: TBitmap;
  YLine: ^TRGBTripleArray;
  Noise: array of array of array of byte;
  Layers: array of array of array of byte; //[层序号，x，y]
  InitDone: boolean = false;   {Max shr CLayer MUST be > 1 else program exits.
    In other words:  if Max div CLayer*2^CLayer > 1 then close}
  CLayer: byte = 7; {Actual Layers = CLayer+1} //层数
  Max: word = 255; {Actual Size = (Max+1)*(Max+1) } //图形大小   {Grain or MixDown Factor, thats like a layers opasity
   in photoshop,127=50% Opaque and 255=100% Opaque.
   Change the grainess with this value. > 127 = more grain. }
  Grain: byte = 127;{$R *.DFM}function freq(xy, layer: word): word;
begin
  Result := xy shr layer;
end;procedure TForm1.Mix;
var
  x, y: word;
  c, l: byte;
begin
  l := ViewCombo.ItemIndex;
  if l = 0 then //显示混合层
    for y := 0 to Max do
    begin
      YLine := Bitmap.Scanline[y];
      for x := 0 to Max do
      begin
        c := Layers[0, x, y]; //取出一个像素的第一个字节
        for l := 1 to CLayer do
          c := ((c * Grain) + (Layers[l, x, y] * not Grain)) shr 8; //混合处理
        fillchar(YLine[x], 3, c); //填充结果灰度值
      end;
    end
  else //显示指定层
    for y := 0 to Max do
    begin
      YLine := Bitmap.Scanline[y];
      for x := 0 to Max do
      begin
        c := Layers[l - 1, x, y];
        fillchar(YLine[x], 3, c);
      end;
    end;
  Canvas.Draw(7, 7, Bitmap);
end;procedure Init(NumberOFLayers: byte);
var
  xy, y: word;
  l: byte;
begin
  SetLength(Noise, NumberOFLayers + 1);
  SetLength(Layers, NumberOFLayers + 1);
  for l := 0 to NumberOFLayers do
  begin
    xy := freq(Max, l);
    SetLength(Noise[l], xy + 1);
    SetLength(Layers[l], Max + 1);
    for y := 0 to xy do
      SetLength(Noise[l, y], xy);
    for y := 0 to Max do
      SetLength(Layers[l, y], Max + 1);
  end;
end;procedure InterpolateRect(Rect: TRect; v1, v2, v3, v4: byte; Layer: byte);
var
  c, x, y,
    dx, dy,
    dxy, dxX, dyY
    : word;
begin
{Interpolation between the values v1..v4 in the size of rect}
  with Rect do
  begin
    dx := Right - Left;
    dy := Bottom - Top;
    dxy := dx * dy;
    for y := 0 to dy do
    begin
      dyY := dy - y;
      for x := 0 to dx do
      begin
        dxX := dx - x;
        c := (v1 * dyY * dxX) div dxy + (v2 * dyY * x) div dxy +
          (v3 * y * dxX) div dxy + (v4 * y * x) div dxy;
        Layers[Layer, left + x, top + y] := c;
      end;
    end;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
var
  x: byte;
begin
  if Max shr Clayer < 1 then
    exit; {see introduction}
  Bitmap := TBitmap.Create;
  Bitmap.PixelFormat := pf24bit;
  Bitmap.Width := Max + 1;
  Bitmap.Height := Max + 1;
  Init(CLayer);
  ViewCombo.Items.Add('Mixed Layers');
  for x := 0 to CLayer do
    ViewCombo.Items.Add('Layer ' + IntToStr(x + 1));
  NoiseRadio.ItemIndex := 0;
  SmoothRadio.ItemIndex := 0;
  ViewCombo.ItemIndex := 0;
  InitDone := true;
  NoiseGen.Click;
end;procedure TForm1.DrawClick(Sender: TObject);
var
  x, y: word;
  l, cl: byte;
  sc: single;
begin
  Screen.Cursor := crHourGlass;
 {No Interpolation and layer[0] fill}
  for l := 0 to CLayer do
    for x := 0 to Max do
      for y := 0 to Max do
        Layers[l, x, y] := Noise[l, freq(x, l), freq(y, l)];
 {Interpolation}
  if SmoothRadio.ItemIndex = 0 then
    for l := 1 to CLayer do
    begin
      y := 0;
      cl := freq(Max, l);
      sc := Max / cl;
      repeat begin
          x := 0;
          repeat begin
              InterPolateRect(Rect(Round(x * sc), Round(y * sc), Round((x * sc) + sc), Round((y * sc) + sc)), Noise[l, x, y], Noise[l, x + 1, y], Noise[l, x, y + 1], Noise[l, x + 1, y + 1], l);
              Inc(x);
            end;
          until x = cl;
          inc(y);
        end;
      until y = cl;
    end;
  Mix;
  Screen.Cursor := crDefault;
end;procedure TForm1.NoiseGenClick(Sender: TObject);
var
  x, y, l: word;
begin
  Randomize;
 {Grayscale noise}
  if NoiseRadio.ItemIndex = 0 then
    for l := 0 to CLAyer do
      for x := 0 to freq(Max, l) do
        for y := 0 to freq(Max, l) do
          Noise[l, x, y] := Random(32768);
 {Monochrome noise}
  if NoiseRadio.ItemIndex = 1 then
    for l := 0 to CLAyer do
      for x := 0 to freq(Max, l) do
        for y := 0 to freq(Max, l) do
          if random(32768) > 16384 then
            Noise[l, x, y] := 255
          else
            Noise[l, x, y] := 0;
  Draw.Click;
  ViewCombo.ItemIndex := 0
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 {Release memory used}
  Finalize(Layers);
  Finalize(Noise);
  YLine := nil;
  Bitmap.Free
end;procedure TForm1.NoiseRadioClick(Sender: TObject);
begin
  if InitDone then
    NoiseGen.Click
end;procedure TForm1.SmoothRadioClick(Sender: TObject);
begin
  if InitDone then
    Draw.Click
end;procedure TForm1.ViewComboChange(Sender: TObject);
begin
  if InitDone then
    Mix
end;procedure TForm1.FormPaint(Sender: TObject);
begin
  if InitDone = false then
    close;
  Canvas.Draw(7, 7, Bitmap);
end;procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
  Grain := UpDown1.Position;
  Mix;
end;end.