Voir le flux RSS

Blog de Gilles Vasseur - Pascal et compagnie

[Actualité] Dessiner des rectangles - BGRABitmap avec Lazarus (1/2)

Noter ce billet
par , 17/02/2017 à 16h01 (892 Affichages)
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 :

Nom : 2017-02-17_144619.png
Affichages : 1150
Taille : 26,0 Ko

La fiche lfm correspondante est celle-ci :

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

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
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 :

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
 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 :

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
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 :

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
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 :

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

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
{** 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 :

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
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 :

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
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 :

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
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 :

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
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 :

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
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 :

Code Pascal : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
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 :

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

Nom : 2017-02-17_154824.png
Affichages : 974
Taille : 14,5 Ko


Comme toujours, il est téléchargeable depuis rectangles.7z.

Envoyer le billet « Dessiner des rectangles - BGRABitmap avec Lazarus (1/2) » dans le blog Viadeo Envoyer le billet « Dessiner des rectangles - BGRABitmap avec Lazarus (1/2) » dans le blog Twitter Envoyer le billet « Dessiner des rectangles - BGRABitmap avec Lazarus (1/2) » dans le blog Google Envoyer le billet « Dessiner des rectangles - BGRABitmap avec Lazarus (1/2) » dans le blog Facebook Envoyer le billet « Dessiner des rectangles - BGRABitmap avec Lazarus (1/2) » dans le blog Digg Envoyer le billet « Dessiner des rectangles - BGRABitmap avec Lazarus (1/2) » dans le blog Delicious Envoyer le billet « Dessiner des rectangles - BGRABitmap avec Lazarus (1/2) » dans le blog MySpace Envoyer le billet « Dessiner des rectangles - BGRABitmap avec Lazarus (1/2) » dans le blog Yahoo

Mis à jour 02/06/2017 à 09h16 par gvasseur58

Catégories
Programmation , Free Pascal , Lazarus , Graphisme

Commentaires

  1. Avatar de naute
    • |
    • permalink
    Bonjour Gilles .

    D'abord tous mes remerciements pour l'aide que tu apportes à chacun, que ce soit au niveau technique ou au niveau traduction. Je sais que c'est banal et que cela va sans dire, mais comme l'a très bien dit quelqu'un sur ce forum, cela va bien aussi en le disant .

    Désireux d'essayer la librairie BGRABitmap pour palier certaines carences de Lazarus au niveau graphique, du moins sous GTK2, je me suis précipité sur ton "mini tutoriel", comme tu le nommes.

    J'en ai fait une copie conforme, du moins je le pense, mais quelque chose ne fonctionne pas. La compilation se passe parfaitement, sans aucun warning, mais seule une fenêtre vide s'affiche à l'écran, et ce qui est étonnant, elle ne répercute même pas ses paramètres de taille et de position.

    Est-ce que le problème est évident et sa solution triviale ou préfères-tu que j'ouvre un fil sur ce sujet?

    Amicalement,
    Hervé.
  2. Avatar de gvasseur58
    • |
    • permalink
    Bonjour Hervé,

    Merci pour des encouragements qui sont toujours les bienvenus !

    Pour ce qui est de ton problème, peux-tu me faire parvenir par MP ou dans le fil de cette discussion le code exact que tu as utilisé ? Il m'est difficile de répondre sans support concret.

    A très bientôt,

    Gilles
  3. Avatar de naute
    • |
    • permalink
    Bonjour Gilles .

    Voilà les informations. Comme je te l'ai précisé précédemment, c'est du copié/collé. Je n'ai normalement pas changé une virgule,

    test.lpr
    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
     
    program test;
     
    {$mode objfpc}{$H+}
     
    uses
     {$IFDEF UNIX}{$IFDEF UseCThreads}
     cthreads,
     {$ENDIF}{$ENDIF}
     Interfaces, // this includes the LCL widgetset
     Forms, main
     { you can add units after this };
     
    {$R *.res}
     
    begin
     RequireDerivedFormResource:=True;
     Application.Initialize;
     Application.CreateForm(TForm, MainForm);
     Application.Run;
    end.
    main.pas
    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
     
    { |========================================================================|
      |                                                                        |
      |                  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.

    main.lfm
    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
     
    object MainForm: TMainForm
      Left = 351
      Height = 525
      Top = 226
      Width = 905
      Caption = 'Test de rectangle - BGRABITMAP'
      ClientHeight = 525
      ClientWidth = 905
      Position = poScreenCenter
      LCLVersion = '1.8.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 = 213
        ClientWidth = 174
        TabOrder = 0
        object btnRectdmSet: TButton
          Left = 16
          Height = 25
          Top = 16
          Width = 136
          Caption = 'Rectangle (dmSet)'
          TabOrder = 0
        end
        object btnRectangleBGRAPixel: TButton
          Left = 16
          Height = 25
          Top = 48
          Width = 136
          Caption = 'Rectangle (BGRAPixel)'
          TabOrder = 1
        end
        object btnRectangleBorderFillColor: TButton
          Left = 16
          Height = 25
          Top = 80
          Width = 136
          Caption = 'Rectangle (Border/Fill)'
          TabOrder = 2
        end
        object btnFillRect: TButton
          Left = 16
          Height = 25
          Top = 112
          Width = 136
          Caption = 'FillRect (color)'
          TabOrder = 3
        end
        object btnRoundRect: TButton
          Left = 16
          Height = 25
          Top = 144
          Width = 136
          Caption = 'RoundRect (BGRAPixel)'
          TabOrder = 4
        end
        object btnRoundRectBorderFillColor: TButton
          Left = 16
          Height = 25
          Top = 176
          Width = 136
          Caption = 'RoundRect (Border/Fill)'
          TabOrder = 5
        end
      end
      object btnClear: TButton
        Left = 24
        Height = 25
        Top = 480
        Width = 75
        Caption = 'Nettoyer'
        TabOrder = 1
      end
    end
    test.lps
    Code xml : 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
     
    <?xml version="1.0" encoding="UTF-8"?>
    <CONFIG>
      <ProjectSession>
        <Version Value="10"/>
        <BuildModes Active="Default"/>
        <Units Count="3">
          <Unit0>
            <Filename Value="test.lpr"/>
            <IsPartOfProject Value="True"/>
            <EditorIndex Value="2"/>
            <CursorPos X="40" Y="18"/>
            <UsageCount Value="20"/>
            <Loaded Value="True"/>
          </Unit0>
          <Unit1>
            <Filename Value="main.pas"/>
            <IsPartOfProject Value="True"/>
            <ComponentName Value="MainForm"/>
            <ResourceBaseClass Value="Form"/>
            <CursorPos X="40" Y="22"/>
            <UsageCount Value="20"/>
            <Loaded Value="True"/>
            <LoadedDesigner Value="True"/>
          </Unit1>
          <Unit2>
            <Filename Value="../../../Applications/lazarus/packages/bgrabitmap-master/bgrabitmap/bgrabitmap.pas"/>
            <UnitName Value="BGRABitmap"/>
            <IsVisibleTab Value="True"/>
            <EditorIndex Value="1"/>
            <UsageCount Value="10"/>
            <Loaded Value="True"/>
          </Unit2>
        </Units>
        <JumpHistory Count="7" HistoryIndex="6">
          <Position1>
            <Filename Value="main.pas"/>
            <Caret Line="25" Column="7"/>
          </Position1>
          <Position2>
            <Filename Value="main.pas"/>
            <Caret Line="13" Column="62"/>
          </Position2>
          <Position3>
            <Filename Value="main.pas"/>
            <Caret Line="22" Column="13" TopLine="4"/>
          </Position3>
          <Position4>
            <Filename Value="main.pas"/>
            <Caret Line="25" Column="41" TopLine="16"/>
          </Position4>
          <Position5>
            <Filename Value="main.pas"/>
            <Caret Line="34" Column="100" TopLine="73"/>
          </Position5>
          <Position6>
            <Filename Value="main.pas"/>
            <Caret Line="35" Column="100" TopLine="23"/>
          </Position6>
          <Position7>
            <Filename Value="main.pas"/>
            <Caret Line="22" Column="40"/>
          </Position7>
        </JumpHistory>
      </ProjectSession>
    </CONFIG>

    Amicalement,
    Hervé.
  4. Avatar de gvasseur58
    • |
    • permalink
    Bonjour Hervé,

    A première vue, c'est ton fichier LFM qui indique ce qui ne va pas : aucun composant n'est associé aux gestionnaires d'événements . Ainsi, la fenêtre principale devrait être associée aux gestionnaires OnCreate et OnDestroy, mais ce n'est pas le cas.

    En fait, si c'est le problème, le code de l'unité ne suffit pas : il faut absolument que le fichier LFM reflète les liaisons entre composants et gestionnaires.
    Deux solutions :
    1. cliquer sur les bons gestionnaires dans l'inspecteur d'objets pour chaque objet concerné.
    2. reprendre le fichier LFM selon le modèle suivant...

    Code : 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
    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
    J'espère que tout ira bien après ça !

    Gilles
  5. Avatar de naute
    • |
    • permalink


    Effectivement, aucun des gestionnaires d’événement n'était affecté. J'ai donc remédié à cela mais sans grand résultat malheureusement.

    Voici mon nouveau fichier lfm :

    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
     
    object MainForm: TMainForm
      Left = 351
      Height = 525
      Top = 226
      Width = 905
      Caption = 'Test de rectangle - BGRABITMAP'
      ClientHeight = 525
      ClientWidth = 905
      OnCreate = FormCreate
      OnDestroy = FormDestroy
      Position = poScreenCenter
      LCLVersion = '1.8.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 = 213
        ClientWidth = 174
        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

    Plutôt que de te faire perdre ton temps, je vais tout recommencer à zéro, à la main, sans faire de copie pour essayer de gagner du temps. Je te tiens au courant quelque soit le résultat.

    Amicalement,
    Hervé.
  6. Avatar de naute
    • |
    • permalink
    Bonjour Gilles .

    Après avoir tout saisi à la main ça fonctionne parfaitement. Comme je ne comprenais pas ce qui s'était passé, j'ai comparé les fichiers des deux versions. L'erreur est dans le fichier test.lpr. La ligne Application.CreateForm(TForm, MainForm); n'est pas correcte, mais, curieusement, elle ne déclenche aucune exception. .

    Fichier fonctionnel :
    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
     
    program test;
     
    {$mode objfpc}{$H+}
     
    uses
     {$IFDEF UNIX}{$IFDEF UseCThreads}
     cthreads,
     {$ENDIF}{$ENDIF}
     Interfaces, // this includes the LCL widgetset
     Forms, main
     { you can add units after this };
     
    {$R *.res}
     
    begin
     RequireDerivedFormResource:=True;
     Application.Initialize;
     Application.CreateForm(TMainForm, MainForm);
     Application.Run;
    end.
    Fichier erroné :
    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
     
    program test;
     
    {$mode objfpc}{$H+}
     
    uses
     {$IFDEF UNIX}{$IFDEF UseCThreads}
     cthreads,
     {$ENDIF}{$ENDIF}
     Interfaces, // this includes the LCL widgetset
     Forms, main
     { you can add units after this };
     
    {$R *.res}
     
    begin
     RequireDerivedFormResource:=True;
     Application.Initialize;
     Application.CreateForm(TForm, MainForm);
     Application.Run;
    end.
    Comme j'avais fait un copié/collé, la synchronisation n'a pas été automatique et quand j'ai modifié à la main, j'ai zappé ce détail . Désolé de t'avoir fait perdre ton temps pour une bête erreur de ma part.
    Je vais pouvoir commencer la deuxième partie de tes tutos .

    Merci encore,
    amicalement,
    Hervé.