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,

[foetus]

Un dégradé c'est juste une interpolation linéaire sur les 3 composantes R, G, B

[Gilbert Geyer]

Bonjour,

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

De rien ... Pour ma part j'aime bien les solutions simples obtenues avec les routines standard de Delphi plutôt que d'utiliser des bibliothèques de N routines dont on n'utilise qu'une seule.

A+.

[Andnotor]

Je rappelle tout de même à votre bon souvenir l'API GradientFill qui existe depuis... Windows 2000

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
procedure DrawGradient(aHandle :THandle; aRect :TRect; aStartColor, aEndColor :TColor; aVertical :boolean);
const
  Orientation :array[boolean] of ShortInt = (GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V);
var
  Vertex :array[0..1] of TTriVertex;
  Mesh   :TGradientRect;
 
begin
  Vertex[0].X     := aRect.Left;
  Vertex[0].Y     := aRect.Top;
  Vertex[0].Red   := GetRValue(aStartColor) *$100;
  Vertex[0].Green := GetGValue(aStartColor) *$100;
  Vertex[0].Blue  := GetBValue(aStartColor) *$100;
 
  Vertex[1].X     := aRect.Right;
  Vertex[1].Y     := aRect.Bottom;
  Vertex[1].Red   := GetRValue(aEndColor) *$100;
  Vertex[1].Green := GetGValue(aEndColor) *$100;
  Vertex[1].Blue  := GetBValue(aEndColor) *$100;
 
  Mesh.UpperLeft  := 0;
  Mesh.LowerRight := 1;
 
  GradientFill(aHandle, @Vertex, 2, @Mesh, 1, Orientation[aVertical]);
end;

[ShaiLeTroll]

AndNotOr

Que c'est long à écrire en Delphi
En C++, comme dans cette réponse c'est plus "ramassé" quoi que finalement assez illisible

Code c++ :

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

1
2
3
4
 
      GRADIENT_RECT Mesh = { 0, 1 };
      TRIVERTEX Vertext[ 2 ] = {aRect.left, aRect.Top, GetRValue(aStartColor) << 8,GetGValue(aStartColor) << 8, GetBValue(aStartColor) << 8, 0x0000, aRect.right, aRect.bottom, GetRValue(aEndColor) << 8,GetGValue(aEndColor) << 8, GetBValue(aEndColor) << 8, 0x0000};
      GradientFill(aHandle, Vertext, 2, &Mesh, 1, Orientation[aVertical]);

[anapurna]

salut


pourquoi ce compliquer la vie ^^

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
 TPanel = class(ExtCtrls.TPanel)
  protected
    FColorStart : TColor;
    FColorEnd   : TColor;
    procedure Paint; override;   // surcharge de la methode de dessin de TPanel
  public
    property Canvas;             // TPanel contient un canvas qu'il faut publié!
    property ColorEnd : Tcolor read FColorEnd write FColorEnd;
    property ColorStart : Tcolor read FColorStart write FColorStart;
  end;

...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
  procedure TPanel.Paint;
  begin
    // Methode de dessin originale de TPanel
    inherited Paint;
    GradientFillCanvas(canvas,FColorStart,FColorEnd,ClientRect,gdVertical);
  end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.ColorEnd   := Clred;
  Panel1.ColorStart := clBlue;
end;

[Jipété]

Je rappelle tout de même à votre bon souvenir l'API GradientFill qui existe depuis... Windows 2000

Et le plus rigolo c'est que la procédure que tu viens de poster s'exécute également sous... Linux , grâce à l'ami Lazarus, et sans aucune adaptation ! Y a des fois faut jongler, triturer des trucs, adapter des machins, et là, rien : un composant TPaintBox, et dans son événement OnPaint l'appel à ta proc et roule ma poule :

Code :

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

1
2
3
4
procedure TMainForm.pboxTriVertexPaint(Sender: TObject);
begin
  DrawGradient(pboxTriVertex.Canvas.Handle, pboxTriVertex.ClientRect, clRed, clBlue, False);
end;

pourquoi se compliquer la vie ^^

Code :

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

    GradientFillCanvas(canvas,FColorStart,FColorEnd,ClientRect,gdVertical);

Hey, parce que Lazarus ne connait pas ce GradientFillCanvas.
Bon, tout ça serait adaptable, comme je le disais plus haut, mais je fatigue, à force d'adapter des trucs

[Andnotor]

@anapurna: Bien vu, je connaissais pas

Alors disons qu'en appelant directement GradientFill, on n'est plus limité à deux couleurs

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
procedure DrawMultiGradient(aHandle :THandle; aRect :TRect; aColors :array of TColor);
var
  Vertex :array of TTriVertex;
  Mesh   :array of TGradientRect;
  X      :array[boolean] of integer;
  Step   :double;
  i      :Integer;
 
begin
  if Length(aColors) < 2 then Exit;
 
  X[FALSE] := aRect.Left;
  X[TRUE]  := aRect.Right;
  Step     := aRect.Height /High(aColors);
 
  SetLength(Vertex, Length(aColors));
  SetLength(Mesh, High(aColors));
 
  for i := 0 to High(aColors) do
  begin
    Vertex[i].X     := X[Odd(i)];
    Vertex[i].Y     := Round(aRect.Top +Step *i);
    Vertex[i].Red   := GetRValue(aColors[i]) *$100;
    Vertex[i].Green := GetGValue(aColors[i]) *$100;
    Vertex[i].Blue  := GetBValue(aColors[i]) *$100;
  end;
 
  for i := 0 to High(aColors) -1 do
  begin
    Mesh[i].UpperLeft  := i;
    Mesh[i].LowerRight := i+1;
  end;
 
  GradientFill(aHandle, pointer(Vertex), Length(Vertex), Mesh, Length(Mesh), GRADIENT_FILL_RECT_V);
end;

[Jipété]

Alors disons qu'en appelant directement GradientFill, on n'est plus limité à deux couleurs

Faudrait que tu mettes une copie d'écran de ce que ça peut afficher car, là, j'atteins les limites de la compatibilité Delphi/Lazarus : tout ce que j'ai c'est une image noire...

En plus, il a fallu commencer les bidouillages, genre

Code :

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

1
2
//  Step     := aRect.Height /High(aColors); // le TRect de Lazarus n'a ni Height ni Width, faut faire les calculs
  Step     := (aRect.Bottom-aRect.Top) / High(aColors);

et

Code :

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

1
2
//  GradientFill(aHandle, pointer(Vertex), Length(Vertex), Mesh, Length(Mesh), GRADIENT_FILL_RECT_V);
  GradientFill(aHandle, @Vertex, Length(Vertex), @Mesh, Length(Mesh), GRADIENT_FILL_RECT_V);

J'ai tenté deux manières pour appeler la proc :
d'abord

Code :

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

1
2
3
4
procedure TMainForm.pboxTriVertexPaint(Sender: TObject);
begin
  DrawMultiGradient(pboxTriVertex.Canvas.Handle, pboxTriVertex.ClientRect, [clRed, clBlue, clYellow]);
end;

et ensuite

Code :

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

1
2
3
4
5
6
7
8
9
procedure TMainForm.pboxTriVertexPaint(Sender: TObject);
var
  PassingColors: array [0..2] of TColor;
begin
  PassingColors[0] := clRed;
  PassingColors[1] := clBlue;
  PassingColors[2] := clYellow;
  DrawMultiGradient(pboxTriVertex.Canvas.Handle, pboxTriVertex.ClientRect, PassingColors);
end;

mais dans les deux cas la paintbox est noire...

J'ai basiquement vérifié ce que je passais avec edit1.Text := inttostr(High(acolors));// High=2, Length=3 au début de la proc, et comme le montrent les commentaires, ça a l'air correct.
Après, sans savoir ce que je dois (a)voir, ça me dépasse...

[Andnotor]

Par exemple :



Cette ligne est fausse GradientFill(aHandle, @Vertex, Length(Vertex), @Mesh, Length(Mesh), GRADIENT_FILL_RECT_V);. Le tableau de vertex est maintenant dynamique, la variable Vertex est donc maintenant un pointeur sur le tableau et non plus le tableau.
GradientFill attend un PTriVertex non compatible avec un type tableau dynamique. J'aurais pu transtyper par PTriVertex(Vertex), j'ai simplifié par un pointeur non typé, pointer(Vertex), compatible avec tout type de pointeur.

De même pour Mesh à la différence que GradientFill attend un pointeur mais sans notion de type, tous les types de pointeurs sont donc acceptés, pas de problème ici pour passer un pointeur de tableau

Cette ligne est correct : GradientFill(aHandle, pointer(Vertex), Length(Vertex), Mesh, Length(Mesh), GRADIENT_FILL_RECT_V);

Cela dit, GradientFill est une API Windows. A voir donc comment Lazarus adapte cela (avec quelle limitation) pour une utilisation sous Linux.

[Jipété]

Salut salut,

Grand merci pour ton retour, tes exemples colorés et tes explications :

Cette ligne est fausse GradientFill(aHandle, @Vertex, Length(Vertex), @Mesh, Length(Mesh), GRADIENT_FILL_RECT_V);

C'est comme ça que j'avais pu compiler en m'inspirant de ta première proposition, car Lazarus est chatouilleux au niveau des pointeurs, des adresses, toussa toussa...

Cette ligne est correcte : GradientFill(aHandle, pointer(Vertex), Length(Vertex), Mesh, Length(Mesh), GRADIENT_FILL_RECT_V);

Image noire, mais j'y suis arrivé comme ça : GradientFill(aHandle, pointer(Vertex), Length(Vertex), pointer(Mesh), Length(Mesh), GRADIENT_FILL_RECT_V); et là, j'ai eu un magnifique dégradé :

[Jipété]

Yop !

Alors disons qu'en appelant directement GradientFill, on n'est plus limité à deux couleurs

Mais on a un microscopique souci avec le multivertex en mode horizontal (oui, j'ai implémenté le choix du balayage en m'inspirant du premier code code que tu as posté)...

À gauche du trait marron, un dégradé vertical jaune à bleu et en passant par le blanc en mode multi, ça roule ; à droite la même chose en mode horizontal


Une idée ?

[Andnotor]

Il faut bien entendu inverser la calculation de X/Y.

En vertical (mon exemple), X passe de gauche à droite et inversement indéfiniment. Y est incrémenté.
En horizontal, et bien c'est Y qui doit commuter entre haut et bas et X qui doit être incrémenté.

Ici, tu appliques le calcul vertical à l'horizontal. Tu as donc deux dégradés pleine largeur (Left <-> Right) sur une demi hauteur (Step = Height /(3 couleurs -1)).

Avec deux couleurs, la question ne se pose pas, il n'y a qu'un seul rectangle

[Jipété]

Il faut bien entendu inverser la calculation de X/Y.

Quelque chose comme ça, quoi :

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
procedure DrawMultiGradient(aHandle :THandle; aRect :TRect; aColors :array of TColor; aVertical :boolean);
const // New Jipété
  Orientation :array[boolean] of ShortInt = (GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V);
var
  Vertex :array of TTriVertex;
  Mesh   :array of TGradientRect;
  X      :array[boolean] of integer;
  Step   :double;
  i      :Integer;
begin
  if Length(aColors) < 2 then Exit;
  if aVertical then
  begin
    X[FALSE] := aRect.Left;
    X[TRUE]  := aRect.Right;
    //Step     := aRect.Height /High(aColors); // Delphi
    Step     := (aRect.Bottom-aRect.Top) / High(aColors); // Lazarus
  end else
  begin
    X[FALSE] := aRect.Top;
    X[TRUE]  := aRect.Bottom;
    Step     := (aRect.Right-aRect.Left) / High(aColors);
  end;
 
  SetLength(Vertex, Length(aColors));
  SetLength(Mesh, High(aColors));
 
  for i := 0 to High(aColors) do
  begin
    if aVertical then
    begin
      Vertex[i].X     := X[Odd(i)];
      Vertex[i].Y     := Round(aRect.Top + Step *i);
    end else
    begin
      Vertex[i].X     := Round(aRect.Left + Step *i);
      Vertex[i].Y     := X[Odd(i)];
    end;
    Vertex[i].Red   := GetRValue(aColors[i]) *$100;
    Vertex[i].Green := GetGValue(aColors[i]) *$100;
    Vertex[i].Blue  := GetBValue(aColors[i]) *$100;
  end;
 
  for i := 0 to High(aColors) -1 do
  begin
    Mesh[i].UpperLeft  := i;
    Mesh[i].LowerRight := i+1;
  end;
//  original 4 Delphi:
//  GradientFill(aHandle, pointer(Vertex), Length(Vertex), Mesh, Length(Mesh), GRADIENT_FILL_RECT_V);
// modif 4 Lazarus ok :
//  GradientFill(aHandle, pointer(Vertex), Length(Vertex), pointer(Mesh), Length(Mesh), GRADIENT_FILL_RECT_V);
// modif ajout choix orientation
  GradientFill(aHandle, pointer(Vertex), Length(Vertex), pointer(Mesh), Length(Mesh), Orientation[aVertical]);
end;

Résultat au top !


Merci pour tout