Utilisation de la propriété TBitMap.ScanLine

Date de publication : 16/11/2003 , Date de mise a jour : 16/11/2003

Par Earl F. Glynn (efg's computer lag)
 Nono40 ( Traduction ) (nono40.developpez.com)
 

Ce document est la traduction de la version anglaise de l'auteur disponible ici :
http://www.efg2.com/Lab/ImageProcessing/Scanline.htm

La propriété ScanLine a été introduite avec Delphi 3, elle permet un accès rapide à chaque pixel. Mais vous devez connaître le format de pixel utilisé (TBitMap.PixelFormat ) pour accéder correctement aux pixels. Cet article va montrer comment utiliser la propriété ScanLine pour traiter des pixels dans différentes applications graphiques ou autres. En premier lieu, chaque format de pixel va être décrit, accompagné d'un exemple. Après cette présentation théorique, plusieurs applications seront décrites, la plupart utilisant le format pf24bit. En dernier, quelques problèmes particuliers sur l'utilisation de ScanLine seront présentés.

Introduction

Listing 1 : Rotation d'un bitmap en utilisant la propriété Canvas.Pixels
WITH ImageFrom.Canvas.ClipRect DO
BEGIN
  FOR i := Left TO Right DO
    FOR j := Top TO Bottom DO
      ImageTo.Canvas.Pixels[j,Right-i-1] := ImageFrom.Canvas.Pixels[i,j]
END;

I. ScanLine et PixelFormat

I-A. Format pfCustom

I-B. Format pfDevice

I-C. Format pf1bit

pByteArray = ^TByteArray;
TByteArray = ARRAY[0..32767] OF BYTE;

Listing 2. Remplir un bitmap pf1bit avec un masque fixe
procedure TFormPf1bit.ButtonTagFillClick(Sender: TObject);
  VAR
    Bitmap: TBitmap;
    i     : INTEGER;
    j     : INTEGER;
    Row   : pByteArray;
    Value : BYTE;
begin
  // Value = $00 = 00000000 en binaire pour le noir
  // Value = $FF = 11111111 en binaire pour le blanc
  // Value = $55 = 01010101 en binaire pour les rayures
  Value := (Sender AS TButton).Tag;

  Bitmap := TBitmap.Create;
  TRY
    WITH Bitmap DO
    BEGIN
      Width := 32;
      Height := 32;

      // Etrange, pourquoi cette ligne doit suivre Width/Height pour
      // que le code fonctionne ? Dans le cas contraire, le bitmap
      // est toujours noir.
      PixelFormat := pf1bit;

      IF        CheckBoxPalette.Checked
      THEN Bitmap.Palette := GetTwoColorPalette
    END;

    FOR j := 0 TO Bitmap.Height-1 DO
    BEGIN
      Row := pByteArray(Bitmap.Scanline[j]);
      FOR i := 0 TO (Bitmap.Width DIV BitsPerPixel)-1 DO
      BEGIN
        Row[i] := Value
      END
    END;

    ImageBits.Picture.Graphic := Bitmap
  FINALLY
    Bitmap.Free
  END
end;

$00, $FC, $0F, $C0
$07, $FF, $1F, $E0
00000000 11111100 00001111 11000000
00000111 11111111 00011111 11100000

Inverser un bitmap pf1bit
FOR j := 0 TO Bitmap.Height-1 DO
BEGIN
  RowOut := pByteArray(Bitmap.Scanline[j]);
  RowIn := pByteArray(ImageBits.Picture.Bitmap.Scanline[j]);
  FOR i := 0 TO (Bitmap.Width DIV BitsPerPixel)-1 DO
  BEGIN
    RowOut[i] := NOT RowIn[i]
  END
END;

I-D. Format pf4bit

// Affichage de barre de 16 couleurs dans un bitmap pf4bit
// efg, 6 October 1998

procedure TForm1.ButtonPf4bitClick(Sender: TObject);
  VAR
    Bitmap:  TBitmap;
    i,j   :  INTEGER;
    m     :  INTEGER;
    row   :  pByteArray;    // Chaque pixel est un morceau (1/2 octet )
begin
  Bitmap := TBitmap.Create;
  TRY
    Bitmap.Width  := Image1.Width;
    Bitmap.Height := Image1.Height;  // Doit être un multiple de 16
    Bitmap.PixelFormat := pf4bit;    // 16 couleurs

    FOR j := 0 TO Bitmap.Height-1 DO
    BEGIN
      m := j DIV 16;      // 16 bands :  0 .. 15
      row := Bitmap.Scanline[j];
      FOR i := 0 TO Bitmap.Width DIV 2 - 1 DO  // 2 pixels par octet
      BEGIN
        row[i] := m         + {pixel du morceau bas}
                  (m SHL 4);  {pixel du morceau haut}
      END
    END;

    Image1.Picture.Graphic := Bitmap
  FINALLY
    Bitmap.Free
  END
end;

I-E. Format pf8bit

Listing 4 : Affectation des pixels d'un pf8bit en utilisant TByteArray
VAR
  i  :  INTEGER;
  j  :  INTEGER;
  Row:  pByteArray
. . .
FOR j := 0 TO BitmapBase.Height-1 DO
BEGIN
  Row := BitmapBase.ScanLine[j];
  FOR i := 0 TO BitmapBase.Width-1 DO
  BEGIN
    Row[i] := <pixel value 0..255>;   // Affecter un index de palette
  END
END;

ImageShow.Picture.Graphic := BitmapBase;

Listing 5 : copier les données d'un bitmap pf4bit dans un bitmap pf8bit
// A partir d'un bitmap pf4bit nommé Bitmap4, transférer les données
// vers un bitmap pf8bit nommé Bitmap8.
VAR
  Bitmap4: TBitmap; // pf4bit Bitmap
  Bitmap8: TBitmap; // pf8bit Bitmap
  i      : INTEGER;
  j      : INTEGER;
  Row4   : pByteArray; // pf4bit Scanline
  Row8   : pByteArray; // pf8bit Scanline
...
Bitmap8 := TBitmap.Create;
TRY
  Bitmap8.Width  := Bitmap4.Width;
  Bitmap8.Height := 2 * Bitmap4.Height;
  Bitmap8.PixelFormat := pf8Bit;

  // Copie des Scalines pf4bit vers les Scanlines pf8bit
  FOR j := 0 TO Bitmap4.Height-1 DO
  BEGIN
    Row4 := Bitmap4.Scanline[j];  // Scanline origine
    Row8 := Bitmap8.Scanline[j];  // Scanline destination

    // Width[Bytes] = Width[Pixels] / 2 pour un Bitmap pf4bit
    // On suppose que la largeur est paire.
    FOR i := 0 TO (Bitmap4.Width DIV 2)-1 DO
    BEGIN
      Row8[2*i  ] := Row4[i] DIV 16;
      Row8[2*i+1] := Row4[i] MOD 16
    END
  END;

  Image8.Picture.Graphic := Bitmap8;
FINALLY
  Bitmap8.Free
END

Listing 5 : copier les données d'un bitmap pf4bit dans un bitmap pf8bit
// efg, 24 August 1998

unit ScreenGetPaletteEntries;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    ButtonReadpf8bit: TButton;
    Memo1: TMemo;
    Image2: TImage;
    procedure ButtonReadpf8bitClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

CONST
  MaxPixelCount = 65536;

TYPE
  TRGBArray = ARRAY[0..MaxPixelCount-1] OF TRGBTriple;
  pRGBArray = ^TRGBArray;

procedure TForm1.ButtonReadpf8bitClick(Sender: TObject);
  VAR
    i                :  CARDINAL;
    index            :  BYTE;
    j                :  CARDINAL;
    LogicalPalette   :  TMaxLogPalette;
    PaletteEntryCount:  CARDINAL;
    Bitmap8          :  TBitmap;
    Bitmap24         :  TBitmap;
    Row8             :  pByteArray;
    Row24            :  pRGBArray;
begin
  Bitmap8 := TBitmap.Create;
  TRY
    Bitmap8.LoadFromFile('Deer.BMP');

    // Affichage du Bitmap pf8bit
    Image1.Picture.Graphic := Bitmap8;

    IF   Bitmap8.PixelFormat <> pf8bit
    THEN ShowMessage('Format attendu : 8-bits/pixel BMP');

    IF   Bitmap8.Palette = 0
    THEN ShowMessage ('Pas de palette avec le BMP')
    ELSE BEGIN
      PaletteEntryCount := GetPaletteEntries(Bitmap8.Palette, 0, 255,
                                             LogicalPalette.palPalEntry);
      FOR i := 0 TO PaletteEntryCount-1 DO
      BEGIN
         Memo1.Lines.Add(Format('%3.3d %3.3d %3.3d %3.3d %d',
           [i, LogicalPalette.palPalEntry[i].peRed,
               LogicalPalette.palPalEntry[i].peGreen,
               LogicalPalette.palPalEntry[i].peBlue,
               LogicalPalette.palPalEntry[i].peFlags]))
      END;

      Bitmap24 := TBitmap.Create;
      TRY
        Bitmap24.Width  := Bitmap8.Width;
        Bitmap24.Height := Bitmap8.Height;
        Bitmap24.PixelFormat := pf24bit;

        FOR j := 0 TO Bitmap8.Height-1 DO
        BEGIN
          Row8  := Bitmap8.Scanline[j];
          Row24 := Bitmap24.Scanline[j];

          FOR i := 0 TO Bitmap8.Width-1 DO
          BEGIN
            index := Row8[i];  // index dans la palette
            WITH Row24[i] DO
            BEGIN
              rgbtRed   := LogicalPalette.palPalEntry[index].peRed;
              rgbtGreen := LogicalPalette.palPalEntry[index].peGreen;
              rgbtBlue  := LogicalPalette.palPalEntry[index].peBlue
            END
          END

        END;

        // Sauvegarde dans la nouveau BMP
        Bitmap24.SaveToFile('Deer24.BMP');

        // Affichage du BMP 24-bit (Sans palette maintenant)
        Image2.Picture.Graphic := Bitmap24;
      FINALLY
        Bitmap24.Free
      END

    END
  FINALLY
    Bitmap8.Free
  END
end;

end.

I-F. Format pf15bit et pf16bit

BEGIN
  bitmap := TBitmap.Create;
  TRY
    bitmap.Width  := 32;
    bitmap.Height := 32;
    bitmap.PixelFormat := pf15Bit; 
    IF   bitmap.PixelFormat <> pf15bit
    THEN ShowMessage('pf15bit non supporté !');
...

pf15bit:  0 rrrrr vvvvv bbbbb
pf16bit:  rrrrr vvvvvv bbbbb

Listing 6 : Création d'un bitmap pf15bit jaune
VAR
  Bitmap: TBitmap;
  i     : INTEGER;
  j     : INTEGER;

  R     : 0..31; // chaque composante RVB a 5 bits
  G     : 0..31;
  B     : 0..31;

  RGB   : WORD;
  Row   : pWordArray; // de SysUtils
...
Bitmap := TBitmap.Create;
TRY
  Bitmap.Width  := Image1.Width;
  Bitmap.Height := Image1.Height;
  Bitmap.PixelFormat := pf15bit;

  R := 31; // Max Red
  G := 31; // Max Green
  B :=  0; // No Blue

  // "FillRect" utilisant ScanLine
  // Les bits dans chaque pixels sont diposés selon :
  // 0rrrrrvvvvvbbbbb. Le bit de poids fort est ignoré
  RGB := (R SHL 10) OR (G SHL 5) OR B; // "Jaune"

  FOR j := 0 TO Bitmap.Height-1 DO
  BEGIN
    Row := Bitmap.Scanline[j];
    FOR i := 0 TO Bitmap.Width-1 DO
      Row[i] := RGB
  END;

  Image1.Picture.Graphic := Bitmap
FINALLY
  Bitmap.Free
END

procedure TForm1.ButtonFillYellowPf16bitClick(Sender: TObject);

  VAR
    Bitmap:  TBitmap;
    i     :  INTEGER;
    j     :  INTEGER;

    R     :  0..31;  // 5 bits
    G     :  0..63;  // 6 bits (l'oeil est plus sensible au vert)
    B     :  0..31;  // 5 bits

    RGB   :  WORD;
    Row   :  pWordArray;   // de SysUtils
begin
  Bitmap := TBitmap.Create;
  TRY
    Bitmap.Width  := Image1.Width;
    Bitmap.Height := Image1.Height;
    Bitmap.PixelFormat := pf16bit;

    R := 31;    // Max rouge
    G := 63;    // Max vert
    B :=  0;    // Pas de bleu

    // "FillRect" en utilisant ScanLine
    RGB := (R SHL 11) OR (G SHL 5) OR B;  // "Jaune"

    FOR j := 0 TO Bitmap.Height-1 DO
    BEGIN
      Row := Bitmap.Scanline[j];
      FOR  i := 0 TO Bitmap.Width-1 DO
        Row[i] := RGB
    END;

    Image1.Picture.Graphic := Bitmap
  FINALLY
    Bitmap.Free
  END
end;

I-G. Format pf24bit

Listing 7 : Définition de TRGBTripleArray
CONST
  PixelCountMax = 32768;

TYPE
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = ARRAY[0..PixelCountMax-1] OF TRGBTriple;

TYPE   TRGBTripleArray = ARRAY[WORD] OF TRGBTriple;

pRGBTriple = ^TRGBTriple;
TRGBTriple = 
PACKED RECORD
  rgbtBlue : BYTE;
  rgbtGreen: BYTE;
  rgbtRed  : BYTE;
END;

Listing 8A : Création d'un bitmap pf24bit jaune
VAR
  i  :  INTEGER;
  j  :  INTEGER;
  Row:  pRGBTripleArray;
...
Bitmap := TBitmap.Create;
TRY
  Bitmap.PixelFormat := pf24bit;
  Bitmap.Width  := ImageRGB.Width;
  Bitmap.Height := ImageRGB.Height;

  FOR j := 0 TO Bitmap.Height-1 DO
  BEGIN
    Row := Bitmap.Scanline[j];
    FOR i := 0 TO Bitmap.Width-1 DO
    BEGIN
      WITH Row[i] DO
      BEGIN
        rgbtRed   := 255; // pixels jaunes
        rgbtGreen := 255;
        rgbtBlue  :=   0;
      END
    END
  END;

  // Affichage à l'écran
  ImageRGB.Picture.Graphic := Bitmap;

FINALLY
  Bitmap.Free
END

Linsting 8B : avec l'utilisation de CONST TRGBTriple
CONST
  Yellow:  TRGBTriple =
           (rgbtBlue: 0; rgbtGreen: 255; rgbtRed: 255);
VAR
  i  :  INTEGER;
  j  :  INTEGER;
  Row:  pRGBTripleArray;
...
Bitmap := TBitmap.Create;
TRY
  Bitmap.PixelFormat := pf24bit;
  Bitmap.Width  := ImageRGB.Width;
  Bitmap.Height := ImageRGB.Height;

  FOR j := 0 TO Bitmap.Height-1 DO
  BEGIN
    Row := Bitmap.Scanline[j];
    FOR i := 0 TO Bitmap.Width-1 DO
    BEGIN
      Row[i] := Yellow
    END
  END;

  // Affichage à l'écran
  ImageRGB.Picture.Graphic := Bitmap;

FINALLY
  Bitmap.Free
END

FUNCTION  ColorToRGBTriple(CONST Color:  TColor):  TRGBTriple;
BEGIN
  WITH RESULT DO
  BEGIN
    rgbtRed   := GetRValue(Color);
    rgbtGreen := GetGValue(Color);
    rgbtBlue  := GetBValue(Color)
  END
END {ColorToRGBTriple};

Listing 9 : Convertir un bitmap pf24bit en bitmap pf15bit
VAR
  Bitmap15:  TBitmap;
  Bitmap  :  TBitmap;
  i       :  INTEGER;
  j       :  INTEGER;
  Row15   :  pWordArray;
  Row24   :  pRGBTripleArray;
...
Bitmap := TBitmap.Create;
TRY
  Bitmap.LoadFromFile('N:\Images\Flowers\Tulip3.BMP');

  // Conversion en utilisant la méthode "brute"
  Bitmap15 := TBitmap.Create;
  TRY
    Bitmap15.Width  := Bitmap.Width;
    Bitmap15.Height := Bitmap.Height;
    Bitmap15.PixelFormat := pf15bit;

    FOR j := 0 TO Bitmap.Height-1 DO
    BEGIN
      Row15 := Bitmap15.Scanline[j];
      Row24 := Bitmap.Scanline[j];
      FOR i := 0 TO Bitmap.Width-1 DO
      BEGIN
        WITH Row24[i] DO
          Row15[i] := (rgbtRed   SHR 3) SHL 10 OR
                      (rgbtGreen SHR 3) SHL  5 OR
                      (rgbtBlue  SHR 3)
      END
    END;

    Bitmap15.SaveToFile('Tulip3-15A.BMP');
  FINALLY
    Bitmap15.Free
  END;

  // Conversion en utilisant la méthode "simple"
  ASSERT(Bitmap.PixelFormat = pf24bit); // verifie pf24bit
  Bitmap.PixelFormat := pf15bit; // L'affection effectue la conversion
  Bitmap.SaveToFile('Tulip3-15B.BMP')
FINALLY
  Bitmap.Free
END

// Tulip3-15A.BMP et Tulip3-15B.BMP doivent être identiques.

I-H. Format pf32bits

Définition de TRGBQuadArray
CONST
  PixelCountMax = 32768;

TYPE
  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = ARRAY[0..PixelCountMax-1] OF TRGBQuad;

TYPE   TRGBQuadArray = ARRAY[WORD] OF TRGBQuad;

pRGBQuad = ^TRGBQuad;
TRGBQuad = 
PACKED RECORD
  rgbBlue : BYTE;
  rgbGreen: BYTE;
  rgbRed  : BYTE;
  rgbReserved:  BYTE
END;

VAR
  Color :  TColor;
  yellow:  TRGBQuad;
..
  Color := clYellow;
  yellow := TRGBQuad(Color SHL 8);

I-I. Conversion de format

II. Autres notes sur ScanLine

III. Exemples utilisant ScanLine

III-A. Le programme Daisy

III-B. Le programme Split

MakeShadesofGrayImage à partir d'une image RVB
PROCEDURE TFormSplit.MakeShadesOfGrayImage;
  VAR
    Gray   :  INTEGER;   
    i      :  INTEGER;
    j      :  INTEGER;
    rowRGB :  pRGBTripleArray;
    rowGray:  pRGBTripleArray;
BEGIN
  Screen.Cursor := crHourGlass;
  TRY
    FOR j := BitmapRGB.Height-1 DOWNTO 0 DO
    BEGIN
      rowRGB := BitmapRGB.Scanline[j];
      rowGray := BitmapGray.Scanline[j];
      FOR i := BitmapRGB.Width-1 DOWNTO 0 DO
      BEGIN
        // Intensité = (R + G + B) DIV 3
        WITH rowRGB[i] DO
          Gray := (rgbtRed + rgbtGreen + rgbtBlue) DIV 3;

        WITH rowGray[i] DO
        BEGIN
          rgbtRed   := Gray;
          rgbtGreen := Gray;
          rgbtBlue  := Gray
        END

      END
    END;
  FINALLY
    Screen.Cursor := crDefault
  END
END;

III-C. Rotation d'une image

III-D. Permutation de couleurs dans un bitmap pf24bit

Permutation de couleurs en utilisant la tâche Idle
PROCEDURE TFormColorCycle.IdleAction(Sender: TObject; VAR Done: BOOLEAN);
  VAR
    i     :  INTEGER;
    index :  INTEGER;
    j     :  INTEGER;
    RowIn :  pByteArray;
    RowRGB:  pRGBTripleArray;
BEGIN
  IF   NOT CheckBoxCycle.Checked
  THEN Done := TRUE
  ELSE BEGIN
    INC (CycleStart);
    IF   CycleStart >= ColorList.Count
    THEN CycleStart := 0;

    LabelCycle.Caption := IntToStr(CycleStart);

    FOR j := 0 TO BitmapBase.Height-1 DO
    BEGIN
      RowIn  := BitmapBase.ScanLine[j];
      RowRGB := BitmapRGB.ScanLine[j];

      FOR i := 0 TO BitmapBase.Width-1 DO
      BEGIN
        index := CycleStart + RowIn[i];
        IF   index >= ColorList.Count
        THEN index := index - ColorList.Count;

        RowRGB[i] := pRGBTriple(ColorList.Items[index])^
      END
    END;

    ImageShow.Picture.Graphic := BitmapRGB;

    Done := FALSE;
  END
END {IdleAction};

III-E. Autres exemples

IV. Utilisation inappropriée de ScanLine

V. Optimisation

V-A. Minimiser le nombre d'accès à ScanLines

Listing 13 : Minimiser les accès à ScanLines[]
procedure TForm1.ButtonOptimizedClick(Sender: TObject);
  VAR
    Bitmap       :  TBitmap;
    Delta        :  INTEGER;
    i            :  INTEGER;
    j            :  INTEGER;
    k            :  INTEGER;
    LoopCount    :  INTEGER;
    row          :  pRGBTripleArray;
    ScanlineBytes:  INTEGER;
    StartTime    :  DWORD; // DWORD pour que D3 et D4 soient contents
begin
  LabelOptimized.Caption := '';
  LoopCount := SpinEditTimes.Value;

  StartTime := GetTickCount;
  FOR k := 1 TO LoopCount DO
  BEGIN
    Bitmap := TBitmap.Create;
    TRY
      Bitmap.PixelFormat := pf24bit;
      Bitmap.Width  := 640;
      Bitmap.Height := 480;

      row := Bitmap.Scanline[0];
      ScanlineBytes := Integer(Bitmap.Scanline[1]) - Integer(row); 

      FOR j := 0 TO Bitmap.Height-1 DO
      BEGIN
        FOR i := 0 TO Bitmap.Width-1 DO
        BEGIN
          WITH row[i] DO
          BEGIN
            rgbtRed   := k;
            rgbtGreen := i MOD 256;
            rgbtBlue  := j MOD 256;
          END
        END;

       INC(Integer(Row), ScanlineBytes);
      END;
      ImageOptimized.Picture.Graphic := Bitmap
    FINALLY
      Bitmap.Free
    END
  END;
  Delta := GetTickCount - StartTime; // ms
  LabelOptimized.Caption := IntToStr(Delta) + ' Total ms; ' +
    Format('%.1f', [Delta / LoopCount]) + ' ms/bitmap';

end;

V-B. Accéder à ScanLine en utilisant l'assembleur

V-C. Copie d'une zone de données vers ScanLines

Listing 14 : Méthode 'non-optimisée' pour copier un tableau d'entiers dans ScanLine[]
procedure TForm1.Button1Click(Sender: TObject);
 TYPE
    TRGBQuadArray = ARRAY[WORD] OF INTEGER;
    pRGBQuadArray = ^TRGBQuadArray;
  VAR
    i,j   :  INTEGER;
    Bitmap:  TBitmap;
    row   :  pRGBQuadArray;
    Start :  DWORD;
begin
  Start := GetTickCount;
  Bitmap := TBitmap.Create;
  TRY
    Bitmap.PixelFormat := pf32bit;
    Bitmap.Width  := 640;
    Bitmap.Height := 480;
    FOR j := 0 TO Bitmap.Height-1 DO
    BEGIN
      row := Bitmap.Scanline[j];
      FOR i := 0 TO Bitmap.Width-1 DO
      BEGIN
        row[i] := i*j    // Quelque chose pour faire une image "intéressante"
      END
    END;
    Image1.Picture.Graphic := Bitmap;
    ShowMessage( IntToStr(GetTickCount-Start) + ' ms')
  FINALLY
    Bitmap.Free;
  END
end;

 // Affiche l'adresse des "coins" du bitmap
IF   ((i=0) OR (i=Bitmap.Width-1)) AND
     ((j=0) OR (j=1) OR (j=Bitmap.Height-1))
THEN Memo1.Lines.Add('(' + IntToStr(i) + ', ' +  IntToStr(j) + ')  = ' +
                           InttoHex( Integer(@row[i]),8 ));