Blog de Gilles Vasseur - Pascal et compagnie

Après avoir appris à dessiner des rectangles vides ou remplis, avec ou sans angles arrondis, il est temps de doter nos dessins d'attributs plus recherchés. Après tout, la LCL permet à peu près de dessiner comme nous l'avons fait jusqu'à présent. Alors, qu'apporte la bibliothèque BGRABitmap ?

La première lacune de la LCL, et elle est de taille, est de ne pas incorporer d'anticrénelage afin de rendre le dessin plus lisse, sans effet d'escalier pour les lignes obliques. Pour illustrer cette différence majeure, il suffit d'un exemple tout simple qui dessinera une ligne sur un TCanvas de la LCL et sa sœur jumelle sur un TCanvasBGRA de la bibliothèque BGRABitmap.

Voici l'interface d'une telle illustration :

Deux TPaintBox abriteront le dessin d'une ligne chacun tandis que deux TTrackbar permettront de jouer, la première sur l'inclinaison des lignes, la seconde sur la largeur du trait.

Le fichier lfm correspondant à cette interface utilisateur est alors :

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
object MainForm: TMainForm
  Left = 250
  Height = 368
  Top = 184
  Width = 615
  ActiveControl = tbPos
  Caption = 'Test de l''anticrénelage'
  ClientHeight = 368
  ClientWidth = 615
  LCLVersion = '1.6.2.0'
  object pbLCL: TPaintBox
    Left = 80
    Height = 169
    Top = 88
    Width = 169
    OnPaint = pbLCLPaint
  end
  object pbBGRA: TPaintBox
    Left = 320
    Height = 169
    Top = 88
    Width = 169
    OnPaint = pbBGRAPaint
  end
  object tbPos: TTrackBar
    Left = 152
    Height = 25
    Top = 280
    Width = 169
    Max = 169
    OnChange = tbPosChange
    Position = 37
    TabOrder = 0
  end
  object lblLCL: TLabel
    Left = 80
    Height = 15
    Top = 48
    Width = 20
    Caption = 'LCL'
    ParentColor = False
  end
  object lblBGRABitmap: TLabel
    Left = 320
    Height = 15
    Top = 48
    Width = 68
    Caption = 'BGRABitmap'
    ParentColor = False
  end
  object lblPos: TLabel
    Left = 80
    Height = 15
    Top = 280
    Width = 49
    Caption = 'Position :'
    FocusControl = tbPos
    ParentColor = False
  end
  object tbWidth: TTrackBar
    Left = 152
    Height = 25
    Top = 320
    Width = 169
    Min = 1
    OnChange = tbPosChange
    Position = 1
    TabOrder = 1
  end
  object lblWidth: TLabel
    Left = 80
    Height = 15
    Top = 320
    Width = 46
    Caption = 'Largeur :'
    FocusControl = tbWidth
    ParentColor = False
  end
end

Le code ne pose pas de réels problèmes. Il s'agit de dessiner dans les gestionnaires OnPaint des TPaintBox les lignes désirées et de mettre à jour les dessins en cas de changement des valeurs prises par les TTrackBar. Voici le listing complet de cette micro-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
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
{ |========================================================================|
  |                                                                        |
  |                  Projet : découverte de BGRABITMAP                     |
  |                  Description : Programme exemple 05 bis ANTIALIASING   |
  |                  Unité : main.pas                                      |
  |                  Site : www.developpez.com                             |
  |                  Copyright : © Gilles VASSEUR 2017                     |
  |                                                                        |
  |                  Date:    26/02/2017 19:34:10                          |
  |                  Version : 1.0.0                                       |
  |                                                                        |
  |========================================================================| }
 
unit main;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  ComCtrls, StdCtrls, BGRABitmapTypes, BGRABitmap;
 
type
 
  { TMainForm }
 
  TMainForm = class(TForm)
    lblWidth: TLabel;
    lblPos: TLabel;
    lblLCL: TLabel;
    lblBGRABitmap: TLabel;
    pbLCL: TPaintBox;
    pbBGRA: TPaintBox;
    tbPos: TTrackBar;
    tbWidth: TTrackBar;
    procedure pbLCLPaint(Sender: TObject);
    procedure pbBGRAPaint(Sender: TObject);
    procedure tbPosChange(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.lfm}
 
{ TMainForm }
 
procedure TMainForm.pbLCLPaint(Sender: TObject);
begin
  pbLCL.Canvas.Brush.Color := clWhite;
  pbLCL.Canvas.Pen.Width := tbWidth.Position;
  pbLCL.Canvas.FillRect(pbLCL.ClientRect);
  pbLCL.Canvas.MoveTo(20,20);
  pbLCL.Canvas.LineTo(tbPos.Position, 145);
end;
 
procedure TMainForm.pbBGRAPaint(Sender: TObject);
var
  Lbmp: TBGRABitmap;
begin
  Lbmp := TBGRABitmap.Create(pbBGRA.Width, pbBGRA.Height, BGRAWhite);
  try
    Lbmp.CanvasBGRA.Pen.Width := tbWidth.Position;
    Lbmp.CanvasBGRA.MoveTo(20, 20);
    Lbmp.CanvasBGRA.LineTo(tbPos.Position, 145);
    lbmp.Draw(pbBGRA.Canvas, 0, 0);
  finally
    Lbmp.Free;
  end;
end;
 
procedure TMainForm.tbPosChange(Sender: TObject);
begin
  Invalidate;
end;
 
end.

En action, cet exemple montre clairement les différences, en particulier pour certains angles et épaisseurs de trait. Une capture d'écran peut donner ceci :

Pour le moment, le fait de ne dessiner que des rectangles dont les côtés sont parallèles à ceux de l'écran ne permet pas de profiter au mieux de l'anticrénelage. Seuls les bords arrondis des rectangles seront plus esthétiques avec la bibliothèque BGRABitmap. Toutefois, nous verrons ultérieurement que les rotations des dessins (dont les rectangles) seront bien plus agréables au regard avec l'anticrénelage.

La seconde différence importante entre la bibliothèque LCL et celle fournie par BGRABitmap est la transparence que propose la dernière. C'est là que nous allons retrouver nos rectangles.

La transparence est fournie par le quatrième paramètre définissant une couleur : B pur Blue, G pour Green, R pour Red et A pour ce qu'il est convenu d'appeler le Canal Alpha. Comme ses congénères, le canal alpha est de type byte et peut par conséquent prendre une valeur de 0 à 255. Plus sa valeur est faible et plus la couleur associée sera transparente. Pour une valeur de 0, elle disparaît ; pour une valeur de 255, elle recouvre complètement la couleur sous-jacente.

Pour illustrer notre propos, nous allons reprendre l'exemple de la première partie en lui adjoignant une TGroupBox supplémentaire qui abritera les contrôles de test de la transparence.

L'interface utilisateur donnera ceci :

On voit l'ajout de deux TTrackBar : la première jouera de la transparence sur un rectangle simple alors que la seconde agira sur des rectangles entièrement colorés. De même, les deux TButton sont là pour dessiner des rectangles pleins qui chevaucheront en partie les dessins obtenus grâce aux boutons déjà présents.

Voici tout d'abord la fiche lfm qui permet d'obtenir l'interface utilisateur désiré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
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
 
object MainForm: TMainForm
  Left = 250
  Height = 525
  Top = 184
  Width = 905
  Caption = 'Test de Rectangle ( transparence) - BGRABITMAP'
  ClientHeight = 525
  ClientWidth = 905
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  Position = poScreenCenter
  LCLVersion = '1.6.2.0'
  object PaintBox: TPaintBox
    Left = 24
    Height = 440
    Top = 8
    Width = 440
  end
  object gbSimple: TGroupBox
    Left = 480
    Height = 232
    Top = 8
    Width = 176
    Caption = 'Simples'
    ClientHeight = 212
    ClientWidth = 172
    TabOrder = 0
    object btnRectdmSet: TButton
      Left = 16
      Height = 25
      Top = 16
      Width = 136
      Caption = 'Rectangle (dmSet)'
      OnClick = btnRectdmSetClick
      TabOrder = 0
    end
    object btnRectangleBGRAPixel: TButton
      Left = 16
      Height = 25
      Top = 48
      Width = 136
      Caption = 'Rectangle (BGRAPixel)'
      OnClick = btnRectangleBGRAPixelClick
      TabOrder = 1
    end
    object btnRectangleBorderFillColor: TButton
      Left = 16
      Height = 25
      Top = 80
      Width = 136
      Caption = 'Rectangle (Border/Fill)'
      OnClick = btnRectangleBorderFillColorClick
      TabOrder = 2
    end
    object btnFillRect: TButton
      Left = 16
      Height = 25
      Top = 112
      Width = 136
      Caption = 'FillRect (color)'
      OnClick = btnFillRectClick
      TabOrder = 3
    end
    object btnRoundRect: TButton
      Left = 16
      Height = 25
      Top = 144
      Width = 136
      Caption = 'RoundRect (BGRAPixel)'
      OnClick = btnRoundRectClick
      TabOrder = 4
    end
    object btnRoundRectBorderFillColor: TButton
      Left = 16
      Height = 25
      Top = 176
      Width = 136
      Caption = 'RoundRect (Border/Fill)'
      OnClick = btnRoundRectBorderFillColorClick
      TabOrder = 5
    end
  end
  object btnClear: TButton
    Left = 24
    Height = 25
    Top = 480
    Width = 75
    Caption = 'Nettoyer'
    OnClick = btnClearClick
    TabOrder = 1
  end
  object gbOpacity: TGroupBox
    Left = 672
    Height = 232
    Top = 8
    Width = 168
    Caption = 'Avec transparence'
    ClientHeight = 212
    ClientWidth = 164
    TabOrder = 2
    object btnRectangleOpacity: TButton
      Left = 16
      Height = 25
      Top = 16
      Width = 136
      Caption = 'Rectangle (transparence)'
      OnClick = btnRectangleOpacityClick
      TabOrder = 0
    end
    object tbOpacity: TTrackBar
      Left = 16
      Height = 25
      Top = 56
      Width = 136
      Frequency = 5
      Max = 255
      OnChange = btnRectangleOpacityClick
      Position = 0
      TabOrder = 1
    end
    object btnFillRectOpacity: TButton
      Left = 16
      Height = 25
      Top = 96
      Width = 136
      Caption = 'FillRect (transparence)'
      OnClick = btnFillRectOpacityClick
      TabOrder = 2
    end
    object tbFillOpacity: TTrackBar
      Left = 16
      Height = 25
      Top = 136
      Width = 136
      Frequency = 5
      Max = 255
      OnChange = btnFillRectOpacityClick
      Position = 0
      TabOrder = 3
    end
  end
end

Le code ajouté est lui aussi très simple : en fait, il ne fait qu'étendre celui déjà en place en utilisant un paramètre supplémentaire lié à la transparence.

Le premier gestionnaire est partagé par un bouton et une TTrackBar. Le traitement est différencié grâce à un test sur Sender avec Is.
Voici à quoi il ressemble :

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
procedure TMainForm.btnFillRectOpacityClick(Sender: TObject);
// FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
//   overload;
var
  LOpacity: Byte;
begin
  LOpacity := 127;
  if (Sender is TTrackBar) then
  begin
    bmpWork.FillRect(0, 0, PaintBox.Width, PaintBox.Height, BGRABlack);
    bmpWork.Rectangle(60, 60, 140, 120, BGRA(255, 128, 128), dmSet);
    LOpacity := tbFillOpacity.Position;
    bmpWork.Rectangle(100, 100, 180, 140, BGRA(255, 0, 0, LOpacity),
    BGRA(128, 128, 255, LOpacity),
    dmDrawWithTransparency);
  end;
  bmpWork.FillRect(120, 120, 200, 160, BGRA(0, 255, 0, LOpacity),
    dmDrawWithTransparency);
  bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

On remarquera surtout que la fonction BGRA a gagné un paramètre qui correspond au canal alpha. De plus, le paramètre de type TDrawMode des méthodes Rectangle et FillRect est mis à dmDrawWithTransparency au lieu de dmSet comme précédemment. Ces deux changements suffisent pour traiter correctement la transparence.

La seconde méthode ajoutée correspond à l'autre TButton et à la seconde TTrackBar. Elle ressemble à la précédente et emploie les mêmes paramètres supplémentaires :

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
procedure TMainForm.btnRectangleOpacityClick(Sender: TObject);
// Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel;
//   mode: TDrawMode); override;
var
  LOpacity: Byte;
begin
  LOpacity := 127;
  if (Sender is TTrackBar) then
  begin
    bmpWork.FillRect(0, 0, PaintBox.Width, PaintBox.Height, BGRABlack);
    bmpWork.Rectangle(60, 60, 140, 120, BGRA(255, 128, 128), dmSet);
    LOpacity := tbOpacity.Position;
  end;
  bmpWork.Rectangle(100, 100, 180, 140, BGRA(255, 0, 0, LOpacity),
    BGRA(128, 128, 255, LOpacity),
    dmDrawWithTransparency);
  bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

On notera que l'effacement de la zone d'affichage utilise tout simplement un rectangle plein de la couleur de fond désirée (ici, BGRABlack).

Comme toujours, il est très profitable de modifier le programme proposé et de faire varier les différents paramètres.
Une capture d'écran est proposée pour mieux saisir les effets obtenus qui, s'ils sont encore simples, vont bien au-delà de ce que fournit par défaut la LCL :

Pour ce qui est des codes source, vous trouverez celui du test de l'anticrénelage lines.7z et celui des rectangles plus ou moins transparents rectangles2.7z.