Blureffekt (Weichzeichnen) bei Bitmaps

[flomei]

In diesem Thread hat Phantom1 eine Prozedur gepostet mit deren Hilfe man einen sog. "Blureffekt" (aka Weichzeichnen) zu einem Bild hinzufügen kann:
Klick!

Delphi-Quellcode:

procedure BmpGBlur(Bmp: TBitmap; radius: Single);
type
  TRGB      = packed record b, g, r: Byte end;
  TRGBs     = packed record b, g, r: Single end;
  TRGBArray = array[0..0] of TRGB;
const
  ZeroTRGBs: TRGBs=(b:0; g:0; r:0);
var
  MatrixRadius: Byte;
  Matrix : array[-100..100] of Single;

  Procedure CalculateMatrix;
  var x: Integer; Divisor: Single;
  begin
    radius:=radius+1; // der mittel/nullpunkt muss mitgerechnet werden
    MatrixRadius:=Trunc(radius);
    if Frac(radius)=0 then Dec(MatrixRadius);
    Divisor:=0;
    for x:=-MatrixRadius To MatrixRadius do 
    begin
      Matrix[x]:=radius-abs(x);
      Divisor:=Divisor+Matrix[x];
    end;
    for x:=-MatrixRadius to MatrixRadius do
      Matrix[x]:=Matrix[x]/Divisor;
  end;

var
  BmpSL: ^TRGBArray;
  BmpRGB: ^TRGB;
  BmpCopy: array of array of TRGBs;
  BmpCopyRGBs: ^TRGBs;
  PixelRGBs: TRGBs;
  BmpWidth, BmpHeight: Integer;
  x, y, mx: Integer;
begin
  Bmp.PixelFormat := pf24bit; 
  if radius <= 0 then radius := 1 else if radius > 99 then radius := 99; // radius bereich 0 < radius < 99
  CalculateMatrix;
  BmpWidth := Bmp.Width;
  BmpHeight := Bmp.Height;
  SetLength(BmpCopy, BmpHeight, BmpWidth);
  // Alle Bildpunkte ins BmpCopy-Array schreiben und gleichzeitig HORIZONTAL blurren
  for y := 0 To Pred(BmpHeight) do 
  begin
    BmpSL := Bmp.Scanline[y];
    BmpCopyRGBs:=@BmpCopy[y,0];
    for x:=0 to Pred(BmpWidth) do 
    begin
      BmpCopyRGBs^:=ZeroTRGBs;
      for mx := -MatrixRadius to MatrixRadius do 
      begin
        if x + mx <= 0 then
          BmpRGB := @BmpSL^[0]  // erster Pixel
        else if x + mx >= BmpWidth then
          BmpRGB := @BmpSL^[Pred(BmpWidth)] // letzter Pixel
        else
          BmpRGB := @BmpSL^[x+mx];
        BmpCopyRGBs^.b := BmpCopyRGBs^.b+BmpRGB^.b*Matrix[mx];
        BmpCopyRGBs^.g := BmpCopyRGBs^.g+BmpRGB^.g*Matrix[mx];
        BmpCopyRGBs^.r := BmpCopyRGBs^.r+BmpRGB^.r*Matrix[mx];
      end;
      Inc(BmpCopyRGBs);
    end;
  end;
  // Alle Bildpunkte zurück ins Bmp-Bitmap schreiben und gleichzeitig VERTIKAL blurren
  for y := 0 to Pred(BmpHeight) do 
  begin
    BmpRGB := Bmp.ScanLine[y];
    for x := 0 to Pred(BmpWidth) do 
    begin
      PixelRGBs := ZeroTRGBs;
      for mx := -MatrixRadius to MatrixRadius do 
      begin
        if y + mx <= 0 then
          BmpCopyRGBs := @BmpCopy[0, x]  // erster Pixel
        else if y + mx >= BmpHeight then
          BmpCopyRGBs := @BmpCopy[Pred(BmpHeight), x]  // letzter Pixel
        else
          BmpCopyRGBs := @BmpCopy[y + mx, x];
        PixelRGBs.b:=PixelRGBs.b+BmpCopyRGBs^.b*Matrix[mx];
        PixelRGBs.g:=PixelRGBs.g+BmpCopyRGBs^.g*Matrix[mx];
        PixelRGBs.r:=PixelRGBs.r+BmpCopyRGBs^.r*Matrix[mx];
      end;
      BmpRGB^.b := Round(PixelRGBs.b);
      BmpRGB^.g := Round(PixelRGBs.g);
      BmpRGB^.r := Round(PixelRGBs.r);
      Inc(BmpRGB);
    end;
  end;
end;

Für alle die glauben, sie hätten einen solchen Effekt noch nie gesehen habe ich mal zwei Bilder angehangen.
Dort habe ich mithilfe von Photoshop einen (relativ starken) Blureffekt hinzugefügt...

HTH!

MfG Florian

[edit=Matze]Code formatiert. Mfg, Matze[/edit]