如何实现可调整(1-100)的抖动算法?

晕，高手都到哪里去了???????????连抖动都不知道我贴出Floyed-Steinberg抖动算法，给你们参考吧！
----------------------------------------------------------
procedure FSDither(Source, Dest: TBitmap);
type
  TRgb = packed record
    Blue: Byte;
    Green: Byte;
    Red: Byte;
    Filler: Byte;
  end;  TIntegerArray = array[0..(MaxLongInt div 4) - 1] of Integer;
  TpIntegerArray = ^TIntegerArray;var
  RErr1: TpIntegerArray; { red errors }
  RErr2: TpIntegerArray;
  GErr1: TpIntegerArray; { green errors  }
  GErr2: TpIntegerArray;
  BErr1: TpIntegerArray; { blue errors }
  BErr2: TpIntegerArray;  function RGB2Color(RGB: TRGB): TColor;
begin
  with rgb do
  begin
    Result := Blue shl 16 or
      Green shl 8 or
      Red;
  end; // with
end;function BoundInteger(const Value: LongInt;
  const MinValue: LongInt;
  const MaxValue: LongInt): LongInt;
begin
  Result := Value;  if Result < MinValue then
    Result := MinValue;  if Result > MaxValue then
    Result := MaxValue;
end;function color2rgb(color: TColor): TRGB;
begin
  with result do
  begin
    Red := Color and $FF;
    Green := (Color and $FF00) shr 8;
    Blue := (Color and $FF0000) shr 16;
  end;
end;  procedure AllocateErrors;
  var
    Size: LongInt;
  begin
    Size := Source.Width * SizeOf(Integer);
    GetMem(RErr1, Size);
    GetMem(RErr2, Size);
    GetMem(GErr1, Size);
    GetMem(GErr2, Size);
    GetMem(BErr1, Size);
    GetMem(BErr2, Size);    FillChar(RErr1^, Size, 0);
    FillChar(RErr2^, Size, 0);
    FillChar(GErr1^, Size, 0);
    FillChar(GErr2^, Size, 0);
    FillChar(BErr1^, Size, 0);
    FillChar(BErr2^, Size, 0);
  end;  procedure ReleaseErrors;
  var
    Size: LongInt;
  begin
    Size := Source.Width * SizeOf(Integer);
    FreeMem(RErr1, Size);
    FreeMem(RErr2, Size);
    FreeMem(GErr1, Size);
    FreeMem(GErr2, Size);
    FreeMem(BErr1, Size);
    FreeMem(BErr2, Size);
  end;  procedure DitherScanLine(const LineNo: LongInt);
  var
    X: LongInt;
    Rgb: TRgb;
    RErr: Integer;
    GErr: Integer;
    BErr: Integer;
  begin
    for X := 0 to (Source.Width - 1) do
    begin
      Rgb := color2rgb(Source.Canvas.Pixels[X, LineNo]);      RErr1^[X] := BoundInteger(RErr2^[X] + Rgb.Red, 0, 255);
      RErr2^[X] := 0;
      GErr1^[X] := BoundInteger(GErr2^[X] + Rgb.Green, 0, 255);
      GErr2^[X] := 0;
      BErr1^[X] := BoundInteger(BErr2^[X] + Rgb.Blue, 0, 255);
      BErr2^[X] := 0;
    end;    Rgb.Red := RErr1^[0];
    Rgb.Green := GErr1^[0];
    Rgb.Blue := BErr1^[0];
    Dest.Canvas.Pixels[0, LineNo] := Rgb2color(Rgb);    for X := 1 to (Source.Width - 2) do
    begin
      Rgb.Red := RErr1^[X];
      Rgb.Green := GErr1^[X];
      Rgb.Blue := BErr1^[X];            { Using the Rgb property will perform the Color matching }
      Dest.Canvas.Pixels[X, LineNo] := RGB2Color(Rgb);            { get the actual Rgb value after Color matching to compute
              the error }
      Rgb := color2rgb(Dest.Canvas.Pixels[X, LineNo]);            { compute errors }
      RErr := RErr1^[X];
      RErr := RErr - Rgb.Red;      GErr := GErr1^[X];
      GErr := GErr - Rgb.Green;      BErr := BErr1^[X];
      BErr := BErr - Rgb.Blue;      RErr1^[X + 1] := BoundInteger((RErr1^[X + 1] + ((RErr * 7)) div 16), 0, 255);
      RErr2^[X - 1] := BoundInteger((RErr2^[X - 1] + ((RErr * 3)) div 16), 0, 255);
      RErr2^[X] := BoundInteger((RErr2^[X] + ((RErr * 5)) div 16), 0, 255);
      RErr2^[X + 1] := BoundInteger((RErr2^[X + 1] + ((RErr * 1)) div 16), 0, 255);      GErr1^[X + 1] := BoundInteger((GErr1^[X + 1] + ((GErr * 7)) div 16), 0, 255);
      GErr2^[X - 1] := BoundInteger((GErr2^[X - 1] + ((GErr * 3)) div 16), 0, 255);
      GErr2^[X] := BoundInteger((GErr2^[X] + ((GErr * 5)) div 16), 0, 255);
      GErr2^[X + 1] := BoundInteger((GErr2^[X + 1] + ((GErr * 1)) div 16), 0, 255);      BErr1^[X + 1] := BoundInteger((BErr1^[X + 1] + ((BErr * 7)) div 16), 0, 255);
      BErr2^[X - 1] := BoundInteger((BErr2^[X - 1] + ((BErr * 3)) div 16), 0, 255);
      BErr2^[X] := BoundInteger((BErr2^[X] + ((BErr * 5)) div 16), 0, 255);
      BErr2^[X + 1] := BoundInteger((BErr2^[X + 1] + ((BErr * 1)) div 16), 0, 255);
    end;    Rgb.Red := RErr1^[Source.Width - 1];
    Rgb.Green := GErr1^[Source.Width - 1];
    Rgb.Blue := BErr1^[Source.Width - 1];    Dest.Canvas.Pixels[Source.Width - 1, LineNo] := RGB2Color(Rgb);
  end;var
  Y: LongInt;
  HeightMinusOne: LongInt;
begin
  AllocateErrors;
  try
    HeightMinusOne := Source.Height - 1;
    for Y := 0 to HeightMinusOne do
    begin
      DitherScanLine(Y);
    end;
  finally
    ReleaseErrors;
  end;
end;
{-------------------fd---------------------}
用法：
var tmp: TBitmap;
begin
  tmp := TBitmap.Create;
  try
    tmp.Width := Bitmap.Width;
    tmp.Height := Bitmap.Height;
    tmp.pixelformat := pf8bit; //256色
    FSDither(Bitmap, tmp);//Bitmap是真彩色图像
    image1.picture.Bitmap.Assign(tmp);
    end;
  finally
    tmp.Free;
  end;-------------------------------------------------------但是我现在要的是可调整(0-100, 0表示不抖动)的抖动算法，不管是什么类型的Understand?

计算每个像素的灰度，然后根据该灰度值产生一个随机数，确定画黑点或白点的概率。
灰度计算公式：
Gray := (R*30 + G*59 + B*11) Div 256;
然后计算概率：
P := Random(Gray+1);
确定画点：
If P=0 Then Canvas.Pixels[X, Y] := clBlack Else Canvas.Pixels[X,Y] := clWhite;

to zx126(F9):
抖动并不是黑白的，是有颜色的，你没有看过PHOTOSHOP中的那个吗?
Firework MX中也有

zx126(F9):
你这鸟人，把我一年前写给别人做二值误差分散抖动的帖子翻出来，什么意思？你连我的代码是什么类型的抖动都没看懂，就一子不改的帖出来，你要不要脸啊？

F-S抖动我以前用过（它最简单嘛^_^），如果你理解了抖动的原理，我想这并不是个困难的问题，比如你要的36种，假设原图有256种，你就把256种分成36段，将落在各段中的颜色套到最接近的色上，然后将其差值按F-S算法分散到旁边的像素上即可。
说明：这里说的抖动一般称为误差扩散抖动。

zx126(F9) Raptor(猛禽)
说的没错，灰度和RGB是一个样，
问题是你那一块是一色的，好办，
如果是一缕头发，
你还怎么抖？？
所以楼主的想法只用一个抖动，实现起来不好弄呀

>如果是一缕头发，也一样,抖动是一种对图像进行大面积处理的操作不是一种局部操作,它主要目的是让图像看起来色彩比实际的要非富,因为人眼对色彩的敏感度高于对清晰度的敏感,所以一般经过抖动后看起来好得多.但是抖动是比较复杂的,特别是彩色的,比如:如何从256色中选择36色使图你损失最小,简单的用平均分割,但要效果好还是要用复杂的非平均法,kiss2([email protected])兄,我给你写源码你给多少钱?^_^

调试易

如何实现可调整(1-100)的抖动算法?

解决方案 »