Discussion :

[yamino]

Bonjour,

Est-il possible de faire un dégradé de couleurs dans un TPanel ?

[Gilbert Geyer]

Salut,

On ne peut pas accéder au canvas d'un TPanel, mais on peut superposer au TPanel un TLabel de même taille et ensuite faire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
  label1.caption:='';
  with label1.canvas do 
  begin ...
          maCouleur:=RGB[R,G,B]; // où R,G,B sont à calculer avec ta fonction de dégradé
          Pixels[x,y]:=maCouleur;
  end;

A+

[guillemouze]

Salut,

On ne peut pas accéder au canvas d'un TPanel, mais on peut superposer au TPanel un TLabel de même taille et ensuite faire (...)

un TLabel ?!!!
j'aurai plutot pensé mettre une TImage ou une TPaintBox !

[yamino]

J'ai trouvé un composant TJvGradientHeaderPanel dans la suite JVCL qui m'a permis de faire un très beau dégradé...
Merci pour vos réponses

[Gilbert Geyer]

Bonjour,

J'ai trouvé un composant TJvGradientHeaderPanel dans la suite JVCL qui m'a permis de faire un très beau dégradé...

... tant mieux.

Voiçi quand même le code qui permet de faire un dégradé sur le canvas d'un objet-standard dont le canvas est accessible (TForm, TLabel, TImage, TBitMap ...) avec exemple d'un TLabel superposé à un TPanel pour habiller ce dernier : (code testé : marche) :

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
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
unit uGen;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioBtnVertical: TRadioButton;
    ColorDialog1: TColorDialog;
    GroupBox2: TGroupBox;
    plCoulDeb: TPanel;
    Label1: TLabel;
    plCoulFin: TPanel;
    Label2: TLabel;
    DegraderFiche: TButton;
    DegraderLabelSurPanel: TButton;
    Panel3: TPanel; 
    LabelSurPanel: TLabel; //< avec Align:=alClient et superposé à Panel3
    procedure DegraderFicheClick(Sender: TObject);
    procedure DegraderLabelSurPanelClick(Sender: TObject);
    procedure plCoulDebClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Procedure Degrader(CanvasCible : TCanvas; Dim : TRect; CoulDeb,CoulFin : Tcolor; Vertical : boolean);
//@param CanvasCible = Canvas cible
//@param Dim = Rectangle-Dimensions du canvas-cible
//@param CoulDeb,CoulFin = couleurs de début et de fin
//@param Vertical : True pour dégradé vertical sinon dégradé horizontal.
type      TRGB = record R,G,B : integer; end;
var       Frange : TRect;   // Frange rectangulaire pour tracé couleur courante variable
          i     : Integer; // Compteur pour parcourir la hauteur du canvas
          cDeb  : TRGB;    // valeurs RGB de la couleur de Deb
          cDeg  : TRGB;    // valeurs RGB de la couleur courante
          eD_F  : TRGB;    // écarts de RGB entre couleurs de Deb et de Fin

begin    // valeurs RGB de la couleur de Deb
         cDeb.R := GetRValue(ColorToRGB(CoulDeb));
         cDeb.G := GetGValue(ColorToRGB(CoulDeb));
         cDeb.B := GetBValue(ColorToRGB(CoulDeb));
         // écarts RGB entre couleurs de Deb et de Fin
         eD_F.R := GetRValue(ColorToRGB(CoulFin )) - cDeb.R;
         eD_F.G := GetgValue(ColorToRGB(CoulFin )) - cDeb.G;
         eD_F.B := GetbValue(ColorToRGB(CoulFin )) - cDeb.B;
         // Initialisation des dimensions de la Frange de couleur
         Frange.Left := Dim.Left;
         Frange.Right:= Dim.Right - Dim.Left;
         // Boucle de remplissage en dégradé du canvas
         with CanvasCible do
         begin for i:= 0 to 255 do
               begin // Dimensions de la Frange
                     if Vertical = true then
                     begin Frange.Left := Dim.Left;
                           Frange.Right:= Dim.Right - Dim.Left;
                           Frange.Top  := MulDiv(i, Dim.Bottom - Dim.top, 256);
                           Frange.Bottom := MulDiv(i+1, Dim.Bottom - Dim.top, 256);
                     end else
                     begin Frange.Top:=Dim.top;
                           Frange.Bottom:= Dim.Bottom - Dim.top;
                           Frange.left  := MulDiv(i, Dim.Right - Dim.Left, 256);
                           Frange.right := MulDiv(i+1 , Dim.Right - Dim.Left, 256);
                     end;
                     // couleur courante dégradée
                     cDeg.R := (cDeb.R + MulDiv(i, eD_F.R, 255)) mod 256;
                     cDeg.G := (cDeb.G + MulDiv(i, eD_F.G, 255)) mod 256;
                     cDeg.B := (cDeb.B + MulDiv(i, eD_F.B, 255)) mod 256;
                     // Tracé sur canvas
                     Brush.color:=RGB(cDeg.R, cDeg.G, cDeg.B);
                     FillRect(Frange);
               end;
         end;
end;

//--------------------------------------------------------------------------------


procedure TForm1.DegraderFicheClick(Sender: TObject);
begin     Degrader(Form1.canvas, Rect(0,0,width,height), plCoulDeb.Color, plCoulFin.Color, RadioBtnVertical.Checked);
end;

procedure TForm1.plCoulDebClick(Sender: TObject);
//            Choix des couleurs de début et de fin du dégradé 
begin     ColorDialog1.Color:=(sender as Tpanel).Color;
          if ColorDialog1.Execute
          then (sender as Tpanel).Color:=ColorDialog1.Color;
end;

procedure TForm1.FormShow(Sender: TObject);
begin     DegraderFiche.Click;
end;

procedure TForm1.FormResize(Sender: TObject);
begin     DegraderFiche.Click;
end;

procedure TForm1.DegraderLabelSurPanelClick(Sender: TObject);
var       R : TRect;
begin     with LabelSurPanel do
          begin R:=Rect(0,0,width,height);
                Degrader(canvas, R, plCoulDeb.Color, plCoulFin.Color, RadioBtnVertical.Checked);
          end;
end;

end.

A+

[Jipété]

Bonjour,

Voici quand même le code qui permet de faire un dégradé sur le canvas d'un objet-standard dont le canvas est accessible (TForm, TLabel, TImage, TBitMap ...) avec exemple d'un TLabel superposé à un TPanel pour habiller ce dernier : (code testé : marche) :

8 ans plus tard , je reviens sur le code proposé par Gilbert car, pour des besoins propres il me fallait un afficheur (le label) plus petit que son conteneur (le panel), et je me suis rendu compte qu'il y avait des petits soucis, masqués quand Top = 0 et Bottom = Height...

De modifications en simplifications, je suis arrivé au code ci-dessous, qui remplace le code existant dans la procédure "Degrader" à partir de la ligne " // Initialisation des dimensions de la Frange de couleur" jusqu'à la fin de la proc (que j'ai renommée "MakeGradient") :

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
         // Initialisation des dimensions de la Frange de couleur
         with Frange do // Dimensions de la Frange
         if Vertical then
         begin // le Top est calculé + bas
           Left  := Dim.Left;
           Right := Dim.Right;
           Bottom:= Dim.Bottom;
         end else
         begin // le Left est calculé + bas
           Top   := Dim.top;
           Bottom:= Dim.Bottom;
           Right := Dim.Right;
         end;
 
         // Boucle de remplissage en dégradé du canvas
         for i:= 0 to 255 do
         begin
           with Frange do // Top ou Left de la Frange
           if Vertical then
             Top  := MulDiv(i, Dim.Bottom - Dim.top, 256) + Dim.Top
           else
             Left := MulDiv(i, Dim.Right - Dim.Left, 256) + Dim.Left;
 
             // couleur courante dégradée
             cDeg.R := (cDeb.R + MulDiv(i, eD_F.R, 255)) mod 256;
             cDeg.G := (cDeb.G + MulDiv(i, eD_F.G, 255)) mod 256;
             cDeg.B := (cDeb.B + MulDiv(i, eD_F.B, 255)) mod 256;
 
             // Tracé sur canvas
             with CanvasCible do begin
               Brush.color:=RGB(cDeg.R, cDeg.G, cDeg.B);
               FillRect(Frange);
           end;
         end;

J'ai fait un test rapide comme ceci, avec un label sur un panel et un Checkbox qui porte le nom RadioBtnVertical, si si ! :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm1.RadioBtnVerticalClick(Sender: TObject);
var
  R: TRect;
begin
  with LabelSurPanel do
  begin
//    R:=Rect(0,0,width,height);
    // TODO : s'assurer que Left < Right et Top < Bottom
    // sinon l'affichage ne sera pas bon...
    R:=Rect(20, 15, width div 3, height div 2);
    MakeGradient(canvas, R, clBlack, clWhite, RadioBtnVertical.Checked);
  end;
end;

Ça permet d'obtenir ce genre de résultats :

Pour les 4 images à gauche, il s'agit de TImage (noms : image1 à 4, width et height à 128) utilisés comme ça :

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
procedure TForm1.FormActivate(Sender: TObject);
var
  i: integer;
  R: TRect;
begin
  R := image1.ClientRect;
//  R.Top := R.Bottom div 2;
  R.Left:= R.Right  div 2;
  R.Top := R.Bottom div 3;
//  R.Left:= R.Right  div 3;
  for i := 1 to 4 do
  case i of
    1: MakeGradient(image1.Canvas, R, clBlack, clWhite, False); // H
    2: MakeGradient(image2.Canvas, R, clGreen, clBlue,  False); // H
    3: MakeGradient(image3.Canvas, R, clWhite, clBlack, True);  // V
    4: MakeGradient(image4.Canvas, R, clAqua,  clOlive, True);  // V
  end;
end;

Merci pour avoir publié il y a 8 ans cette chose qui m'a aujourd'hui mis le pied à l'étrier,