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

Par Gilles Vasseur

Avec ce mini-tutoriel, je vous propose de dessiner quelques rectangles à l'aide de la bibliothèque BGRABitmap. Ce premier travail préparera les suivants qui mettront en œuvre des techniques plus complexes comme la transparence ou l'utilisation de textures.

En guise d'illustration, une petite application abritera une TPaintBox pour le résultat des dessins et quelques TButton pour lancer leur exécution.
Voici tout d'abord l'interface visuelle qui ne comprend que des composants standard :

245720


La fiche lfm correspondante est celle-ci :

object MainForm: TMainForm
Left = 250
Height = 525
Top = 184
Width = 905
Caption = 'Test de Rectangle - 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
end

Avant toute chose, il va falloir créer un objet de type TBGRABitmap dans le gestionnaire de l'événement OnCreate de la fiche principale:

procedure TMainForm.FormCreate(Sender: TObject);
begin
bmpWork := TBGRABitmap.Create(PaintBox.Width, PaintBox.Height, BGRABlack);
end;

Cet objet aura été préalablement déclaré dans la classe TForm (ici rebaptisée TMainForm), par exemple dans sa partie privée:

private
{ private declarations }
bmpWork: TBGRABitmap;
public
{ public declarations }
end;


Dorénavant, les dessins pourront être affichés dans la TPaintBox, l'objet bmpWork ayant été exactement initialisé à ses dimensions.

Bien sûr, la création oblige à créer son pendant pour libérer les ressources mobilisées. C'est dans le gestionnaire OnDestroy que cette libération trouvera tout naturellement sa place :

procedure TMainForm.FormDestroy(Sender: TObject);
begin
bmpWork.Free;
end;


Après ce travail de préparation, il est temps d'aborder le dessin des rectangles les plus simples.

La façon la plus simple de dessiner un rectangle est d'appeler la méthode Rectangle avec ses paramètres de base:

procedure TMainForm.btnRectdmSetClick(Sender: TObject);
// Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
begin
bmpWork.Rectangle(20, 20, 100, 80, BGRAWhite, dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

On voit qu'il faut en premier lieu définir les coordonnées du point supérieur gauche (20, 20) et de celui du point inférieur droit (100, 80), en se souvenant bien entendu que les ordonnées sont placées en Pascal dans le sens opposé des repères couramment utilisés par les êtres humains (ainsi, le coin supérieur gauche de la zone de dessin a pour coordonnées (0,0) ). Ces coordonnées sont suivies de l'indication d'une couleur de type TBGRAPixel (type sur lequel nous reviendrons sous peu) et d'un mode de dessin qui sera toujours dmSet (remplacement du point recouvert) dans les exemples de cette première approche.

Après l'appel de la méthode désirée, il faut transférer le dessin virtuel sur le canevas de la zone réelle de dessin, ici celui de la TPaintBox : c'est le rôle de la méthode Draw qui prend pour paramètres le canevas de la zone dessin et les coordonnées du premier point supérieur gauche d'où il faut commencer à dessiner (ici, le point (0, 0) ).

Le résultat de la nouvelle méthode définie, lorsqu'on clique sur le bouton correspondant, est l'affichage d'un rectangle blanc sur la surface noire du TBGRABitmap.

L'emploi de constantes comme BGRABlack manque de souplesse. C'est pourquoi BGRABitmap offre des fonctions utiles comme BGRA qui construisent des données de type TBGRAPixel.

TBGRAPixel est un enregistrement étendu, c'est-à-dire incluant des propriétés et des méthodes, un peu à la manière des classes. En voici la déclaration:

TBGRAPixel = packed record
private
function GetClassIntensity: word;
function GetClassLightness: word;
procedure SetClassIntensity(AValue: word);
procedure SetClassLightness(AValue: word);
public
{$IFDEF BGRABITMAP_RGBAPIXEL}
red, green, blue, alpha: byte;
{$ELSE}
blue, green, red, alpha: byte;
{$ENDIF}
procedure FromRGB(ARed,AGreen,ABlue: Byte; AAlpha: Byte = 255);
procedure FromColor(AColor: TColor; AAlpha: Byte = 255);
procedure FromString(AStr: string);
procedure FromFPColor(AColor: TFPColor);
procedure ToRGB(out ARed,AGreen,ABlue,AAlpha: Byte); overload;
procedure ToRGB(out ARed,AGreen,ABlue: Byte); overload;
function ToColor: TColor;
function ToString: string;
function ToGrayscale(AGammaCorrection: boolean = true): TBGRAPixel;
function ToFPColor: TFPColor;
class Operator := (Source: TBGRAPixel): TColor;
class Operator := (Source: TColor): TBGRAPixel;
property Intensity: word read GetClassIntensity write SetClassIntensity;
property Lightness: word read GetClassLightness write SetClassLightness;
end;

L'essentiel dans un premier temps est de constater que ce type d'enregistrement définit les couleurs à partir de quatre données essentielles qui sont des octets (byte). Les trois premières données (blue, green, red) fixent le mélange des couleurs de base et la dernière (alpha) indique le degré d'opacité qui ne sera utilisé que dans les tutoriels suivants.

Pour revenir à la fonction BGRA, elle renvoie justement un enregistrement de type TBGRAPixel à partir de ces données de base:

{** Creates a pixel with given RGBA values }
function BGRA(red, green, blue, alpha: byte): TBGRAPixel; overload; inline;
{** Creates a opaque pixel with given RGB values }
function BGRA(red, green, blue: byte): TBGRAPixel; overload; inline;

C'est la version sans le paramètre alpha dont il sera question par la suite. Comme un paramètre de type TBGRAPixel est attendu par de nombreuses méthodes de dessin de la classe TBGRABitmap, on comprendra que BGRA soit si utile.

En remplaçant la constante prédéfinie BGRABlack par le résultat de cette fonction, on gagne beaucoup en souplesse et en précision dans la couleur attendue:

procedure TMainForm.btnRectangleBGRAPixelClick(Sender: TObject);
// Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
var
Lc: TBGRAPixel;
begin
Lc := BGRA(255, 128, 128);
bmpWork.Rectangle(60, 60, 140, 120, Lc, dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

Bien sûr, il serait tout à fait possible d'insérer directement la fonction comme paramètre de la méthode:

procedure TMainForm.btnRectangleBGRAPixelClick(Sender: TObject);
// Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
begin
bmpWork.Rectangle(60, 60, 140, 120, BGRA(255, 128, 128), dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

Le résultat sera toujours un rectangle, mais dont la couleur (et éventuellement la transparence) sera maîtrisée.

Il ne reste qu'à tester les autres méthodes disponibles à partir des éléments jusqu'alors étudiés.

On peut décider, par exemple, de remplir un rectangle. Il gardera sa bordure, mais son intérieur sera peint avec une couleur:

procedure TMainForm.btnRectangleBorderFillColorClick(Sender: TObject);
// Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel;
// mode: TDrawMode); override;
begin
bmpWork.Rectangle(100, 100, 180, 140, BGRA(255, 0, 0), BGRA(128, 128, 255),
dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

Au contraire, on pourra décider que le bord du rectangle n'est pas nécessaire et faire alors appel à la méthode FillRect:

procedure TMainForm.btnFillRectClick(Sender: TObject);
// FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
// overload;
begin
bmpWork.FillRect(120, 120, 200, 160, BGRA(0, 255, 0), dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

On pourra aussi préférer des rectangles aux bords arrondis. Il faudra alors faire appel à la méthode RoundRect qui prend en plus deux nouveaux paramètres indiquant le diamètre de l'ellipse qui définit l'arrondi du rectangle:

procedure TMainForm.btnRoundRectClick(Sender: TObject);
// RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor: TBGRAPixel;
// ADrawMode: TDrawMode = dmDrawWithTransparency); override;
var
Lc: TBGRAPixel;
begin
Lc := BGRA(255, 128, 128);
bmpWork.RoundRect(260, 60, 340, 120, 12, 12, Lc, dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

Enfin, une variante de la méthode précédente existe pour dessiner des rectangles pleins aux bords arrondis:

procedure TMainForm.btnRoundRectBorderFillColorClick(Sender: TObject);
// RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor, FillColor:
// TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
begin
bmpWork.RoundRect(300, 100, 380, 140, 15, 15, BGRA(255, 0, 0), BGRA(128, 128, 255),
dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

Le code source complet de l'application d'exemple donne ceci :

{ |========================================================================|
| |
| Projet : découverte de BGRABITMAP |
| Description : Programme exemple 05 RECTANGLES |
| Unité : main.pas |
| Site : www.developpez.com |
| Copyright : © Gilles VASSEUR 2017 |
| |
| Date: 17/02/2017 14:40:10 |
| Version : 1.0.0 |
| |
|========================================================================| }

unit main;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
StdCtrls, BGRABitmapTypes, BGRABitmap;

type

{ TMainForm }

TMainForm = class(TForm)
btnRectdmSet: TButton;
btnRectangleBGRAPixel: TButton;
btnRectangleBorderFillColor: TButton;
btnFillRect: TButton;
btnRoundRect: TButton;
btnRoundRectBorderFillColor: TButton;
btnClear: TButton;
gbSimple: TGroupBox;
PaintBox: TPaintBox;
procedure btnClearClick(Sender: TObject);
procedure btnFillRectClick(Sender: TObject);
procedure btnRectangleBGRAPixelClick(Sender: TObject);
procedure btnRectangleBorderFillColorClick(Sender: TObject);
procedure btnRectdmSetClick(Sender: TObject);
procedure btnRoundRectBorderFillColorClick(Sender: TObject);
procedure btnRoundRectClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
bmpWork: TBGRABitmap;
public
{ public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.btnRectdmSetClick(Sender: TObject);
// Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
begin
bmpWork.Rectangle(20, 20, 100, 80, BGRAWhite, dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

procedure TMainForm.btnRoundRectBorderFillColorClick(Sender: TObject);
// RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor, FillColor:
// TBGRAPixel; ADrawMode: TDrawMode = dmDrawWithTransparency); override;
begin
bmpWork.RoundRect(300, 100, 380, 140, 15, 15, BGRA(255, 0, 0), BGRA(128, 128, 255),
dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

procedure TMainForm.btnRoundRectClick(Sender: TObject);
// RoundRect(X1, Y1, X2, Y2: integer; DX, DY: integer; BorderColor: TBGRAPixel;
// ADrawMode: TDrawMode = dmDrawWithTransparency); override;
var
Lc: TBGRAPixel;
begin
Lc := BGRA(255, 128, 128);
bmpWork.RoundRect(260, 60, 340, 120, 12, 12, Lc, dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

procedure TMainForm.btnRectangleBGRAPixelClick(Sender: TObject);
// Rectangle(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
var
Lc: TBGRAPixel;
begin
Lc := BGRA(255, 128, 128);
bmpWork.Rectangle(60, 60, 140, 120, Lc, dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

procedure TMainForm.btnFillRectClick(Sender: TObject);
// FillRect(x, y, x2, y2: integer; c: TBGRAPixel; mode: TDrawMode); override;
// overload;
begin
bmpWork.FillRect(120, 120, 200, 160, BGRA(0, 255, 0), dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

procedure TMainForm.btnClearClick(Sender: TObject);
begin
bmpWork.FillRect(0, 0, PaintBox.Width, PaintBox.Height, BGRABlack);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

procedure TMainForm.btnRectangleBorderFillColorClick(Sender: TObject);
// Rectangle(x, y, x2, y2: integer; BorderColor, FillColor: TBGRAPixel;
// mode: TDrawMode); override;
begin
bmpWork.Rectangle(100, 100, 180, 140, BGRA(255, 0, 0), BGRA(128, 128, 255),
dmSet);
bmpWork.Draw(PaintBox.Canvas, 0, 0);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
bmpWork := TBGRABitmap.Create(PaintBox.Width, PaintBox.Height, BGRABlack);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
bmpWork.Free;
end;

end.

L'exécution de cette application permet, en cliquant sur les boutons, de dessiner des... rectangles :mouarf: :

245749



Comme toujours, il est téléchargeable depuis 245745.