Blog de Gilles Vasseur - Pascal et compagnie

Il est souvent nécessaire de redimensionner une image afin qu'elle s'insère au mieux dans une surface définie. La bibliothèque offre une méthode simple pour des redimensionnements de base : il s'agit de Resample qui appartient à la classe principale TBGRABitmap.

Voici sa déclaration :

Code Pascal :

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

1
2
function Resample(newWidth, newHeight: integer;
      mode: TResampleMode = rmFineResample): TBGRACustomBitmap; override;

Bien sûr, l'essentiel de son action tient dans les nouvelles dimensions newWidth et newHeight.
On voit par ailleurs qu'elle utilise un paramètre de type TResampleMode, une énumération elle-même définie ainsi :

Code Pascal :

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

1
2
3
4
5
6
7
8
9
TResampleMode = (
    {** Low quality resample by repeating pixels, stretching them }
    rmSimpleStretch,
    {** Use resample filters. This gives high
        quality resampling however the proportion changes slightly because
        the first and last pixel are considered to occupy only half a unit as
        they are considered as the border of the picture
        (pixel-centered coordinates) }
    rmFineResample);

Les commentaires indiquent la qualité meilleure de l'option utilisée par défaut par Resample, mais aussi un problème de proportion dû à l'utilisation de coordonnées non entières. En général, la gêne occasionnée est infime et reste au moins tout à fait acceptable.

Pour revenir à Resample, il est à noter que cette méthode renvoie un objet de type TBGRACustomBitmap si bien qu'il sera nécessaire de le transtyper vers le type réellement utilisé, généralement TBGRABitmap.

Afin de tester cette méthode, voici à présent le fichier lfm une petite application :

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
object MainForm: TMainForm
  Left = 376
  Height = 680
  Top = 22
  Width = 586
  Caption = 'Test de RESAMPLE - BGRABitmap'
  ClientHeight = 680
  ClientWidth = 586
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  Position = poScreenCenter
  LCLVersion = '1.6.2.0'
  object tckbResample: TTrackBar
    Left = 24
    Height = 25
    Top = 624
    Width = 320
    Frequency = 30
    Max = 200
    OnChange = tckbResampleChange
    PageSize = 20
    Position = 100
    TabOrder = 0
  end
  object lblSize: TLabel
    Left = 352
    Height = 15
    Top = 624
    Width = 27
    Caption = 'Taille'
    FocusControl = tckbResample
    ParentColor = False
  end
  object PaintBox: TPaintBox
    Left = 24
    Height = 584
    Top = 24
    Width = 544
    OnPaint = PaintBoxPaint
  end
  object cbFine: TCheckBox
    Left = 416
    Height = 19
    Top = 624
    Width = 89
    Caption = 'Amélioration'
    OnChange = tckbResampleChange
    TabOrder = 1
  end
end

Du point de vue graphique, l'interface devrait se présenter ainsi :

Le principe de fonctionnement de l'application est simple : suivant la position du curseur, l'image chargée sera reproduite en plus ou moins grand dans son conteneur qui n'est autre qu'une TPaintBox. De plus, une TCheckBox permet de changer de type de filtre pour le redimensionnement.

Le code source complet est le suivant :

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
{ |========================================================================|
  |                                                                        |
  |                  Projet : découverte de BGRABITMAP                     |
  |                  Description : Programme exemple 04 RESAMPLE           |
  |                  Unité : main.pas                                      |
  |                  Site : www.developpez.com                             |
  |                  Copyright : © Gilles VASSEUR 2017                     |
  |                                                                        |
  |                  Date:    15/02/2017 10:15:10                          |
  |                  Version : 1.0.0                                       |
  |                                                                        |
  |========================================================================| }
 
unit main;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  StdCtrls, ExtCtrls, BGRABitmap, BGRABitmapTypes;
 
type
 
  { TMainForm }
 
  TMainForm = class(TForm)
    cbFine: TCheckBox;
    lblSize: TLabel;
    PaintBox: TPaintBox;
    tckbResample: TTrackBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure tckbResampleChange(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    bmpWork: TBGRABitmap;
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.lfm}
 
{ TMainForm }
 
procedure TMainForm.FormCreate(Sender: TObject);
// *** chargement de l'image à la création ***
begin
  bmpWork := TBGRABitmap.Create('chat.png');
end;
 
procedure TMainForm.FormDestroy(Sender: TObject);
// *** libération des ressources ***
begin
  bmpWork.Free;
end;
 
procedure TMainForm.PaintBoxPaint(Sender: TObject);
// *** la PaintBox est repeinte ***
var
  LMode: TResampleMode;
  LBmp: TBGRABitmap;
begin
  if cbFine.Checked then
    LMode := rmFineResample
  else
    LMode := rmSimpleStretch;
  LBmp := TBGRABitmap.Create(bmpWork.Width * tckbResample.Position div 100,
    bmpWork.Height * tckbResample.Position div 100);
  try
    LBmp := bmpWork.Resample(Lbmp.Width, LBmp.Height, LMode) as TBGRABitmap;
    LBmp.Draw(PaintBox.Canvas, 0, 0);
  finally
    LBmp.Free;
  end;
end;
 
procedure TMainForm.tckbResampleChange(Sender: TObject);
// *** une valeur a été modifiée ***
begin
  PaintBox.Invalidate;
end;
 
end.

La seule difficulté qu'il présente est d'utiliser un pourcentage de la position de la TTrackBar afin de calculer les nouvelles dimensions de l'image.

Il va sans dire que cette méthode finalement toute simple est très utile et par conséquent très fréquemment utilisée : en particulier, elle rend possible un travail efficace des images traitées par couches qui seront de dimensions égales ou adaptées à des proportions désirées.

Le code source de l'application d'exemple est disponible ici : resampleimage.7z

Bonne découverte !