Bild weichzeichnen

[BlueStarHH]

Hi,

ich möchte ein Bild mit dem "gaussian blur"-Algorithmus (Gaußischer Weichzeichner) weichzeichnen. Kennt jemand eine Seite auf der eine Implementation in Delphi zu finden ist und/oder eine Seite wo die Funktionsweise des Algorithmus vorzugsweise auf Deutsch beschrieben ist? Vielen Dank!

[Binärbaum]

Hallo Blue Star,

ein erster Anlaufpunkt wäre sicherlich Gaußsches Weichzeichnen oder Wikipedia.
Wenn man dann einmal das grundlegende Prinzip bzw. den Algorithmus verstanden hat, sollte ein Implementation mit Delphi auch nicht mehr so schwierig sein.

MfG
Binärbaum

[Pfoto]

Hallo,

ich habe einen Code in Benutzung, der u.a. auch hier erwähnt wird:
http://www.delphi-library.de/viewtop...a5900d&t=19270

(Man darf doch auf Postings eines anderen Delphi-Forums linken, oder?)


Gruß
Pfoto

[Aenogym]

Zitat von Pfoto:

(Man darf doch auf Postings eines anderen Delphi-Forums linken, oder?)

natürlich, zumal es sich um ein partnerforum handelt

[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.

[BlueStarHH]

Zitat von Binärbaum:

ein erster Anlaufpunkt wäre sicherlich Gaußsches Weichzeichnen oder Wikipedia.
Wenn man dann einmal das grundlegende Prinzip bzw. den Algorithmus verstanden hat, sollte ein Implementation mit Delphi auch nicht mehr so schwierig sein.

Ersteinmal vielen Dank für die Antworten. Der Text in der Wikipedia und was ich vor dem Posten dieser Frage in Google gefunden habe, hilft mir beim Verständnis des Algorithmus nicht viel weiter. In der Wikipedia steht z.B. nicht, wie die Matrix genau genutzt wird um die Farbe von einem Pixel zu errechnen. Nehmen wir mal an, ich habe folgendes Graustufenbild (jede Zahl gibt die Graufärbung von 0 bis 255 eines Pixels an):

Code:

50  55  60 
45 200 100
10   0   5

Wie würde das Resultat nun aussehen, wenn man die Matrix aus der Wikipedia nutzt? Und wie verrechnet man die Ausgangs-Pixel mit der Matrix nun? Mir geht es hier nicht um eine schnelle optimierte Lösung, sondern um eine einfache, simple zum nachvollziehen. Danke!

Aus der Wikipedia:

Code:

Pixel Gaußwert -> Vorfaktor*Ganzzahl
0     0,16              343*55
1     0,10              343*33
2     0,02              343*7
3     0,00              343*0
 Matrix           
 1  4   7   4   1
 4  20  33  20  4
 7  33  55  33  7    x 343
 4  20  33  20  4
 1  4   7   4   1

Noch eine Frage: Wie kommt man von dem Gaußwert auf Vorfaktor*Ganzzahl?