Apprendre à dessiner des rectangles - BGRABitmap avec Lazarus (partie 2/2)

Par Gilles Vasseur

Le 6 juin 2017, par gvasseur58

0PARTAGES

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

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

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

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

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

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 [ATTACH]248754d1/a/a/a" /> et celui des rectangles plus ou moins transparents [ATTACH]248760d1/a/a/a" />.

Une erreur dans cette actualité ? Signalez-nous-la !

Votre nom : Votre e-mail :

Décrivez l'erreur que vous souhaitez porter à notre connaissance :

Identifiez-vous

Créer un compte

Apprendre à dessiner des rectangles - BGRABitmap avec Lazarus (partie 2/2)

Par Gilles Vasseur

Identifiant
Mot de passe

Mot de passe oublié ?

Identifiez-vous

Créer un compte

Apprendre à dessiner des rectangles - BGRABitmap avec Lazarus (partie 2/2) Par Gilles Vasseur

Apprendre à dessiner des rectangles - BGRABitmap avec Lazarus (partie 2/2)

Par Gilles Vasseur