Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Grafik / Sound / Multimedia (https://www.delphipraxis.net/21-library-grafik-sound-multimedia/)
-   -   Delphi 5x5-Blur bzw. "Antialiasing" (https://www.delphipraxis.net/12422-5x5-blur-bzw-antialiasing.html)

dizzy 26. Nov 2003 23:00


5x5-Blur bzw. "Antialiasing"
 
Kein "echtes" Antialiasing, aber ein konfigurierbarer 5x5-Blur.
In AntAussen, AnzMitte und AntInnen lässt sich einstellen, wie stark welche Region in den Zielpixel einfliessen soll (wobei AntInnen das Zentrum darstellt). Dabei sollte man beachten, dass die Anteile summiert = 1 sind, sonst wird's unschön.

Die Prozedur dürfte recht fix sein, und sich auch für den einen oder anderen "realtime"-Einsatz eignen (vielleicht nicht ganz fullscreen, aber immerhin ;))

Anmerkung: Das ganze ist NICHT als Funktion implementiert, da ich den Eindruck hatte, dass es so schneller läuft.
Anmerkung2: Die Kanten des Bildes werden allerdings vernachlässigt, um nicht noch if-Abfragen rein zu bringen. Das Teil ist auf Geschwindigkeit geschrieben (und dass wo ich doch kein Wort Assembler kann 8) ).


Die Regionen sehen folgendermaßen aus:
A = Aussen (AntAussen)
M = Mitte (AntMitte)
I = Innen (AntInnen)
Delphi-Quellcode:
   A A A
A M M M A
A M I M A
A M M M A
   A A A
Der Code:
Delphi-Quellcode:
type
  PixelA3  = array[1..3] of Byte;
  PixelA15 = array[1..15] of Byte;


procedure TForm1.AntiAlias5(const i: TBitmap; var o: TBitmap);
var
  Po: ^PixelA3;
  P1, P2, P3, P4, P5: ^PixelA15;
  x, y: Cardinal;
  dekrement: Cardinal;
  AntAussen, AntMitte, AntInnen: double;
begin
  // Anteile der Regionen am Zielpixel festlegen
  AntAussen := 12*4;  // 12 Pixel zu 1/4 in Ziel-Pixel
  AntMitte := 8*4;  //  8 Pixel zu 1/4 in Ziel-Pixel
  AntInnen :=   2;  //  1 Pixel zu 1/2 in Ziel-Pixel

  dekrement := 3*(i.Width-3);

  // Scanline der ersten 5 Zeilen abholen
  P1 := i.ScanLine[0];
  P2 := i.ScanLine[1];
  P3 := i.ScanLine[2];
  P4 := i.ScanLine[3];
  P5 := i.ScanLine[4];

  for y := 2 to i.Height-4 do
  begin
    // Scanline des Zielbildes abholen
    Po := o.ScanLine[y];
    // und die x-Position um 2 erhöhen (wie gesagt, Rand spielt nicht mit)
    inc(Po, 2);
    for x := 2 to i.Width-2 do
    begin
      // Blauwert des Zielpixels aus den Blauwerten der Ausgangsregion basteln
      Po^[1] := round(((P1^[4]+P1^[7]+P1^[10]      +
                        P2^[1]                     + P2^[13] +
                        P3^[1]                     + P3^[13] +
                        P4^[1]                     + P4^[13] +
                        P5^[4]+P5^[7]+P5^[10])        / AntAussen) +

                      ((P2^[4]+P2^[7]+P2^[10]      +
                        P3^[4]      +P3^[10]      +
                        P4^[4]+P4^[7]+P4^[10])        / AntMitte) +

                       (P3^[7]                 / AntInnen));

      // Wie bei Blau, jetzt mit grün
      Po^[2] := round(((P1^[5]+P1^[8]+P1^[11]      +
                        P2^[2]                     + P2^[14] +
                        P3^[2]                     + P3^[14] +
                        P4^[2]                     + P4^[14] +
                        P5^[5]+P5^[8]+P5^[11])        / AntAussen) +

                      ((P2^[5]+P2^[8]+P2^[11]      +
                        P3^[5]      +P3^[11]      +
                        P4^[5]+P4^[8]+P4^[11])        / AntMitte) +

                       (P3^[8]                 / AntInnen));

        // und bei Rot...
        Po^[3] := round(((       P1^[6]+P1^[9]+P1^[12]       +
                          P2^[3]                   + P2^[15] +
                          P3^[3]                   + P3^[15] +
                          P4^[3]                   + P4^[15] +
                          P5^[6]+P5^[9]+P5^[12])        / AntAussen) +

                        ((P2^[6]+P2^[9]+P2^[12]       +
                          P3^[6]      +P3^[12]       +
                          P4^[6]+P4^[9]+P4^[12])        / AntMitte) +

                         (P3^[9]                 / AntInnen));

        // Alle Zeiger um 3 Byte erhöen - also einen Pixel nach rechts
        // (PByte deswegen, weil P1-P5 15 Bytes groß sind, und sonst auch um
        // 15 Byte verschoben würden.)
        inc(PByte(P1), 3);
        inc(PByte(P2), 3);
        inc(PByte(P3), 3);
        inc(PByte(P4), 3);
        inc(PByte(P5), 3);

        // Zeiger des Zielpixels einen Pixel nach rechts
        inc(Po, 1);
      end;

     // Alle Zeiger auf den Pixel links ziehen
     dec(PByte(P2), dekrement);
     dec(PByte(P3), dekrement);
     dec(PByte(P4), dekrement);
     dec(PByte(P5), dekrement);

     // und dann die Zeilen verschieben
     P1 := P2;
     P2 := P3;
     P3 := P4;
     P4 := P5;
     P5 := i.ScanLine[y+3]; // und die neue Zeile holen
   end;
end;
Viel Spaß damit, und wer Fehler findet darf sie behalten --- oder schickt mir besser eine PM. Aber ich hab das Teil erfolgreich im Einsatz ;)


gruss,
dizzy

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

Robert Marquardt 27. Nov 2003 06:21

Re: 5x5-Blur bzw. "Antialiasing"
 
Ich werkel gerade an der Jedi VCL und dort an den Bildbearbeitungsfunktionen.
Ich wuerde die Zeiger auf TRGBTriple zeigen lassen.
Nicht vergessen das Pixelformat der Bitmap auf pf24bit umstellen.

dizzy 27. Nov 2003 14:18

Re: 5x5-Blur bzw. "Antialiasing"
 
Zitat:

Ich wuerde die Zeiger auf TRGBTriple zeigen lassen.
Würde ich im zweiten Fall (PixelA15 = array[1..15] of Byte;) nicht. Dann höchstens auf ein "array[1..3] of TRGBTriple", da ich ja damit 3 Pixel mit einem Zeiger erschlage. Aber ich wüsste jetzt nicht wirklich, wo der Vorteil von TRGBTriple läge...


Zitat:

Nicht vergessen das Pixelformat der Bitmap auf pf24bit umstellen.
:oops: ...das hätt' ich vergessen zu sagen. Danke!

Robert Marquardt 27. Nov 2003 14:27

Re: 5x5-Blur bzw. "Antialiasing"
 
Der Unterschied ist das mit TRGBTriple es lesbarer wird.
Ich seh gerade noch mehrere Fehler.
Die Schleifen sollten doch wohl bis Width-3 bzw Height-3 laufen.
Die Groesse des Zielbildes sollte gesetzt werden.

Luckie 27. Nov 2003 14:30

Re: 5x5-Blur bzw. "Antialiasing"
 
Öhm. Könntest du deine Codeformatierung etwqas an den Objeect Pascal Style Guide anpassen? Zu finden hier: http://www.luckie-online.de/artikel/opstyleguide.shtml

dizzy 27. Nov 2003 14:52

Re: 5x5-Blur bzw. "Antialiasing"
 
Zitat:

Der Unterschied ist das mit TRGBTriple es lesbarer wird.
Naja okay. Ich persönlich finde es so schöner. Über Geschmack lässt sich ja bekanntlich nicht streiten ;).

Zitat:

Ich seh gerade noch mehrere Fehler.
Die Schleifen sollten doch wohl bis Width-3 bzw Height-3 laufen.
Probier's doch mal aus. Dann läufst du über die Zeilenenden bzw. Spaltenenden. Bei der y-Schleife fange ich bei 2 an damit sich das Zielbild nicht nach oben verschiebt. Ist schon in Ordnung so. Man muss halt nur meine Anmerkung beachten: Die Ränder (2 Pixel breit) werden ausgelassen und Zeit zu sparen.

Zitat:

Die Groesse des Zielbildes sollte gesetzt werden.
Das Zielbild wird als Parameter übergeben und ist somit bereits definiert.

Aufruf z.B.:
Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
var bmp1, bmp2 : TBitmap;
begin
  bmp1 := TBitmap.Create;
  bmp1.Width := 800;
  bmp1.Height := 600;
  bmp1.PixelFormat := pf24Bit;

  bmp2 := TBitmap.Create;
  bmp2.Width := 800;
  bmp2.Height := 600;
  bmp2.PixelFormat := pf24Bit;

  AntiAlias5(bmp1, bmp2);
end;
Zitat:

Öhm. Könntest du deine Codeformatierung etwqas an den Objeect Pascal Style Guide anpassen?
Öhm. Wo genau ist dein Problem?
Etwa hier?
Delphi-Quellcode:
        Po^[1] := round(((       P1^[4]+P1^[7]+P1^[10]       +
                          P2^[1]                     +P2^[13]+
                          P3^[1]                     +P3^[13]+
                          P4^[1]                     +P4^[13]+
                                 P5^[4]+P5^[7]+P5^[10])        / AntAussen)+         // Äussere Region

                               ((P2^[4]+P2^[7]+P2^[10]       +
                                 P3^[4]      +P3^[10]       +
                                 P4^[4]+P4^[7]+P4^[10])        / AntMitte)+          // Mittlere Region

                                       (P3^[7]                 / AntInnen));        // Zentrum
Das hab ich mit vollster Absicht so gamcht, damit man die grafische vorstellung gleich mit im Code hat. Von mir aus kann man aber auch so schreiben:
Delphi-Quellcode:
Po^[1] := round(((P1^[4]+P1^[7]+P1^[10]+P2^[1]+P2^[13]+P3^[1]+P3^[13]+P4^[1]+P4^[13]+P5^[4]+P5^[7]+P5^[10]) / AntAussen)+
                ((P2^[4]+P2^[7]+P2^[10]+P3^[4]+P3^[10]+P4^[4]+P4^[7]+P4^[10]) / AntMitte)+
                 (P3^[7] / AntInnen));
Nur hilft das dem Verständnis dessen, was da passiert nicht wirklich weiter...

Oder isset, weil ich das "begin" auch noch eine Spalte einrücke? Oder weil "AntAussen" nicht "antAussen" heisst? Oder ist der Prozedurname ungünstig? "do5x5AA(bmp1, bmp2);" besser? ;)

Wenn es überhaupt nicht den "optischen Ansprüchen" genügt, dann kann ich's natürlich ändern. Aber der Lesbarkeit hälfe das meiner Meinung nach nicht wirklich weiter. Ich will keinem an die Karre fahren! Nur wissen, wo jetzt genau der Knackpunkt ist.


gruss,
dizzy

\edit: Delphi-Tags korrigiert

Robert Marquardt 27. Nov 2003 15:32

Re: 5x5-Blur bzw. "Antialiasing"
 
Ich wuerde die Groesse des Bildes trotzdem setzen. Das macht die Funktion allgemeiner.
Ich nehme TRGBTriple (bzw einen eigenen gleichartigen Typ), damit die Funktionen der JVCL CLX-kompatibel werden.
Unter Linux gibt es kein pf24bit sondern nur pf32bit.

dizzy 27. Nov 2003 15:43

Re: 5x5-Blur bzw. "Antialiasing"
 
Hmmm... also wenn ich etwas setze, wird's allgemeiner!? Möchtest du den zu AA-enden Breich als TRect übergeben, wie bei einem Draw? Ansonsten ist doch alles klar: Der Bereich der ge-AA-t wird entspricht der Größe des Bildes, welches als erster Parameter übergeben wird. Das finde ich sehr allgemein, und recht flexibel. Oder ich verstehe dich einfach nur nicht ;).

Mit der CLX und Kylix-Klamotten hab ich mich bisher noch nie beschäftigt, und werde es in absehbarer Zeit wohl auch nicht. Von daher sind mir da so einige Dinge nicht bekannt :oops:.

Dann sei hiermit gesagt:
Dieses Stückchen Code ist NICHT für den Einsatz in Verbindung mit der CLX/Kylix geeignet. Die nötigen Modifikationen entnehme man Robert Marquardt's letztem Post :roll: :-D.


gruss,
dizzy

Phantom1 3. Dez 2003 15:37

Re: 5x5-Blur bzw. "Antialiasing"
 
Hi,

erstmal muss ich sagen das du den code wirklich gut optimiert hast, allerdings ist das ganze etwas unflexibel und die matrix muss man leider immer von hand eingeben. Da ich vor einigen monaten eine ähnliche prozedure geschrieben habe, möchte ich dir diese nicht vorenthalten, vieleicht kannst du sie ja gebrauchen ;O)

Die Procedure arbeit ähnlich wie GaussianBlur, man kann sie aber auch fürs Soften/Blurren/AntiAliasing benutzten.
Man kann einen Pixelradius angeben (von 0.0000001 bis 50 pixel). Je größer der Wert desto mehr wird geblurrt. (achtung große werte können sehr viel rechenzeit beanspruchen!)

Die Matrix und der divisor wird ebenfalls automatisch berechnet, hier mal zwei beispiele:

bei einem radius von 2,0

0,17|0,76|1,00|0,76|0,17
0,76|1,60|2,00|1,60|0,76
1,00|2,00|3,00|2,00|1,00
0,76|1,60|2,00|1,60|0,76
0,17|0,76|1,00|0,76|0,17


und radius 3,6

0,00|0,00|0,13|0,48|0,60|0,48|0,13|0,00|0,00
0,00|0,36|0,99|1,40|1,60|1,40|0,99|0,36|0,00
0,13|0,99|1,80|2,40|2,60|2,40|1,80|0,99|0,13
0,48|1,40|2,40|3,20|3,60|3,20|2,40|1,40|0,48
0,60|1,60|2,60|3,60|4,60|3,60|2,60|1,60|0,60
0,48|1,40|2,40|3,20|3,60|3,20|2,40|1,40|0,48
0,13|0,99|1,80|2,40|2,60|2,40|1,80|0,99|0,13
0,00|0,36|0,99|1,40|1,60|1,40|0,99|0,36|0,00
0,00|0,00|0,13|0,48|0,60|0,48|0,13|0,00|0,00

Desweiteren habe ich die procedure ebenfalls sogut ich konnte optimiert (ich kann leider auch kein assembler).
Die Randpixel werden bei meiner procedure mitgerechnet!

So und hier der sourcecode:

Delphi-Quellcode:
procedure BmpGBlur(Bmp: TBitmap; radius: Single);
Type
  TRGB     = Packed Record b, g, r: Byte End;
  ArrTRGB  = Array of TRGB;
  ArrSingle = Array of Single;
Var
  MatrixDim, MatrixRadius: Byte;
  Matrix  : Array of ArrSingle;
  MatrixY : ^ArrSingle;
  Faktor  : ^Single;
  BmpCopy : Array of ArrTRGB;
  BmpCopyY : ^ArrTRGB;
  BmpRGB, BmpCopyRGB: ^TRGB;
  BmpWidth, BmpHeight, x, y, dx, dy: Integer;
  StartDx, CountDx, StartDy, CountDy: Integer;
  R, G, B, Divisor: Single;

  Procedure CalculateMatrix;
  Var x,y: Integer; MxRadius, f: Single;
  Begin
    radius:=radius+1; // der mittel/nullpunkt muss mitgerechnet werden
    If Frac(radius)=0 Then MatrixDim:=Pred(Trunc(radius)*2) Else MatrixDim:=Succ(Trunc(radius)*2);
    SetLength(Matrix,MatrixDim,MatrixDim);
    MxRadius:=MatrixDim div 2;
    For y:=0 To Pred(MatrixDim) Do
      For x:=0 To Pred(MatrixDim) Do begin
        f:=radius-Sqrt(Sqr(x-MxRadius)+Sqr(y-MxRadius));
        If f<0 Then f:=0; // punkte die außerhalb des radius liegen löschen
        Matrix[y,x]:=f;
      end;
  End;

Begin
  Bmp.PixelFormat:=pf24bit;
  If radius<=0 Then radius:=1 Else If radius>=50 Then radius:=50; // radius bereich 0.0 < radius < 50.0
  CalculateMatrix;
  BmpWidth:=Bmp.Width;
  BmpHeight:=Bmp.Height;
  SetLength(BmpCopy,BmpHeight,BmpWidth);
  // Kopie des Bitmaps erstellen im zweidimensionalen Array (BmpCopy)
  For y:=0 To Pred(BmpHeight) Do
    Move(Bmp.ScanLine[y]^,BmpCopy[y,0],BmpWidth*3);
  MatrixRadius:=Pred(MatrixDim) Div 2;
  For y:=0 To Pred(BmpHeight) Do Begin
    BmpRGB:=Bmp.ScanLine[y];
    For x:=0 to Pred(BmpWidth) Do Begin
      R:=0; G:=0; B:=0; Divisor:=0;
      // Matrixpixel außerhalb des Bitmaps weglassen
      If y<MatrixRadius Then StartDy:=y Else StartDy:=MatrixRadius;
      If y>Pred(BmpHeight)-MatrixRadius Then CountDy:=Pred(BmpHeight)-y+StartDy
      Else CountDy:=MatrixRadius+StartDy;
      If x<MatrixRadius Then StartDx:=x Else StartDx:=MatrixRadius;
      If x>Pred(BmpWidth)-MatrixRadius Then CountDx:=Pred(BmpWidth)-x+StartDx
      Else CountDx:=MatrixRadius+StartDx;
      // Bildpunkte mit der Matrix multiplizieren
      MatrixY:=@Matrix[MatrixRadius-StartDy];
      BmpCopyY:=@BmpCopy[y-StartDy];
      For dy:=0 To CountDy Do Begin
        Faktor:=@MatrixY^[MatrixRadius-StartDx];
        BmpCopyRGB:=@BmpCopyY^[x-StartDx];
        For dx:=0 To CountDx Do Begin
          B:=B+BmpCopyRGB^.b*Faktor^; // blau
          G:=G+BmpCopyRGB^.g*Faktor^; // grün
          R:=R+BmpCopyRGB^.r*Faktor^; // rot
          Divisor:=Divisor+Faktor^;
          Inc(BmpCopyRGB);
          Inc(Faktor);
        End;
        Inc(MatrixY);
        Inc(BmpCopyY);
      End;
      // neuen berechneten Bildpunkt schreiben
      BmpRGB.b:=Round(B/Divisor);
      BmpRGB.g:=Round(G/Divisor);
      BmpRGB.r:=Round(R/Divisor);
      Inc(BmpRGB);
    End;
  End;
End;

Phantom1 4. Dez 2003 12:36

Re: 5x5-Blur bzw. "Antialiasing"
 
Hi

hab meinen code nochmal überarbeitet und ist jetzt wesentlich schneller geworden, vorallem bei großen radien (um das 20-fache etwa)!!!!! :spin: :spin: :spin:

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;
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;
  BmpCopyRGB        : ^TRGBs;
  R, G, B           : Single;
  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];
    BmpCopyRGB:=@BmpCopy[y,0];
    For x:=0 to Pred(BmpWidth) Do Begin
      R:=0; G:=0; B:=0;
      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];
        B:=B+BmpRGB^.b*Matrix[mx];
        G:=G+BmpRGB^.g*Matrix[mx];
        R:=R+BmpRGB^.r*Matrix[mx];
      End;
      BmpCopyRGB^.b:=B; // Farbwerte werden im Typ Single zwischengespeichert !
      BmpCopyRGB^.g:=G;
      BmpCopyRGB^.r:=R;
      Inc(BmpCopyRGB);
    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
      R:=0; G:=0; B:=0;
      For mx:=-MatrixRadius To MatrixRadius Do Begin
        If y+mx<=0 Then
          BmpCopyRGB:=@BmpCopy[0,x]               // erster Pixel
        Else If y+mx>=BmpHeight Then
          BmpCopyRGB:=@BmpCopy[Pred(BmpHeight),x] // letzter Pixel
        Else
          BmpCopyRGB:=@BmpCopy[y+mx,x];
        B:=B+BmpCopyRGB^.b*Matrix[mx];
        G:=G+BmpCopyRGB^.g*Matrix[mx];
        R:=R+BmpCopyRGB^.r*Matrix[mx];
      End;
      BmpRGB^.b:=Round(B);
      BmpRGB^.g:=Round(G);
      BmpRGB^.r:=Round(R);
      Inc(BmpRGB);
    End;
  End;
End;


Alle Zeitangaben in WEZ +1. Es ist jetzt 10:35 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz