Bild weichzeichnen

[Khabarakh]

Hier noch eine Routine, die sehr schnell sein sollte.

Delphi-Quellcode:

****************************************************************
* Fastblur routine (c)2005 Roy Magne Klever
* If you improve it send me a copy at [email][e-mail][/email]
****************************************************************
procedure rkFastBlur(src, dest: TBitmap; radius, rep: integer);
type
  PRGB24 = ^TRGB24;
  TRGB24 = packed record
    B: Byte;
    G: Byte;
    R: Byte;
  end;
  TLine24 = array[0..MaxInt div SizeOf(TRGB24) - 1] of TRGB24;
  PLine24 = ^TLine24;
var
  j, divF, i, w, h, x, y, ny, tx, ty, prg: integer;
  p: pRGB24;
  ptrS, ptrD, pv: integer;
  s0, s1: PLine24;
  saR, saG, saB: array of Integer;
begin
  dest.Assign(src);
  if radius = 0 then
    Exit;

  divF := (radius * 2) + 1;
  w := dest.Width - 1;
  h := dest.Height - 1;
  SetLength(saR, w + 1 + (radius * 2));
  SetLength(saG, w + 1 + (radius * 2));
  SetLength(saB, w + 1 + (radius * 2));

  s1 := dest.ScanLine[0];
  ptrD := integer(dest.ScanLine[1]) - integer(s1);

  ny := Integer(s1);
  for y := 0 to h do
  begin
    for j := 1 to rep do
    begin
      i := -radius;
      while i <= w + radius do
      begin
        tx := i;
        if tx < 0 then
          tx := 0
        else if tx >= w then
          tx := w;
        with pRGB24(ny + tx * 3)^ do
        begin
          saR[i + radius] := r + saR[i + radius - 1];
          saG[i + radius] := g + saG[i + radius - 1];
          saB[i + radius] := b + saB[i + radius - 1];
        end;
        inc(i);
      end;
      for x := 0 to w do
      begin
        tx := x + radius;
        with pRGB24(ny + x * 3)^ do
        begin
          r := ((saR[tx + radius] - saR[tx - 1 - radius]) div divF);
          g := ((saG[tx + radius] - saG[tx - 1 - radius]) div divF);
          b := ((saB[tx + radius] - saB[tx - 1 - radius]) div divF);
        end;
      end;
    end;
    inc(ny, PtrD);
  end;

  SetLength(saR, h + 1 + (radius * 2));
  SetLength(saG, h + 1 + (radius * 2));
  SetLength(saB, h + 1 + (radius * 2));
  for x := 0 to w do
  begin
    for j := 1 to rep do
    begin
      ny := Integer(s1);
      i := -radius;
      while i <= h + radius do
      begin
        if (i > 0) and (i < h) then
          inc(ny, PtrD);
        with pRGB24(ny + x * 3)^ do
        begin
          saR[i + radius] := r + saR[i + radius - 1];
          saG[i + radius] := g + saG[i + radius - 1];
          saB[i + radius] := b + saB[i + radius - 1];
        end;
        inc(i);
      end;
      ny := Integer(s1);
      for y := 0 to h do
      begin
        ty := y + radius;
        with pRGB24(ny + x * 3)^ do
        begin
          r := ((saR[ty + radius] - saR[ty - 1 - radius]) div divF);
          g := ((saG[ty + radius] - saG[ty - 1 - radius]) div divF);
          b := ((saB[ty + radius] - saB[ty - 1 - radius]) div divF);
        end;
        inc(ny, PtrD);
      end;
    end;
  end;
  SetLength(saR, 0);
  SetLength(saG, 0);
  SetLength(saB, 0);
end;

Etwas optimiert, allerdings für die GR32-Lib:

Delphi-Quellcode:

procedure FastBlur(Dst: TBitmap32; Radius: Integer; Passes: Integer = 3);
//****************************************************************
//*  Fastblur routine (c)2005 Roy Magne Klever
//*  GR32 Conversion and further optimizations by Michael Hansen
//*  If you improve it please send a copies to:
//*  [email][e-mail][/email]
//*  [email][e-mail][/email]
//****************************************************************
type
   PARGB32 = ^TARGB32;
   TARGB32 = packed record
     B: Byte;
     G: Byte;
     R: Byte;
     A: Byte;
   end;
   TLine32 = array[0..MaxInt div SizeOf(TARGB32) - 1] of TARGB32;
   PLine32 = ^TLine32;

   PSumRecord = ^TSumRecord;
   TSumRecord = packed record
     saB, saG, saR, saA: Cardinal;
   end;

var
   J, X, Y, w, h,  ny, tx, ty: integer;
   ptrD: integer;
   s1: PLine32;
   C: TColor32;
   sa: array of TSumRecord;
   sr1, sr2: TSumRecord;
   n : Cardinal;
begin
   if Radius = 0 then Exit;

   n := Fixed(1 / ((radius * 2) + 1));
   w := Dst.Width - 1;
   h := Dst.Height - 1;

   SetLength(sa, w + 1 + (radius * 2));

   s1 := PLine32(Dst.PixelPtr[0,0]);
   ptrD := Integer(Dst.PixelPtr[0,1]) - Integer(s1);

   ny := Integer(s1);
   for Y := 0 to h do
   begin
     for J := 1 to Passes do
     begin
       X := - Radius;
       while X <= w + Radius do
       begin
         tx := X;
         if tx < 0 then tx := 0 else if tx >= w then tx := w;
         sr1 := sa[X + Radius - 1];
         C := PColor32(ny + tx shl 2)^;
         with sa[X + Radius] do
         begin
           saA := sr1.saA + C shr 24;
           saR := sr1.saR + C shr 16 and $FF;
           saG := sr1.saG + C shr 8 and $FF;
           saB := sr1.saB + C and $FF;
         end;
         inc(X);
       end;
       for X := 0 to w do
       begin
         tx  := X + Radius;
         sr1 := sa[tx + Radius];
         sr2 := sa[tx - 1 - Radius];
         PColor32(ny + X shl 2)^ := (sr1.saA - sr2.saA) * n shl 8 and 
$FF000000 or
                                    (sr1.saR - sr2.saR) * n and $FF0000 or
                                    (sr1.saG - sr2.saG) * n shr 8 and $FF00 
or
                                    (sr1.saB - sr2.saB) * n shr 16;
       end;
     end;
     inc(ny, PtrD);
   end;

   SetLength(sa, h + 1 + (Radius * 2));
   for X := 0 to w do
   begin
     for J := 1 to Passes do
     begin
       ny := Integer(s1);
       Y := - Radius;
       while Y <= h + Radius do
       begin
         if (Y > 0) and (Y < h) then inc(ny, PtrD);
         sr1 := sa[Y + Radius - 1];
         C := PColor32(ny + X shl 2)^;
         with sa[Y + Radius] do
         begin
           saA := sr1.saA + C shr 24;
           saR := sr1.saR + C shr 16 and $FF;
           saG := sr1.saG + C shr 8 and $FF;
           saB := sr1.saB + C and $FF;
         end;
         inc(Y);
       end;
       ny := Integer(s1);
       for Y := 0 to h do
       begin
         ty := Y + Radius;
         sr1 := sa[ty + Radius];
         sr2 := sa[ty - 1 - Radius];
         PColor32(ny + X shl 2)^ := (sr1.saA - sr2.saA) * n shl 8 and 
$FF000000 or
                                    (sr1.saR - sr2.saR) * n and $FF0000 or
                                    (sr1.saG - sr2.saG) * n shr 8 and $FF00 
or
                                    (sr1.saB - sr2.saB) * n shr 16;
         inc(ny, PtrD);
       end;
     end;
   end;
   SetLength(sa, 0);
end;

Ein weiterer Algorithmus von dizzy lässt sich in der CodeLib finden.

[Garfield]

Das Thema ist zwar alt, aber ich habe eine Frage zu diesem Bereich:

Zitat von Khabarakh:

Delphi-Quellcode:

****************************************************************
* Fastblur routine (c)2005 Roy Magne Klever
* If you improve it send me a copy at [email][e-mail][/email]
****************************************************************
procedure rkFastBlur(src, dest: TBitmap; radius, rep: integer);

...

      i := -radius;
      while i <= w + radius do
      begin
        tx := i;
        if tx < 0 then
          tx := 0
        else if tx >= w then
          tx := w;
        with pRGB24(ny + tx * 3)^ do
        begin
          saR[i + radius] := r + saR[i + radius - 1];
          saG[i + radius] := g + saG[i + radius - 1];
          saB[i + radius] := b + saB[i + radius - 1];
        end;
        inc(i);
      end;

...

Der Startwert von i ist -radius. Dann wäre der erste Wert für i + radius - 1 -1. Das Array beginnt doch aber mit Element 0. Warum kommt es da nicht zu einem Fehler? Werden dann für das Element -1 irgendwelche zufälligen Werte genommen?

[himitsu]

Pixel-Farbfehler am Rand wird es bestimmt geben.

Die Lines liegen direkt hintereinander, also erwischt man da entweder das letzte Pixel Zeile drunterliegenden Zeile. (die Lines gehen von links nach rechts und dann von unten nach oben)
Eventuell liegt noch zwischen den Lines ein Align-Bereich, welcher mit 0 (Schwarz) gefüllt ist
und vor der untersten Line liegt praktisch noch der Bitmap-Header.
Man erwischt also immer irgendeinen Speicher und bekommt keine Zugriffsverletzung.

Und Indexfehler dür die -1 bekommt man auch nicht, da ihr in eurem Code bestimmt die Bereichsprüfung deaktiviert habt.

[Blup]

Liegt ein Teil der Pixel die für die Berechnung nicht im Bild vor (X außerhalb des Randes), werden diese auch nicht in die Berechnung einbezogen.

Code:

X.X.X
X.E.F 
X.H.I

Neu.E := (
0 + 0 + 0 +
0 + E * Faktor.E + F * Faktor.F +
0 + H * Faktor.H + I * Faktor.I) 
/ (
1 * 1 * 1 *
1 * Faktor.E * Faktor.F *
1 * Faktor.H * Faktor.I)

Der Divisor muss bei einer 3x3-Matrix also einmal für jeden Eckpunkt und für jeden Rand neu berechnet werden.

[Garfield]

Zitat von himitsu:

Und Indexfehler dür die -1 bekommt man auch nicht, da ihr in eurem Code bestimmt die Bereichsprüfung deaktiviert habt.

Das ist es. Die Bereichsprüfung ist default = false. Bei true kommt eine Fehlermeldung. Bei mir kommen für Element -1 reproduzierbar Werte von 436 raus.

Danke himi.

@ Blup: Der Gauss ist mir klar. Mir ging es nur um die -1.