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 :hi:

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