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

Par Gilles Vasseur

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 :

248735


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 :

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 :

{ |========================================================================|
| |
| 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 :

248736


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:

248739

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:


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:

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:

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:

248751

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