FILTRE DE NETTETÉ D'UN BITMAP

Commentaire de f0xi le 12/02/2007 01:48:12 administrateur CS

pas mal du tout, mais on peu augmenter les performances un chouilla.


ici, avec l'image de l'exemple on passe de 109..120ms a 42..61ms :


const
  MaxImageSize = 32767; { max : image 32767x32767 }

type
  TPixel = record
    Blue  : Byte;
    Green : Byte;
    Red   : Byte;
  end;
  pPixelArray = ^TPixelArray;
  TPixelArray = array[0..MaxImageSize] of TPixel;
  TScanline   = array[0..MaxImageSize] of pPixelArray;
  TFilter     = array[0..8] of integer;

procedure BmpAccentuation(Src,Dest : TBitmap; const Correction: integer);
var
  Filter : TFilter;
  SelPix : TPixel;
  ScanSrc,
  ScanDest : TScanline;

  I,
  NewR,NewG,NewB,
  PosX, PosY,
  mX, mY,
  dX, dY,
  Diviseur,
  WM,HM,
  Cor2 : integer;

const
  PC_dYToI : array [-1..1] of byte = (1,4,7);

begin
   Dest.Assign(Src);

   if Correction = 0 then exit;

   Cor2      := Correction shl 2;

   Filter[0] := -Correction;
   Filter[2] := Filter[0];
   Filter[6] := Filter[0];
   Filter[8] := Filter[0];
   Filter[1] := 0;
   Filter[3] := 0;
   Filter[5] := 0;
   Filter[7] := 0;
   Filter[4] := Cor2 + 128;

   Diviseur  := Filter[4] - Cor2;

   WM       := Src.Width-1;
   HM       := Src.Height-1;

   for I := 0 to HM do begin
       ScanSrc[I]  := Src.Scanline[I];
       ScanDest[I] := Dest.Scanline[I];
   end;

   for PosY := 0 to HM do
       for PosX := 0 to WM do begin

           NewR := 0;
           NewG := 0;
           NewB := 0;

           for dY := -1 to 1 do begin

               mY := PosY + dY;
               if (mY < 0) or (mY > HM) then mY := PosY;
               I := PC_dYToI[dY];

               for dX := -1 to 1 do begin
                   mX := PosX + dX;
                   if (mX < 0) or (mX > WM) then mX := PosX;

                   SelPix := ScanSrc[mY,mX];

                   I := I + dX;

                   NewR := NewR + SelPix.Red   * Filter[I];
                   NewG := NewG + SelPix.Green * Filter[I];
                   NewB := NewB + SelPix.Blue  * Filter[I];
               end;
           end;

           NewR := NewR div Diviseur;
           if NewR > 255 then NewR := 255 else if NewR < 0 then NewR := 0;

           NewG := NewG div Diviseur;
           if NewG > 255 then NewG := 255 else if NewG < 0 then NewG := 0;

           NewB := NewB div Diviseur;
           if NewB > 255 then NewB := 255 else if NewB < 0 then NewB := 0;

           with ScanDest[PosY, PosX] do begin
                Red   := NewR;
                Green := NewG;
                Blue  := NewB;
           end;
      end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
  Jpg: TJpegImage;
begin
  Jpg     := TJpegImage.Create;

  try
    OrigBmp := TBitmap.Create;
    Jpg.LoadFromFile('ImageTest.jpg');

    OrigBmp.Assign(Jpg);
    OrigBmp.PixelFormat:= pf24bit;
  finally
    Jpg.Free;
  end;

  Image1.Picture.Bitmap.Assign(OrigBmp);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Origbmp.Free;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  BmpAccentuation(OrigBmp, Image1.Picture.Bitmap, Trackbar1.Position);
end;

Commentaire de f0xi le 12/02/2007 16:06:37 administrateur CS

mmm bizarre, je n'avais pas ce soucis ...

mais je pense que j'ai merder dans mon tableau de precalc

j'aurais du faire :

IRat : array[-1..1,-1..1] of byte = (0,1,2,3,4,5,6,7,8);

et

           for dY := -1 to 1 do begin

               mY := PosY + dY;
               if (mY < 0) or (mY > HM) then mY := PosY;

               for dX := -1 to 1 do begin
                   mX := PosX + dX;
                   if (mX < 0) or (mX > WM) then mX := PosX;

                   SelPix := ScanSrc[mY,mX];

                   I := IRat[dY,dX];

                   NewR := NewR + SelPix.Red   * Filter[I];
                   NewG := NewG + SelPix.Green * Filter[I];
                   NewB := NewB + SelPix.Blue  * Filter[I];
               end;
           end;

ce qui evite 18 additions et 9 multiplications (donc environ 45 operations CPU en moins)
ça plus la compression des if pour mY et mX avec le deport de mY dans la boucle mY (sinon on la fait inutilement 6 fois)
cette boucle deviens donc plus rapide, puisqu'elle serat executée plusieurs millions de fois selon la taille de l'image.
(1 310 720 fois pour la boucle dY et 3 932 160 pour la boucle dX pour une image en 1280x1024)

l'optimisation est donc cruciale pour un tel process.
deja, ton idée de tableau pour les scanline est pas mal, elle accelere beaucoup le process (mais prend plus de memoire en contrepartie).

Commentaire de Francky23012301 le 15/02/2007 16:19:42

Salut,

Tres bon code : je suis bleuffé par le rendu.

Dis moi : J'ai cherché sur le net mais j'ai rien trouvé sur les différents filtres qui existent. Un ptit lien serait le bienvenu SVP M'Sieur ;).

@+

Commentaire de ThWilliam le 16/02/2007 12:35:40

Merci Francky.

D'autres filtres matriciels ? Vu que je cherchais exclusivement un filtre d'accentuation (trouvé en commentaires d'un code C++), je ne peux te répondre. Regarde toujours ceci :
http://www.alvasoft.net/programmation-traitement-d-image-par-filtrage-24-1.html
Programme téléchargeable (pas le code source) qui te permet d'entrer des valeurs sur une matrice 5 x 5.

L'application du filtre met beaucoup de temps ? J'ai placé un chrono et j'obtiens pour l'image de la démo un temps de traitement d' environ 30 ms. (sans l'optimisation de f0xi : environ 47 ms). Mon ordi = P4 3Ghz HT 1Go DDRam 400Mhz.

A +
Thierry        

Commentaire de ThWilliam le 16/02/2007 16:11:05

Salut Cirec,

Dans ma première mise à jour, j'avais déclaré TPixel dans l'ordre : R, G, B.

Mais si tu fais le test suivant sur une image de charte de couleurs :

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  p: pPixelArray;
begin
  p:= image1.picture.bitmap.ScanLine[Y];
  labelRed.caption:= inttostr(P[X].Red);
end;

... LabelRed  => 0 pour un rouge pur !!!
Donc ScanLine renvoie bien les valeurs selon l'ordre B,G,R.

A +
Thierry

Commentaire de Francky23012301 le 17/02/2007 19:46:41

Salut,

BOn pour tout te dire, j'ai fais un test ou je capture le flux de la webcam via le presse papier. En voulant appliquer le filtre, je n'ai plus aucune fluidité : en appliquant un intervalle de 50 ms, je vois la nouvelle image au bout d'une seconde.

Commentaire de cirec le 20/02/2007 14:03:47 administrateur CS

Aie Aie Aie ... maintenent c'est Florenth qui continue à ma perturber ... lol

Bon alors regarde le petit exemple que j'ai donné dans mon premier post.

Je teste une couleur (TColor) en BGR mais celui qui me donne le bon résultat c'est l'ABSOLUTE RGB ????

D'autant plus que tu ne me facilites pas la tâche :
d'abord tu dis :"Si tes octets sont en BGRA comme les TColor ..."
et ensuite tu écris :"TColor: RGBA"

Ah oui aussi : je croyais que les TColors étaient en tripe et non en quad ????

et pour courroner le tout même les déclaration dans Windows.pas ne sont pas très claire :

TRGBTriple est déclaré en BGR
TRGBQuad   est aussi en BGR plus l'alpha chanel

  tagRGBTRIPLE = packed record
    rgbtBlue: Byte;
    rgbtGreen: Byte;
    rgbtRed: Byte;
  end;
  TRGBTriple = tagRGBTRIPLE;

  tagRGBQUAD = packed record
    rgbBlue: Byte;
    rgbGreen: Byte;
    rgbRed: Byte;
    rgbReserved: Byte;
  end;
  TRGBQuad = tagRGBQUAD;

Bon sur ce ... je vais me prendre une aspirine ... lol
@+
Cirec

Commentaire de ThWilliam le 20/02/2007 19:20:09

@Cirec et Florent : bon, je vous laisse à vos maux de tête (bien que ce ne soit pas sans intérêt).

@Florent : oui, on peut déclarer Filter: array[-1..1, -1..1] of Integer et se passer de la constante IRat. Le traitement serait même apparemment un milli-poil plus rapide.

Commentaire de murearctique le 06/11/2009 10:31:32

Merci pour la clarté et l'efficacité de ton code et pour l'honnêteté de tes source. cela fait plaisir