Discussion :

[Gouyon]

Salut à tous

Je me lance dans la création d'un composant et j'ai de gros soucis. Le composant que je cherche à faire est une barre de progression colorée. Le principe est que la couleur de la barre, au lieu de rester la même, évolue en fonction du remplissage et le taux de remplissage est inscrit au milieu.

Voici le code :

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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
 
unit ColoredProgressBar1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,ExtCtrls;
 
type
  TColoredProgressBar = class(TImage)
  private
    { Private declarations }
    Couleur1: TColor;
    Couleur2: TColor;
    Couleur3: TColor;
    Couleur4: TColor;
    Progressif: boolean;
    Max: integer;
    Min: integer;
    Position: integer;
    Texte:string;
 
    procedure SetCouleur1(New: TColor);
    procedure SetCouleur2(New: TColor);
    procedure SetCouleur3(New: TColor);
    procedure SetCouleur4(New: TColor);
    procedure SetProgressif(New: boolean);
    procedure SetMax(New: integer);
    procedure SetMin(New: integer);
    procedure SetPosition(New: integer);
    procedure SetCaption(New: String);
 
  protected
    { Protected declarations }
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
 
  published
    { Published declarations }
    property Color1: TColor read Couleur1 write SetCouleur1 default clRed;
    property Color2: TColor read Couleur2 write SetCouleur2 default clYellow;
    property Color3: TColor read Couleur3 write SetCouleur3 default clLime;
    property Color4: TColor read Couleur4 write SetCouleur4 default clBlue;
    property Progressive: boolean read Progressif write SetProgressif default True;
    property Maximum: integer read Max write SetMax default 100;
    property Minimum: integer read Min write SetMin default 0;
    property Pos: integer read Position write SetPosition;
    property Caption: String read Texte write SetCaption;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  {$I coloredprogressbar1_icon.lrs}
  RegisterComponents('MonPac', [TColoredProgressBar]);
end;
 
constructor TColoredProgressBar.Create(AOwner : TComponent);
begin
  inherited;
  Width:=100;
  Height:=20;
  Couleur1:=clRed;
  Couleur2:=clYellow;
  Couleur3:= clLime;
  Couleur4:=clBlue;
end;
 
destructor TColoredProgressBar.Destroy;
begin
  inherited;
end;
 
procedure TColoredProgressBar.SetCouleur1(New: TColor);
begin
  Couleur1 := New;
end;
 
procedure TColoredProgressBar.SetCouleur2(New: TColor);
begin
  Couleur2 := New;
end;
 
procedure TColoredProgressBar.SetCouleur3(New: TColor);
begin
  Couleur3 := New;
end;
 
procedure TColoredProgressBar.SetCouleur4(New: TColor);
begin
  Couleur4 := New;
end;
 
procedure TColoredProgressBar.SetProgressif(New: boolean);
begin
  Progressif := New;
end;
 
procedure TColoredProgressBar.SetMax(New: integer);
begin
  Max := New;
end;
 
procedure TColoredProgressBar.SetMin(New: integer);
begin
  Min := New;
end;
 
procedure TColoredProgressBar.SetPosition(New: integer);
begin
  Position := New;
end;
procedure TColoredProgressBar.SetCaption(New: String);
begin
 Texte:=New;
end;
 
procedure TColoredProgressBar.Paint;
 var
  Seuil,Plage,xt, yt: integer;
  MaBmp: TBitmap;
  Rect: TRect;
  Lcol,Hcol:TColor;
  R,G,B,rh,gh,bh,rl,gl,bl:byte;
  X:integer;
  S:String;
begin
  X:=round((100*(Position-Min))/(Max-Min));
  S:=Texte+Format(' %3d%%', [X]);
  xt := (Width - Canvas.GetTextWidth(S)) div 2;
  yt:=(Height - Canvas.GetTextHeight(S)) div 2;
  MaBmp := TBitmap.Create;
  MaBmp.Width := Width;
  MaBmp.Height := Height;
  MaBmp.Canvas.Brush.Color := clWhite;
  MaBmp.Canvas.Brush.Style := bsSolid;
  MaBmp.Canvas.FillRect(0, 0, Width, Height);
  MaBmp.Canvas.Font.Color := clBlack;
  MaBmp.Canvas.TextOut(xt, yt, S);
 
  if (X >= 66) then
    begin
      rl:=Blue(Couleur3);
      rh:=Blue(Couleur4);
      gl:=Blue(Couleur3);
      gh:=Blue(Couleur4);
      bl:=Blue(Couleur3);
      bh:=Blue(Couleur4);
      Seuil:=66;
      Plage:=100-66;
    end;
  if (X >= 33) and (X < 66) then
    begin
      rl:=Blue(Couleur2);
      rh:=Blue(Couleur3);
      gl:=Blue(Couleur2);
      gh:=Blue(Couleur3);
      bl:=Blue(Couleur2);
      bh:=Blue(Couleur3);
      Seuil:=33;
      Plage:=66-33;
    end;
  if (X < 33) then
   begin
      rl:=Blue(Couleur1);
      rh:=Blue(Couleur2);
      gl:=Blue(Couleur1);
      gh:=Blue(Couleur2);
      bl:=Blue(Couleur1);
      bh:=Blue(Couleur2);
      Seuil:=0;
      Plage:=33-0;
    end;
  if Progressif then
   begin
      R:=round((rh-rl)*(X-Seuil)/Plage+rl) ;
      G:=round((gh-gl)*(X-Seuil)/Plage+gl) ;
      B:=round((bh-bl)*(X-Seuil)/Plage+bl) ;
      Canvas.Brush.Color := RGBToColor(R, G, B);
   end
  else
  begin
    if X>=100 then
     begin
        X:=100;
        Canvas.Brush.Color := Couleur4;
        end
    else
    begin
     Canvas.Brush.Color := RGBToColor(rl, gl, bl);
      end;
  end;
  xt:=(X * Width) div 100;
  Canvas.FillRect(0, 0, xt, Height);
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(xt, 0,Width, Height);
  Rect.Left := 0;
  Rect.Top := 0;
  Rect.Right := Width;
  Rect.Bottom := Height;
  Canvas.CopyMode := cmSrcAnd;
  Canvas.CopyRect(Rect, MaBmp.Canvas, Rect);
  MaBmp.Free;
 
end;
 
end.

La compilation se fait bien de même que l'installation du paquet. Par contre, dès que je dépose ce composant sur une Form, Lazarus plante.

Si quelqu'un peut me dire où se situe l'erreur.

[tourlourou]

Bonjour,

Ton composant a un Owner, mais pas de Parent qui se charge de l'afficher ?

[Gouyon]

Ton composant a un Owner, mais pas de Parent qui se charge de l'afficher ?

Peux tu être un peu plus explicite. Car il me semblait justement que le Owner est le Parent

[tourlourou]

En Delphi, le Owner est le propriétaire : cad se charge de la libération de l'objet (on peut passer nil quand on gère soi-même le cycle de vie ; et le Parent est l'objet qui se charge de transmettre les messages Windows (au moins d'affichage).

Donc en création dynamique, si on n'affecte pas le Parent, il n'y a pas d'affichage du tout.

Cela dit, le composant peut être conçu de manière à affecter le Owner comme Parent lors du Create... Pour le TImage, je ne pense pas que ce soit le cas, et il doit falloir le renseigner manuellement.

En FPC/Lazarus, ça reste à voir s'il y a la même distinction.

Cela dit, à bien relire ton code, il me semble qu'il y a un hic : tu écris au OnPaint sur le TImage.Canvas ; celui-ci est-il bien défini si on n'affecte pas de Picture ? Et un TPaintBox ne serait-il pas plus indiqué ?

Je regrette de ne pas avoir Lazarus pour tester ici !

Ton composant fonctionne-t-il en création dynamique ?

[Gouyon]

Cela dit, à bien relire ton code, il me semble qu'il y a un hic : tu écris au OnPaint sur le TImage.Canvas ; celui-ci est-il bien défini si on n'affecte pas de Picture ? Et un TPaintBox ne serait-il pas plus indiqué ?

La méthode Paint est surchargée et elle définit comment se comporte mon composant à l'affichage. En fait je me suis inspiré du tutoriel delphi de création d'un composant.

Ton composant fonctionne-t-il en création dynamique ?

Je n'ai pas testé mais ça m'étonnerais que ça fonctionne.

[tourlourou]

Peut-être faut-il essayer plutôt que de copier dans TImage.Canvas le Bitmap que tu as préparé dans le OnPaint, de l'assigner à la propriété Picture (?) du TImage.

Par ailleurs, tu dessines à chaque OnPaint le Bitmap, qu'il ait changé ou pas...

Peut-être peux-tu envisager de le dessiner dans un champ de ton objet, le OnPaint se chargeant seulement de le recopier pour l'afficher. A charge pour le SetProgression de dessiner le nouveau BitMap si changement de position (donc stocker l'ancienne) et de demander le redessin du compo.