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.