Discussion :

[Jipété]

Bonsoir,

titre pompeux pour un petit programme d'étude, qui m'a bien servi il y a quelques années et comme je suis en train d'essayer de passer la machine achetée il y a un an en prod', c'est tombé sur ce prog', et donc je vous raconte :


J'étudie la mise en œuvre des codes jouant avec les dégradés et tout fonctionne bien : je peux choisir la couleur de départ et la couleur d'arrivée en cliquant sur les TShapes qui font afficher un TColorDialog, et le bouton "normal" s'appuie sur DrawMultiGradient (on en parle juste après) quand le bouton "parabolic" utilise DrawParabolicGradient (inspiré de GraphUtil.DrawVerticalGradient).

Les gags arrivent à l'exécution du prog' compilé avec Laz 2.0.12 / 64 bits dans la machine neuve : en utilisant le bouton "normal" (le "parabolic" est toujours bon), ça génère une image noire ou, en bidouillant (lire dessous), je peux faire afficher quelque chose mais le sens du dégradé est faux, il se déroule de haut en bas quand la case à cocher est cochée.

Ce que je peux dire de cette proc' DrawMultiGradient, c'est qu'elle vient de chez les voisins et que les posts suivants ont permis de l'affiner, maintenant, que se passe-t-il de travers en 64 bits ? Ça me dépasse, d'autant plus que si je remplace DrawMultiGradient par GradientFill (qui se trouve à la fin de DrawMultiGradient) en adaptant les paramètres, ça fonctionne !

Mais je ne veux pas l'utiliser, ça me semble trop compliqué pour faire un dégradé de plus de deux couleurs.

Et "parabolic", toujours bon, de base n'utilise pas DrawMultiGradient.

Vous savez tout. Des questions ? Lâchez-vous…

[BeanzMaster]

Salut peux tu nous mettre le code de ton projet test. Car la mis a part ton problème d'orientation, je ne comprend pas trop le problème.

A+

Jérôme

[Jipété]

Salut Jérome,

le code demandé tu l'auras en bas, d'abord un peu de lecture :

Bonjour,

Ce matin à la fraîche j'ai eu une idée lumineuse : un prog' minimaliste avec juste 1 TImage pour l'affichage, 2 TShapes pour les couleurs de départ et d'arrivée, 3 TButtons et 1 TCheckBox pour les actions, et le code réduit à sa plus simple expression et croyez-le ou pas mais dans cette configuration, le code en 64 bits s'exécute aussi bien qu'en 32.

Le challenge maintenant va être de trouver ce qui met la pagaille dans le "gros" programme qui s'appuie sur un TPageControl à 2 onglets, l'un des deux étant dédié quasi exclusivement à ce test qui s'exécute bien en mode minimaliste et qui foire dans le contexte de la prod' alors qu'il n'y a normalement aucune interaction entre les deux onglets…

Une piste : si je "rapatrie" par un bête copier/coller dans l'unité principale une copie de ma procédure DrawMultiGradient (qui réside avec tout un tas d'autres fonctions et procédures dans une unité unit4colors.pas stockée ailleurs), l'affichage revient. Faux car la case à cocher "ckbxVerti" fonctionne à l'envers (quand elle est cochée le dégradé est… horizontal, hé ouais !), mais au moins j'ai un dégradé.

Tests, tests, tests,
gros vieux prog :

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
procedure TMainForm.Button1Click(Sender: TObject);
begin
  with imgGradient do begin
    Picture.Clear;
    DrawMultiGradient(Canvas.Handle, ClientRect, // image noire
      [Shape1.Brush.Color, Shape2.Brush.Color], ckbxVertic.Checked);
//    Canvas.GradientFill(classes.Rect(0,0,Width,Height), // image présente
//      Shape1.Brush.Color, Shape2.Brush.Color, TGradientDirection(ckbxVertic.Checked));
    Update;
  end;
 
  if ckbxVertic.Checked then begin
    Shape2.Left:=Shape1.Left + Shape1.Width + 30; 
    Shape2.Top :=Shape1.Top;
  end else begin
    Shape2.Left:=Shape1.Left; 
    Shape2.Top :=Shape1.Top + Shape1.Height+5;
  end;
end;

petit prog de ce matin :

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
procedure TMainForm.Button3Click(Sender: TObject);
begin
  with imgGradient do begin
    Picture.Clear;
    DrawMultiGradient(Canvas.Handle, ClientRect,
      [Shape1.Brush.Color, Shape2.Brush.Color], ckbxVertic.Checked);
    Update;
  end;
 
  if ckbxVertic.Checked then begin
    Shape2.Left:=Shape1.Left;
    Shape2.Top :=Shape1.Top + Shape1.Height+5;
  end else begin
    Shape2.Left:=Shape1.Left + Shape1.Width + 30;
    Shape2.Top :=Shape1.Top;
  end;
end;

j'en suis là :
D'abord on remarque que pour faire déplacer les TShapes les codes sont différents, résultat les affichages sont corrects et cohérents , ensuite

Code :

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

1
2
3
4
5
6
  with imgGradient do begin
    Picture.Clear;
    DrawMultiGradient(Canvas.Handle, ClientRect,                // kc, image noire
// je copie/colle son code depuis son unité vers ici, je renomme, et j'ai un dégradé (mais le sens est faux)
//    fromcolorunitDrawMultiGradient(Canvas.Handle, ClientRect, // ok
     [Shape1.Brush.Color, Shape2.Brush.Color], ckbxVertic.Checked);

Mais le plus dément, c'est que si je prends le code de cette proc DrawMultiGradient et que je le colle dans une autre unité en lui changeant le nom plus les déclarations qui vont bien, ben… ça s'exécute correctement !

J'y perds mon latin, je vais faire un tour en vélo ça me changera les idées parce que là, je vais me griller une soupape dans la tête.


Tout cela ne m'inspire aucune confiance car je ne vois pas du tout où chercher le problème, puisqu'il n'y en a pas en 32 bits…

Le code complet du "petit prog" de ce matin pour obtenir ç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
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
unit unitmain;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, ExtCtrls, StdCtrls,
  LCLIntf, LCLType; // pour DrawMultiGradient
 
type
 
  { TMainForm }
 
  TMainForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ckbxVertic: TCheckBox;
    imgGradient: TImage;
    Shape1: TShape;
    Shape2: TShape;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  MainForm: TMainForm;
 
implementation
 
{$R *.lfm}
 
{ TMainForm }
 
// https://www.developpez.net/forums/d481267/environnements-developpement/delphi/composants-vcl/degrade-couleurs-tpanel/#post8629973
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; // x,y, r,g,b,a
  Mesh   :array of TGradientRect; // upperleft, lowerright
  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
      //Andnotor : "Il faut bien entendu inverser la calculation de X/Y"
      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 from Delphi:
//  GradientFill(aHandle, pointer(Vertex), Length(Vertex), Mesh, Length(Mesh), GRADIENT_FILL_RECT_V);
// modif pour Lazarus ok :
//  GradientFill(aHandle, pointer(Vertex), Length(Vertex), pointer(Mesh), Length(Mesh), GRADIENT_FILL_RECT_V);
// modif pour sens
  GradientFill(aHandle, pointer(Vertex), Length(Vertex), pointer(Mesh), Length(Mesh), Orientation[aVertical]);
end;
 
procedure TMainForm.Button1Click(Sender: TObject);
begin
  imgGradient.Picture.Clear;
  DrawMultiGradient(imgGradient.Canvas.Handle, imgGradient.ClientRect,
    [Shape1.Brush.Color, Shape2.Brush.Color], False);
  imgGradient.Update;
  Shape2.Left:=Shape1.Left + Shape1.Width + 30; Shape2.Top:=Shape1.Top;
end;
 
procedure TMainForm.Button2Click(Sender: TObject);
begin
  imgGradient.Picture.Clear;
  DrawMultiGradient(imgGradient.Canvas.Handle, imgGradient.ClientRect,
    [Shape1.Brush.Color, Shape2.Brush.Color], True);
  imgGradient.Update;
  Shape2.Left:=Shape1.Left; Shape2.Top:=Shape1.Top + Shape1.Height+5;
end;
 
procedure TMainForm.Button3Click(Sender: TObject);
begin
  imgGradient.Picture.Clear;
  DrawMultiGradient(imgGradient.Canvas.Handle, imgGradient.ClientRect,
    [Shape1.Brush.Color, Shape2.Brush.Color], ckbxVertic.Checked);
  imgGradient.Update;
 
  if ckbxVertic.Checked then begin
    Shape2.Left:=Shape1.Left; Shape2.Top:=Shape1.Top + Shape1.Height+5;
  end else begin
    Shape2.Left:=Shape1.Left + Shape1.Width + 30; Shape2.Top:=Shape1.Top;
  end;
end;
 
end.

[der§en]

Je voudrais bien t'aider mais, j'avoue humblement que je n'ai pas compris ton problème...

J'ai fait un copier collé de ton code, moyennant de petites corrections, j’obtiens le même résultat que toi sur mon Lazarus 2.0.12 en 64 bits.

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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
 
unit unitmain;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, LCLIntf, LCLType;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ckbxVertic: TCheckBox;
    imgGradient: TImage;
    Shape1: TShape;
    Shape2: TShape;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
 
  public
 
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
procedure DrawMultiGradient(aHandle: THandle; aRect: TRect; aColors: array of TColor; aVertical: boolean);
const
  Orientation: array[boolean] of ShortInt = (GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V);
var
  // x,y, r,g,b,a
  Vertex: array of TTriVertex;
  // upperleft, lowerright
  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;
    // Delphi
    Step   :=  aRect.Height / High(aColors);
    // Lazarus
    //Step     := (aRect.Bottom-aRect.Top) / High(aColors);
  end
  else
  begin
    X[FALSE] :=  aRect.Top;
    X[TRUE]  :=  aRect.Bottom;
    // Delphi
    Step     := aRect.Width / High(aColors);
    // Lazarus
    //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
      //Andnotor : "Il faut bien entendu inverser la calculation de X/Y"
      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 from Delphi:
  //  GradientFill(aHandle, pointer(Vertex), Length(Vertex), Mesh, Length(Mesh), GRADIENT_FILL_RECT_V);
 
  // modif pour Lazarus ok :
  //  GradientFill(aHandle, pointer(Vertex), Length(Vertex), pointer(Mesh), Length(Mesh), GRADIENT_FILL_RECT_V);
 
  // modif pour sens
  GradientFill(aHandle, pointer(Vertex), Length(Vertex), pointer(Mesh), Length(Mesh), Orientation[aVertical]);
end;
 
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  imgGradient.Picture.Clear;
 
  DrawMultiGradient(imgGradient.Canvas.Handle, imgGradient.ClientRect, [Shape1.Brush.Color, Shape2.Brush.Color], False);
 
  imgGradient.Update;
 
  Shape2.Left := Shape1.Left + Shape1.Width + 8;
  Shape2.Top  := Shape1.Top;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  imgGradient.Picture.Clear;
 
  DrawMultiGradient(imgGradient.Canvas.Handle, imgGradient.ClientRect, [Shape1.Brush.Color, Shape2.Brush.Color], True);
 
  imgGradient.Update;
 
  Shape2.Left := Shape1.Left;
  Shape2.Top  := Shape1.Top + Shape1.Height + 8;
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  imgGradient.Picture.Clear;
 
  DrawMultiGradient(imgGradient.Canvas.Handle, imgGradient.ClientRect, [Shape1.Brush.Color, Shape2.Brush.Color], ckbxVertic.Checked);  imgGradient.Update;
 
  if ckbxVertic.Checked then
  begin
    Shape2.Left := Shape1.Left;
    Shape2.Top  := Shape1.Top + Shape1.Height + 8;
  end
  else
  begin
    Shape2.Left := Shape1.Left + Shape1.Width + 8;
    Shape2.Top  := Shape1.Top;
  end;
end;
 
end.

[Jipété]

Je voudrais bien t'aider mais, j'avoue humblement que je n'ai pas compris ton problème...

Bienvenue au club des fous !

Alors en ce qui te concerne (je n'ai pas regardé ton code, je suis à la bourre), c'est normal qu'il fonctionne, c'est le petit code de démo.

Là où ça coince, c'est quand j'essaie d'obtenir le même comportement avec une ihm un peu plus chargée. Pendant que tu rédigeais ton post, moi j'écrivais ça :

Bon, j'ai l'explication (pas la solution) pour l'inversion de sens, un truc de grand malade :


Vous la voyez, la case à cocher avec sa checkmark ? Vous la voyez bien, en bas de l'image ?

Hé bien, quand je fais exécuter le prog en pas-à-pas après avoir décoché la coche, le test if saute directement à la ligne après end else begin ! :


et face à ça, je ne sais pas ce qu'il faut faire.

J'ai une solution de contournement : le bug se manifeste SI la case est cochée dans l'EDI, suffit de la décocher et tout rentre dans l'ordre -- pour cette histoire de vertical/horizontal, parce que l'appel à la création du dégradé est toujours foireuse :
procédure dans la unit principale = ok
procédure dans une unit dédiée = pâté (image noire comme vous pouvez le voir) alors que c'est strictement le même code…


J'y retourne (oui je sais, tout ça est un peu confus, c'est parce qu'il fait chaud, )

[der§en]

Ton Pb ne serait pas la présence d'un NOT dans ton if ?

Si ton source n'est pas "confidentiel", je veux bien t'aider.

[Jipété]

Ton Pb ne serait pas la présence d'un NOT dans ton if ?

Le pb du vertical/horizontal : j'ai dû me faire un nœud dans la tête (je commence à fatiguer), désolé pour le dérangement.

Si ton source n'est pas "confidentiel", je veux bien t'aider.

Merci pour ta proposition, non, il n'y a rien de confidentiel, c'est juste que c'est une telle pagaille que j'ai trop honte de montrer ça.
EDIT : de plus, je viens de faire le test à l'instant, dans le petit prog de démo j'ai viré l'unité avec juste la proc DrawMultiGradient pour mettre à la place ma vieille unit4colors qui date d'un paquet d'années et c'est toujours bon, oufff !
Ce qui est ci-dessous est donc caduc (et je n'ai pas trouvé qui met la pagaille...)
/EDIT

Et j'ai une solution pour ce problème d'image noire générée par le prog original (la petite démo de ce matin on peut l'oublier) : il suffit que la procédure DrawMultiGradient soit incluse dans la main-unit (très désagréable) et il faut aussi que j'ajoute Canvas.Changed;après l'appel de la proc, sinon l'image affichée est bonne mais l'enregistrement du fichier donne une image noire !
Et voilà.

Je m'attends à d'autres misères dans les jours à venir…