Look Inside

Manipuler des pixels

Je trouve régulièrement des questions sur les forums sur la manière d'accélérer la modification d'une image pixel par pixel.

Sous Delphi on pourra évidemment utiliser TCanvas.Pixels[x, y], mais c'est clairement la méthode la plus lente !

procedure TForm1.FormPaint(Sender: TObject);
var
  Bmp: TBitmap;
  x  : Integer;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Width := 512;
    Bmp.Height := 512;
    for x := 0 to 511 do
      Bmp.Canvas.Pixels[x, x] := clRed;
    Canvas.Draw(0, 0, Bmp);
  finally
    Bmp.Free;
  end;
end;

On lui préférera un accès direct au buffer interne du bitmap (le DIB = Device Independant Bitmap) via la propriété ScanLine.

procedure TForm1.FormPaint(Sender: TObject);
var
  Bmp   : TBitmap;
  x     : Integer;
  Pixels: PCardinal;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Width := 512;
    Bmp.Height := 512;
    Bmp.PixelFormat := pf32Bit; // force le format interne du DIB
    for x := 0 to 511 do
    begin
      //Bmp.Canvas.Pixels[x, x] := clRed;
      Pixels := Bmp.ScanLine[x]; // la ligne x
      Inc(Pixels, x); // le xième pixel de la ligne
      Pixels^ := $ff0000; // couleur native RRGGBB
    end;
    Canvas.Draw(0, 0, Bmp);
  finally
    Bmp.Free;
  end;
end;

ici on ne modifie qu'un pixel par ligne, le gain n'est pas forcément remarquable (d'autant qu'on ne modifie que 512 pixels), mais je voulais simplement montrer le principe. Car en fait, cet article est au sujet d'une API qui existe depuis fort longtemps et qui permet de dessiner un tableau de Pixels !

SetDIBitsToDevice

Pour le coup on va faire une modification plus importante. L'image est déclarée comme un simple tableau de TColor, on accède donc directement aux pixels par pixels[y, x]. Ensuite on déclare le format de ce DIB dans un TBitmapInfo, soit les dimensions et le nombre de bits (32). Et il ne reste plus qu'à envoyer notre tableau de pixels sur un hDC, c'est à dire le Handle d'un Canvas et le tour est joué !

Petite remarque, les DIB ont naturellement la tête en bas, si vous ne voulez pas inverser la coordonnée Y de votre tableau, vous pouvez indiquer une hauteur négative dans TBitmapInfo !

Modification du 29/05/2013: inversion de X et Y sur le tableau de pixels, il faut utiliser pixels[y, x] et non pixels[x, y] !

const
  IMAGE_WIDTH  = 256;
  IMAGE_HEIGHT = 256;
var
  pixels: array[0..IMAGE_HEIGHT - 1, 0..IMAGE_WIDTH - 1] of TColor; // hauteur puis largeur, et non l'inverse

procedure TForm1.FormCreate(Sender: TObject);
var
  x, y: Integer;
begin
  for x := 0 to IMAGE_WIDTH - 1 do
    for y := 0 to IMAGE_HEIGHT - 1 do
      pixels[y, x] := (x + y) or ((x - y) shl 8 ) or ((x + x) shl 16);
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  BitsInfos: TBitmapInfo;
begin
  FillChar(BitsInfos, SizeOf(BitsInfos), 0);
  with BitsInfos do
  begin
    with bmiHeader do
    begin
      biSize          := 40;
      biWidth         := IMAGE_WIDTH;
      biHeight        := - IMAGE_HEIGHT; // inverser le DIB pour avoir le tête en haut
      biPlanes        := 1;
      biBitCount      := 32;
    end;
  end;
  SetDIBitsToDevice(
    Canvas.Handle,
    10, 10, IMAGE_WIDTH, IMAGE_HEIGHT,
    0, 0, 0, IMAGE_HEIGHT,
    @pixels,
    BitsInfos,
    0
  );
end;

Cette même méthode pourra être utilisée pour dessiner le DIB sur un Bitmap sur lequel vous pourrez intervenir via son Canvas pour ajouter du texte par exemple. En voici la preuve:

procedure TForm1.FormPaint(Sender: TObject);
var
  BitsInfos: TBitmapInfo;
  Bmp: TBitmap;
begin
  FillChar(BitsInfos, SizeOf(BitsInfos), 0);
  with BitsInfos do
  begin
    with bmiHeader do
    begin
      biSize          := 40;
      biWidth         := IMAGE_WIDTH;
      biHeight        := - IMAGE_HEIGHT;
      biPlanes        := 1;
      biBitCount      := 32;
    end;
  end;
  Bmp := TBitmap.Create;
  try
    Bmp.width := IMAGE_WIDTH;
    Bmp.Height := IMAGE_HEIGHT;
    Bmp.PixelFormat := pf32Bit;
    SetDIBitsToDevice(
      Bmp.Canvas.Handle,
      0, 0, IMAGE_WIDTH, IMAGE_HEIGHT,
      0, 0, 0, IMAGE_HEIGHT,
      @pixels,
      BitsInfos,
      0
    );
    with Bmp.Canvas do
    begin
      Brush.Style := bsClear;
      Font.Name := 'Arial';
      Font.Size := 12;
      Font.Style := [fsBold];
      TextOut(11, 11, 'Hello World');
      Font.Color := clWhite;
      TextOut(10, 10, 'Hello World');
    end;
    Canvas.Draw(10, 10, Bmp);
  finally
    Bmp.Free;
  end;
end;

Date de dernière modification : 27/09/2023