Blog de Gilles Vasseur - Pascal et compagnie

Dans le billet précédent, j'ai proposé une petite application utilisant PutImageAngle, mais mettant volontairement de côté deux des paramètres possibles de cette méthode : AOutputBounds qui délimite la zone d'affichage de l'image traitée et AResampleFilter qui permet de choisir le filtre utilisé lors de la modification de la même image.

AOutputBounds est du type TRect, ce qui signifie qu'il contient au choix deux points définissant le point supérieur gauche et le point inférieur droit, ou quatre coordonnées représentant les mêmes points.

En déposant sur la fiche un composant TCheckBox à renommer cbRect et en modifiant la méthode associée à l'événement OnPaint de la TPaintBox, il devient possible de prendre en compte ou non la restriction de la surface à dessiner :

Code Pascal :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
procedure TMainForm.PaintBoxPaint(Sender: TObject);
// *** la PaintBox est repeinte ***
var
  LBmp: TBGRABitmap;
  LRect: TRect;
begin
  if cbRect.Checked then
  begin
    // Rectangle restreint choisi pour le dessin
    LRect.Bottom:=150;
    LRect.Left:=10;
    LRect.Right:=150;
    LRect.Top:=10;
  end
  else
    // surface complète de la surface de dessin
    LRect := PaintBox.ClientRect;
  LBmp := TBGRABitmap.Create(PaintBox.Width, PaintBox.Height, BGRABlack);
  try
    LBmp.PutImageAngle((PaintBox.Width - bmpWork.Width) * tckbX.Position / 100 - 0.5,
      (PaintBox.Height - bmpWork.Height) * tckbY.Position / 100 - 0.5,
      bmpWork,
      tckbAngle.Position, LRect,
      bmpWork.Width * tckbRotCenter.Position / 100 - 0.5,
      bmpWork.Height * tckbRotCenter.Position / 100 - 0.5,
      seOpacity.Value, cbOffset.Checked, cbBlur.Checked);
    LBmp.Draw(PaintBox.Canvas, 0, 0, False);
  finally
    LBmp.Free;
  end;
end;

La nouvelle TCheckBox voit son événement OnChange relié comme les autres contrôles à la méthode tckbAngleChange qui centralise ainsi tout changement. À présent, l'image traitée n'apparaîtra que si elle est incluse dans le rectangle prédéfini :

Pour tester l'influence de AResampleFilter, il faut revoir l'interface, car le nouveau paramètre remplace le drapeau concernant le flou. Le type utilisé devient alors TResampleFilter déclaré ainsi :

Code Pascal :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
TResampleFilter = (
    {** Equivalent of simple stretch with high quality and pixel-centered coordinates }
    rfBox,
    {** Linear interpolation giving slow transition between pixels }
    rfLinear,
    {** Mix of ''rfLinear'' and ''rfCosine'' giving medium speed stransition between pixels }
    rfHalfCosine,
    {** Cosine-like interpolation giving fast transition between pixels }
    rfCosine,
    {** Simple bi-cubic filter (blurry) }
    rfBicubic,
    {** Mitchell filter, good for downsizing interpolation }
    rfMitchell,
    {** Spline filter, good for upsizing interpolation, however slightly blurry }
    rfSpline,
    {** Lanczos with radius 2, blur is corrected }
    rfLanczos2,
    {** Lanczos with radius 3, high contrast }
    rfLanczos3,
    {** Lanczos with radius 4, high contrast }
    rfLanczos4,
    {** Best quality using rfMitchell or rfSpline }
    rfBestQuality);

Quand bien même les différentes options ne seront pas toujours visibles avec une image en rotation, la création de onze boutons radio dans un TRadioGroup s'impose :

Il faut ensuite déclarer une variable rsFilter dans la classe TMainForm :

Code Pascal :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 procedure RadioButton1Change(Sender: TObject);
    procedure tckbAngleChange(Sender: TObject);
  private
    { private declarations }
    rsFilter: TResampleFilter;
  public
    { public declarations }
    bmpWork: TBGRABitmap;
  end;

Chaque bouton radio voit alors son gestionnaire d'événement OnChange lié à une méthode centralisée qui se sert du transtypage du paramètre Sender en TRadioButton et de la propriété TabOrder pour discriminer les boutons :

Code Pascal :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
procedure TMainForm.RadioButton1Change(Sender: TObject);
// *** nouveau filtre actif ***
begin
  rsFilter := TResampleFilter((Sender as TRadioButton).TabOrder);
  PaintBox.Invalidate; // force le réaffichage
end;

Enfin, la méthode pour l'événement OnPaint de la TPainBox doit tenir compte du changement de la nouvelle variante de PutImageAngle utilisée :

Code Pascal :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
procedure TMainForm.PaintBoxPaint(Sender: TObject);
// *** la PaintBox est repainte ***
var
  LBmp: TBGRABitmap;
begin
  LBmp := TBGRABitmap.Create(PaintBox.Width, PaintBox.Height, BGRABlack);
  try
    LBmp.PutImageAngle((PaintBox.Width - bmpWork.Width) * tckbX.Position / 100 - 0.5,
      (PaintBox.Height - bmpWork.Height) * tckbY.Position / 100 - 0.5,
      bmpWork,
      tckbAngle.Position, rsFilter,
      bmpWork.Width * tckbRotCenter.Position / 100 - 0.5,
      bmpWork.Height * tckbRotCenter.Position / 100 - 0.5,
      seOpacity.Value, cbOffset.Checked);
    LBmp.Draw(PaintBox.Canvas, 0, 0, False);
  finally
    LBmp.Free;
  end;
end;

L'exécution du programme permet de tester les différents filtres, en particulier lorsque l'image subit une rotation qui ne correspond pas à un multiple de l'angle droit :

Encore une fois, à vous de jouer et de transformer ce programme comme bon vous semble : l'objectif est de comprendre comment fonctionne la méthode PutImageAngle .

Liens pour les codes source des deux exemples : rotateimage3.7z et rotateimage2.7z