root / UFSeqAliP.pas
Historique | Voir | Annoter | Télécharger (20,307 ko)
1 |
unit UFSeqAliP ;
|
---|---|
2 |
|
3 |
interface
|
4 |
|
5 |
uses
|
6 |
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
7 |
Dialogs, StdCtrls, ExtCtrls, Buttons, PBNumEdit, JvExControls, JvComponent, |
8 |
JvEnterTab, UVariables, gnugettext; |
9 |
|
10 |
type
|
11 |
TFSeqAliP = class(TForm)
|
12 |
GBAli: TGroupBox; |
13 |
CBSeqAli: TComboBox; |
14 |
LBRule: TListBox; |
15 |
LNo: TLabel; |
16 |
LModeFin: TLabel; |
17 |
CBTwoAli: TCheckBox; |
18 |
CBTransit: TCheckBox; |
19 |
CBAli1: TComboBox; |
20 |
LInit: TLabel; |
21 |
LFin: TLabel; |
22 |
PBAli1Init: TPBNumEdit; |
23 |
PBAli1Fin: TPBNumEdit; |
24 |
PBAli2Init: TPBNumEdit; |
25 |
PBAli2Fin: TPBNumEdit; |
26 |
GBSeqAli: TGroupBox; |
27 |
CBAli2: TComboBox; |
28 |
GBRule: TGroupBox; |
29 |
SBAddRule: TSpeedButton; |
30 |
SBDelRule: TSpeedButton; |
31 |
SBAddSeqAli: TSpeedButton; |
32 |
SBDelSeqAli: TSpeedButton; |
33 |
LAli: TLabel; |
34 |
LAli1: TLabel; |
35 |
LAli2: TLabel; |
36 |
LAli1Init: TLabel; |
37 |
LAli1Fin: TLabel; |
38 |
LAli2Init: TLabel; |
39 |
LAli2Fin: TLabel; |
40 |
PInit: TPanel; |
41 |
PFin: TPanel; |
42 |
SBRename: TSpeedButton; |
43 |
SBComment: TSpeedButton; |
44 |
GBEnd: TGroupBox; |
45 |
LUnitFin: TLabel; |
46 |
PBValFin: TPBNumEdit; |
47 |
CBModeFin: TComboBox; |
48 |
PSeqAli: TPanel; |
49 |
GBParam: TGroupBox; |
50 |
SBSave: TSpeedButton; |
51 |
SBPrint: TSpeedButton; |
52 |
JvEnterAsTab: TJvEnterAsTab; |
53 |
procedure FormShow(Sender: TObject);
|
54 |
procedure FormClose(Sender: TObject; var Action: TCloseAction); |
55 |
procedure LBRuleDrawItem(Control: TWinControl; Index: Integer;
|
56 |
Rect: TRect; State: TOwnerDrawState); |
57 |
procedure CBSeqAliChange(Sender: TObject);
|
58 |
procedure SBAddSeqAliClick(Sender: TObject);
|
59 |
procedure SBDelSeqAliClick(Sender: TObject);
|
60 |
procedure SBAddRuleClick(Sender: TObject);
|
61 |
procedure SBDelRuleClick(Sender: TObject);
|
62 |
procedure LBRuleClick(Sender: TObject);
|
63 |
procedure CBTwoAliClick(Sender: TObject);
|
64 |
procedure CBTransitClick(Sender: TObject);
|
65 |
procedure PBAli1InitChange(Sender: TObject);
|
66 |
procedure PBAli1FinChange(Sender: TObject);
|
67 |
procedure CBAli1Change(Sender: TObject);
|
68 |
procedure CBAli2Change(Sender: TObject);
|
69 |
procedure FormActivate(Sender: TObject);
|
70 |
procedure FormDeactivate(Sender: TObject);
|
71 |
procedure SBRenameClick(Sender: TObject);
|
72 |
procedure SBCommentClick(Sender: TObject);
|
73 |
procedure CBModeFinChange(Sender: TObject);
|
74 |
procedure PBValFinChange(Sender: TObject);
|
75 |
procedure SBSaveClick(Sender: TObject);
|
76 |
procedure SBPrintClick(Sender: TObject);
|
77 |
procedure FormCreate(Sender: TObject);
|
78 |
private
|
79 |
{ D?clarations priv?es }
|
80 |
Update, Modified : boolean ; |
81 |
IdxSeqAliP, NumRule : integer ; |
82 |
procedure Save ;
|
83 |
public
|
84 |
{ D?clarations publiques }
|
85 |
function StrModeFin (n : integer) : string ; |
86 |
function StrAliment (n : integer) : string ; |
87 |
end;
|
88 |
|
89 |
var
|
90 |
FSeqAliP: TFSeqAliP; |
91 |
|
92 |
implementation
|
93 |
|
94 |
uses
|
95 |
UStrings, UInit, UUtil, UFindRec, UEchelle, UFComment, UFRapSeqAliP ; |
96 |
|
97 |
{$R *.dfm}
|
98 |
|
99 |
{ TFSeqAliP }
|
100 |
|
101 |
procedure TFSeqAliP.FormCreate(Sender: TObject);
|
102 |
begin
|
103 |
if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1 |
104 |
then
|
105 |
Font.Name := 'Arial Unicode MS';
|
106 |
TranslateComponent(Self); |
107 |
Constraints.MinWidth := 616 + (Width - ClientWidth);
|
108 |
Width := Constraints.MinWidth; |
109 |
Constraints.MinHeight := 432 + (Height - ClientHeight);
|
110 |
Height := Constraints.MinHeight; |
111 |
end;
|
112 |
|
113 |
procedure TFSeqAliP.FormShow (Sender : TObject) ;
|
114 |
begin
|
115 |
Modified := FALSE ; |
116 |
StringsSeqAliP (CBSeqAli.Items, TRUE) ; |
117 |
SBAddSeqAli.Enabled := IsComplete or (ListSeqAliP.Count < 5) ; |
118 |
SBSave.Enabled := IsComplete or IsEducation ;
|
119 |
IdxSeqAliP := -1 ;
|
120 |
// CBSeqAliChange (nil) ;
|
121 |
end ;
|
122 |
|
123 |
procedure TFSeqAliP.FormClose (Sender : TObject ; var Action : TCloseAction) ; |
124 |
begin
|
125 |
if Modified then Save ; |
126 |
Action := caFree ; |
127 |
NumWinSeqAliP := -1 ;
|
128 |
end ;
|
129 |
|
130 |
procedure TFSeqAliP.FormActivate (Sender : TObject) ;
|
131 |
var
|
132 |
i : integer ; |
133 |
begin
|
134 |
CBAli1.Clear ; |
135 |
CBAli2.Clear ; |
136 |
if ListAliment.Count > 0 |
137 |
then
|
138 |
for i := 0 to ListAliment.Count - 1 do |
139 |
begin
|
140 |
PAliment := ListAliment[i] ; |
141 |
if AlimentValid (PAliment) and (PAliment.Typ <> 2) |
142 |
then
|
143 |
begin
|
144 |
CBAli1.Items.Add (PAliment.Nom) ; |
145 |
CBAli2.Items.Add (PAliment.Nom) ; |
146 |
end ;
|
147 |
end ;
|
148 |
// if IdxSeqAliP <> -1
|
149 |
// then
|
150 |
// begin
|
151 |
// PSeqAliP := ListSeqAliP[IdxSeqAliP] ;
|
152 |
// with PSeqAliP.Rule[NumRule] do
|
153 |
// begin
|
154 |
// if NumAli1 <> -1
|
155 |
// then
|
156 |
// CBAli1.ItemIndex := CBAli1.Items.IndexOf (FindNomAliment (NumAli1)) ;
|
157 |
// if NumAli2 <> -1
|
158 |
// then
|
159 |
// CBAli2.ItemIndex := CBAli2.Items.IndexOf (FindNomAliment (NumAli2)) ;
|
160 |
// end ;
|
161 |
// end ;
|
162 |
CBSeqAliChange (nil) ;
|
163 |
PSeqAli.Enabled := IsComplete or IsEducation or IsEvaluation ; |
164 |
SBAddRule.Visible := PSeqAli.Enabled ; |
165 |
SBDelRule.Visible := PSeqAli.Enabled ; |
166 |
end ;
|
167 |
|
168 |
procedure TFSeqAliP.FormDeactivate (Sender : TObject) ;
|
169 |
begin
|
170 |
if Modified then Save ; |
171 |
end ;
|
172 |
|
173 |
procedure TFSeqAliP.Save ;
|
174 |
var
|
175 |
s : string ;
|
176 |
begin
|
177 |
Modified := FALSE ; |
178 |
if IsComplete or IsEducation |
179 |
then
|
180 |
if MessageDlg (Caption + sLineBreak + MsgSave, mtConfirmation, [mbYes, mbNo], 0) = mrYes |
181 |
then
|
182 |
begin
|
183 |
SaveSeqAliP ; |
184 |
if not SeqAliPValid (PSeqAliP) |
185 |
then
|
186 |
MessageDlg(Format (MsgInvalidData, [Caption, PSeqAliP.Nom]), mtWarning, [mbOK], 0) ;
|
187 |
end
|
188 |
else
|
189 |
begin
|
190 |
LoadSeqAliP ; |
191 |
s := CBSeqAli.Text ; |
192 |
StringsSeqAliP (CBSeqAli.Items, TRUE) ; |
193 |
if FindIdxSeqAliP (s) = -1 |
194 |
then
|
195 |
begin
|
196 |
IdxSeqAliP := -1 ;
|
197 |
CBSeqAliChange (nil) ;
|
198 |
end
|
199 |
else
|
200 |
CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (s) ; |
201 |
end ;
|
202 |
end ;
|
203 |
|
204 |
procedure TFSeqAliP.CBSeqAliChange (Sender : TObject) ;
|
205 |
var
|
206 |
i : integer ; |
207 |
begin
|
208 |
if (IdxSeqAliP <> -1) and (CBSeqAli.Text <> PSeqAliP.Nom) |
209 |
then
|
210 |
if Modified then Save ; |
211 |
IdxSeqAliP := FindIdxSeqAliP (CBSeqAli.Text) ; |
212 |
LBRule.Clear ; |
213 |
if IdxSeqAliP = -1 |
214 |
then
|
215 |
begin
|
216 |
CBSeqAli.Repaint ; |
217 |
SBDelSeqAli.Enabled := FALSE ; |
218 |
SBRename.Enabled := FALSE ; |
219 |
SBComment.Enabled := FALSE ; |
220 |
SBSave.Enabled := FALSE ; |
221 |
SBPrint.Enabled := FALSE ; |
222 |
PSeqAli.Visible := FALSE ; |
223 |
end
|
224 |
else // Affichage de l'enregistrement |
225 |
begin
|
226 |
SBDelSeqAli.Enabled := TRUE ; |
227 |
SBRename.Enabled := TRUE ; |
228 |
SBComment.Enabled := TRUE ; |
229 |
SBSave.Enabled := TRUE ; |
230 |
SBPrint.Enabled := TRUE ; |
231 |
PSeqAli.Visible := TRUE ; |
232 |
PSeqAliP := ListSeqAliP[IdxSeqAliP] ; |
233 |
with PSeqAliP^ do |
234 |
CBSeqAli.Hint := Memo ; |
235 |
with PSeqAliP^ do |
236 |
for i := 1 to NbRule do |
237 |
LBRule.Items.Add ('') ;
|
238 |
LBRule.ItemIndex := 0 ;
|
239 |
LBRuleClick (nil) ;
|
240 |
end ;
|
241 |
end ;
|
242 |
|
243 |
procedure TFSeqAliP.SBAddSeqAliClick (Sender : TObject) ;
|
244 |
var
|
245 |
i, n, q : integer ; |
246 |
s : string ;
|
247 |
ok : boolean ; |
248 |
PBackup : PRecSeqAliP ; |
249 |
begin
|
250 |
if Modified then Save ; |
251 |
if IdxSeqAliP = -1 |
252 |
then
|
253 |
q := mrNo |
254 |
else
|
255 |
q := MessageDlg (MsgCopy, mtConfirmation, [mbYes, mbNo], 0) ;
|
256 |
// Saisie du nouveau nom
|
257 |
s := '' ;
|
258 |
repeat
|
259 |
if InputQuery (FSeqAliP.Caption, MsgName, s)
|
260 |
then // V?rification du nom |
261 |
begin
|
262 |
s := Trim (s) ; // Suppression des espaces au d?but et ? la fin
|
263 |
if s = '' |
264 |
then // Pas de nom |
265 |
begin
|
266 |
ok := FALSE ; |
267 |
MessageDlg (MsgNameEmpty, mtWarning, [mbOk], 0) ;
|
268 |
end
|
269 |
else
|
270 |
if Length (s) > 25 |
271 |
then // Nom trop long |
272 |
begin
|
273 |
ok := FALSE ; |
274 |
MessageDlg (Format (MsgNameTooLarge, [25]), mtWarning, [mbOk], 0) ; |
275 |
s := Copy (s, 1, 25) ; |
276 |
end
|
277 |
else
|
278 |
begin
|
279 |
ok := TRUE ; |
280 |
i := 0 ;
|
281 |
while ok and (i < ListSeqAliP.Count) do |
282 |
begin
|
283 |
PSeqAliP := ListSeqAliP[i] ; |
284 |
if PSeqAliP.Nom = s
|
285 |
then // Nom d?j? utilis? |
286 |
begin
|
287 |
ok := FALSE ; |
288 |
MessageDlg (MsgNameExists, mtWarning, [mbOk], 0) ;
|
289 |
end
|
290 |
else
|
291 |
Inc (i) ; |
292 |
end ;
|
293 |
end ;
|
294 |
end
|
295 |
else // Annulation |
296 |
begin
|
297 |
s := '' ;
|
298 |
if (IdxSeqAliP <> -1) |
299 |
then
|
300 |
PSeqAliP := ListSeqAliP[IdxSeqAliP] ; |
301 |
ok := TRUE ; |
302 |
end ;
|
303 |
until ok ;
|
304 |
if s <> '' |
305 |
then // Cr?ation du nouvel enregistrement |
306 |
begin
|
307 |
// Recherche du premier num?ro libre
|
308 |
n := 0 ;
|
309 |
repeat
|
310 |
Inc (n) ; |
311 |
ok := TRUE ; |
312 |
i := 0 ;
|
313 |
while ok and (i < ListSeqAliP.Count) do |
314 |
begin
|
315 |
PSeqAliP := ListSeqAliP[i] ; |
316 |
if PSeqAliP.Num = n
|
317 |
then
|
318 |
ok := FALSE |
319 |
else
|
320 |
Inc (i) ; |
321 |
end ;
|
322 |
until ok ;
|
323 |
New (PSeqAliP) ; |
324 |
with PSeqAliP^ do |
325 |
begin
|
326 |
Nom := s ; |
327 |
Num := n ; |
328 |
if q = mrYes
|
329 |
then
|
330 |
begin
|
331 |
PBackup := ListSeqAliP[IdxSeqAliP] ; |
332 |
Memo := PBackup.Memo ; |
333 |
NbRule := PBackup.NbRule ; |
334 |
Rule := PBackup.Rule ; |
335 |
end
|
336 |
else
|
337 |
begin
|
338 |
Memo := '' ;
|
339 |
NbRule := 1 ;
|
340 |
for i := 1 to MAX_RULE do |
341 |
with Rule[i] do |
342 |
begin
|
343 |
ModeFin := -1 ;
|
344 |
ValFin := 0 ;
|
345 |
NumAli1 := -1 ;
|
346 |
NumAli2 := -1 ;
|
347 |
PctAli1Init := 100 ;
|
348 |
PctAli1Fin := 100 ;
|
349 |
end ;
|
350 |
end ;
|
351 |
end ;
|
352 |
ListSeqAliP.Add (PSeqAliP) ; |
353 |
CBSeqAli.Items.Add (PSeqAliP.Nom) ; |
354 |
CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (PSeqAliP.Nom) ; |
355 |
CBSeqAliChange (nil) ;
|
356 |
Modified := TRUE ; |
357 |
SBAddSeqAli.Enabled := IsComplete or (ListSeqAliP.Count < 5) ; |
358 |
SBCommentClick (nil) ;
|
359 |
end ;
|
360 |
end ;
|
361 |
|
362 |
procedure TFSeqAliP.SBDelSeqAliClick (Sender : TObject) ;
|
363 |
begin
|
364 |
if SeqAliPUsed (PSeqAliP.Num)
|
365 |
then // Enregistrement utilis? |
366 |
MessageDlg (MsgDelErr, mtWarning, [mbOk], 0)
|
367 |
else // Suppression de l'enregistrement |
368 |
if MessageDlg (MsgDel, mtConfirmation, [mbYes, mbNo], 0) = mrYes |
369 |
then
|
370 |
begin
|
371 |
Dispose (PSeqAliP) ; |
372 |
ListSeqAliP.Delete (IdxSeqAliP) ; |
373 |
SaveSeqAliP ; // Sauvegarde !
|
374 |
Modified := FALSE ; |
375 |
CBSeqAli.DeleteSelected ; |
376 |
IdxSeqAliP := -1 ;
|
377 |
CBSeqAli.ItemIndex := -1 ;
|
378 |
CBSeqAliChange (nil) ;
|
379 |
SBAddSeqAli.Enabled := IsComplete or (ListSeqAliP.Count < 5) ; |
380 |
end ;
|
381 |
end ;
|
382 |
|
383 |
procedure TFSeqAliP.SBRenameClick (Sender : TObject) ;
|
384 |
var
|
385 |
i : integer ; |
386 |
s : string ;
|
387 |
ok : boolean ; |
388 |
begin
|
389 |
// Saisie du nouveau nom
|
390 |
s := CBSeqAli.Text ; |
391 |
repeat
|
392 |
if InputQuery (FSeqAliP.Caption, MsgRename, s) and (s <> CBSeqAli.Text) |
393 |
then // V?rification du nom |
394 |
begin
|
395 |
s := Trim (s) ; // Suppression des espaces au d?but et ? la fin
|
396 |
if s = '' |
397 |
then // Pas de nom |
398 |
begin
|
399 |
ok := FALSE ; |
400 |
MessageDlg (MsgNameEmpty, mtWarning, [mbOk], 0) ;
|
401 |
end
|
402 |
else
|
403 |
if Length (s) > 25 |
404 |
then // Nom trop long |
405 |
begin
|
406 |
ok := FALSE ; |
407 |
MessageDlg (Format (MsgNameTooLarge, [25]), mtWarning, [mbOk], 0) ; |
408 |
s := Copy (s, 1, 25) ; |
409 |
end
|
410 |
else
|
411 |
begin
|
412 |
ok := TRUE ; |
413 |
i := 0 ;
|
414 |
while ok and (i < ListSeqAliP.Count) do |
415 |
begin
|
416 |
PSeqAliP := ListSeqAliP[i] ; |
417 |
if PSeqAliP.Nom = s
|
418 |
then // Nom d?j? utilis? |
419 |
begin
|
420 |
ok := FALSE ; |
421 |
MessageDlg (MsgNameExists, mtWarning, [mbOk], 0) ;
|
422 |
end
|
423 |
else
|
424 |
Inc (i) ; |
425 |
end ;
|
426 |
end ;
|
427 |
end
|
428 |
else // Annulation |
429 |
begin
|
430 |
s := '' ;
|
431 |
ok := TRUE ; |
432 |
end ;
|
433 |
until ok ;
|
434 |
PSeqAliP := ListSeqAliP[IdxSeqAliP] ; |
435 |
if s <> '' |
436 |
then // Renommer l'enregistrement |
437 |
begin
|
438 |
PSeqAliP.Nom := s ; |
439 |
Modified := TRUE ; |
440 |
StringsSeqAliP (CBSeqAli.Items, TRUE) ; |
441 |
CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (s) ; |
442 |
end ;
|
443 |
end ;
|
444 |
|
445 |
procedure TFSeqAliP.SBCommentClick (Sender : TObject) ;
|
446 |
begin
|
447 |
// Saisie du commentaire
|
448 |
FComment := TFComment.Create (Self) ; |
449 |
with FComment do |
450 |
begin
|
451 |
Memo.Text := PSeqAliP.Memo ; |
452 |
if ShowModal = mrOk
|
453 |
then // Commenter l'enregistrement |
454 |
begin
|
455 |
PSeqAliP.Memo := Memo.Text ; |
456 |
Modified := TRUE ; |
457 |
CBSeqAli.Hint := PSeqAliP.Memo ; |
458 |
end ;
|
459 |
Release ; |
460 |
end ;
|
461 |
end ;
|
462 |
|
463 |
procedure TFSeqAliP.SBSaveClick(Sender: TObject);
|
464 |
begin
|
465 |
SaveSeqAliP ; |
466 |
if not SeqAliPValid (PSeqAliP) |
467 |
then
|
468 |
MessageDlg(Format (MsgInvalidData, [Caption, PSeqAliP.Nom]), mtWarning, [mbOK], 0) ;
|
469 |
Modified := FALSE ; |
470 |
end;
|
471 |
|
472 |
procedure TFSeqAliP.SBPrintClick(Sender: TObject);
|
473 |
begin
|
474 |
FRapSeqAliP := TFRapSeqAliP.Create (Self) ; |
475 |
FRapSeqAliP.QRRapport.PreviewModal ; |
476 |
FRapSeqAliP.Release ; |
477 |
end;
|
478 |
|
479 |
procedure TFSeqAliP.LBRuleClick (Sender : TObject) ;
|
480 |
begin
|
481 |
NumRule := LBRule.ItemIndex + 1 ;
|
482 |
if LBRule.Items.Count < MAX_RULE
|
483 |
then
|
484 |
SBAddRule.Enabled := TRUE |
485 |
else
|
486 |
SBAddRule.Enabled := FALSE ; |
487 |
if NumRule = PSeqAliP.NbRule
|
488 |
then // Fin de simulation |
489 |
begin
|
490 |
SBDelRule.Enabled := FALSE ; |
491 |
GBEnd.Visible := FALSE ; |
492 |
CBTwoAli.Enabled := TRUE ; |
493 |
end
|
494 |
else // Mode de fin |
495 |
begin
|
496 |
SBDelRule.Enabled := TRUE ; |
497 |
GBEnd.Visible := TRUE ; |
498 |
end ;
|
499 |
with PSeqAliP.Rule[NumRule] do |
500 |
begin
|
501 |
Update := TRUE ; |
502 |
CBModeFin.ItemIndex := ModeFin ; |
503 |
CBModeFinChange (nil) ;
|
504 |
PBValFin.AsFloat := ValFin ; |
505 |
if NumAli1 = -1 |
506 |
then
|
507 |
CBAli1.ItemIndex := -1
|
508 |
else
|
509 |
CBAli1.ItemIndex := CBAli1.Items.IndexOf (FindNomAliment (NumAli1)) ; |
510 |
if CBAli1.ItemIndex = -1 |
511 |
then
|
512 |
CBAli1.Hint := ''
|
513 |
else
|
514 |
begin
|
515 |
PAliment := ListAliment[FindIdxAliment (CBAli1.Text)] ; |
516 |
CBAli1.Hint := PAliment.Memo ; |
517 |
end ;
|
518 |
if NumAli2 = -1 |
519 |
then
|
520 |
begin
|
521 |
CBAli2.ItemIndex := -1 ;
|
522 |
if CBTwoAli.Checked
|
523 |
then
|
524 |
CBTwoAli.Checked := FALSE |
525 |
else
|
526 |
CBTwoAliClick (nil) ;
|
527 |
end
|
528 |
else // 2 aliments |
529 |
begin
|
530 |
CBAli2.ItemIndex := CBAli2.Items.IndexOf (FindNomAliment (NumAli2)) ; |
531 |
PBAli1Init.AsInteger := PctAli1Init ; |
532 |
if PctAli1Init = PctAli1Fin
|
533 |
then
|
534 |
if CBTransit.Checked
|
535 |
then
|
536 |
CBTransit.Checked := FALSE |
537 |
else
|
538 |
CBTransitClick (nil)
|
539 |
else // transition |
540 |
begin
|
541 |
PBAli1Fin.AsInteger := PctAli1Fin ; |
542 |
CBTransit.Checked := TRUE ; |
543 |
end ;
|
544 |
CBTwoAli.Checked := TRUE ; |
545 |
end ;
|
546 |
if CBAli2.ItemIndex = -1 |
547 |
then
|
548 |
CBAli2.Hint := ''
|
549 |
else
|
550 |
begin
|
551 |
PAliment := ListAliment[FindIdxAliment (CBAli2.Text)] ; |
552 |
CBAli1.Hint := PAliment.Memo ; |
553 |
end ;
|
554 |
Update := FALSE ; |
555 |
end ;
|
556 |
end ;
|
557 |
|
558 |
procedure TFSeqAliP.LBRuleDrawItem(Control: TWinControl; Index: Integer;
|
559 |
Rect: TRect; State: TOwnerDrawState); |
560 |
begin
|
561 |
with (Control as TListBox).Canvas do |
562 |
begin
|
563 |
// Cadre principal
|
564 |
FillRect(Rect); |
565 |
// Texte
|
566 |
SetTextAlign(Handle, TA_LEFT); |
567 |
Rect.Left := 22;
|
568 |
TextRect(Rect, Rect.Left, Rect.Top, StrModeFin(Index + 1));
|
569 |
Rect.Left := 150 ;
|
570 |
TextRect(Rect, Rect.Left, Rect.Top, StrAliment(Index + 1));
|
571 |
Rect.Left := 0;
|
572 |
// Num?ro
|
573 |
SetTextAlign(Handle, TA_RIGHT); |
574 |
Rect.Right := 14;
|
575 |
TextRect(Rect, Rect.Right, Rect.Top, Format('%d', [Index + 1])); |
576 |
end;
|
577 |
end;
|
578 |
|
579 |
procedure TFSeqAliP.SBAddRuleClick (Sender : TObject) ;
|
580 |
var
|
581 |
i : integer ; |
582 |
begin
|
583 |
for i := PSeqAliP.NbRule downto NumRule do |
584 |
PSeqAliP.Rule[i + 1] := PSeqAliP.Rule[i] ;
|
585 |
with PSeqAliP.Rule[NumRule] do |
586 |
begin
|
587 |
ModeFin := -1 ;
|
588 |
ValFin := 0 ;
|
589 |
end ;
|
590 |
Inc (PSeqAliP.NbRule) ; |
591 |
LBRule.Items.Add ('') ;
|
592 |
LBRule.ItemIndex := NumRule - 1 ;
|
593 |
LBRuleClick (nil) ;
|
594 |
Modified := TRUE ; |
595 |
ActiveControl := CBModeFin ; |
596 |
end ;
|
597 |
|
598 |
procedure TFSeqAliP.SBDelRuleClick (Sender : TObject) ;
|
599 |
var
|
600 |
i : integer ; |
601 |
begin
|
602 |
Dec (PSeqAliP.NbRule) ; |
603 |
for i := NumRule to PSeqAliP.NbRule do |
604 |
PSeqAliP.Rule[i] := PSeqAliP.Rule[i + 1] ;
|
605 |
i := NumRule ; // Position courante
|
606 |
LBRule.DeleteSelected ; |
607 |
LBRule.ItemIndex := i - 1 ;
|
608 |
LBRuleClick (nil) ;
|
609 |
ActiveControl := LBRule ; |
610 |
Modified := TRUE ; |
611 |
end ;
|
612 |
|
613 |
procedure TFSeqAliP.CBModeFinChange (Sender : TObject) ;
|
614 |
begin
|
615 |
if CBModeFin.ItemIndex = 3 |
616 |
then
|
617 |
begin
|
618 |
CBTwoAli.Enabled := FALSE ; |
619 |
if CBTwoAli.Checked
|
620 |
then
|
621 |
CBTwoAli.Checked := FALSE |
622 |
else
|
623 |
CBTwoAliClick (nil) ;
|
624 |
end
|
625 |
else
|
626 |
CBTwoAli.Enabled := TRUE ; |
627 |
case CBModeFin.ItemIndex of |
628 |
0, 1 : // Dur?e ou Age |
629 |
LUnitFin.Caption := StrJ ; |
630 |
2, 3 : // Poids vif ou Cumul aliment |
631 |
LUnitFin.Caption := StrKg ; |
632 |
else
|
633 |
LUnitFin.Caption := '' ;
|
634 |
end ;
|
635 |
if CBModeFin.ItemIndex = -1 |
636 |
then
|
637 |
PBValFin.Visible := FALSE |
638 |
else
|
639 |
PBValFin.Visible := TRUE ; |
640 |
if not Update |
641 |
then
|
642 |
begin
|
643 |
Modified := TRUE ; |
644 |
PSeqAliP.Rule[NumRule].ModeFin := CBModeFin.ItemIndex ; |
645 |
LBRule.Repaint ; |
646 |
end ;
|
647 |
end ;
|
648 |
|
649 |
procedure TFSeqAliP.PBValFinChange (Sender : TObject) ;
|
650 |
begin
|
651 |
if not Update |
652 |
then
|
653 |
begin
|
654 |
Modified := TRUE ; |
655 |
PSeqAliP.Rule[NumRule].ValFin := PBValFin.AsFloat ; |
656 |
LBRule.Repaint ; |
657 |
end ;
|
658 |
end ;
|
659 |
|
660 |
procedure TFSeqAliP.CBTwoAliClick (Sender : TObject) ;
|
661 |
begin
|
662 |
if CBTwoAli.Checked
|
663 |
then
|
664 |
begin
|
665 |
if CBAli1.ItemIndex = -1 |
666 |
then
|
667 |
CBAli2.Enabled := FALSE |
668 |
else
|
669 |
CBAli2.Enabled := TRUE ; |
670 |
PInit.Visible := TRUE ; |
671 |
CBTransit.Visible := TRUE |
672 |
end
|
673 |
else
|
674 |
begin
|
675 |
if CBAli2.Text <> '' |
676 |
then
|
677 |
begin
|
678 |
Modified := TRUE ; |
679 |
CBAli2.ItemIndex := -1 ;
|
680 |
PSeqAliP.Rule[NumRule].NumAli2 := -1 ;
|
681 |
end ;
|
682 |
CBAli2.Enabled := FALSE ; |
683 |
PInit.Visible := FALSE ; |
684 |
CBTransit.Visible := FALSE ; |
685 |
PBAli1Init.AsInteger := 100 ;
|
686 |
if CBTransit.Checked
|
687 |
then
|
688 |
CBTransit.Checked := FALSE |
689 |
else
|
690 |
CBTransitClick (nil) ;
|
691 |
end ;
|
692 |
end ;
|
693 |
|
694 |
procedure TFSeqAliP.CBTransitClick (Sender : TObject) ;
|
695 |
begin
|
696 |
if CBTransit.Checked
|
697 |
then
|
698 |
begin
|
699 |
PFin.Visible := TRUE ; |
700 |
LInit.Visible := TRUE ; |
701 |
PBAli1Init.Hint := HintAli1Init ; |
702 |
end
|
703 |
else
|
704 |
begin
|
705 |
PFin.Visible := FALSE ; |
706 |
LInit.Visible := FALSE ; |
707 |
PBAli1Init.Hint := HintAli1Const ; |
708 |
PBAli1Fin.AsInteger := PBAli1Init.AsInteger ; |
709 |
end ;
|
710 |
end ;
|
711 |
|
712 |
procedure TFSeqAliP.CBAli1Change (Sender : TObject) ;
|
713 |
begin
|
714 |
if CBAli1.ItemIndex > -1 |
715 |
then
|
716 |
CBAli2.Enabled := CBTwoAli.Checked ; |
717 |
if not Update and (CBAli1.Text <> '') |
718 |
then
|
719 |
begin
|
720 |
Modified := TRUE ; |
721 |
PSeqAliP.Rule[NumRule].NumAli1 := FindNumAliment (CBAli1.Text) ; |
722 |
LBRule.Repaint ; |
723 |
end ;
|
724 |
end ;
|
725 |
|
726 |
procedure TFSeqAliP.CBAli2Change (Sender : TObject) ;
|
727 |
begin
|
728 |
if not Update and (CBAli2.Text <> '') |
729 |
then
|
730 |
begin
|
731 |
Modified := TRUE ; |
732 |
PSeqAliP.Rule[NumRule].NumAli2 := FindNumAliment (CBAli2.Text) ; |
733 |
LBRule.Repaint ; |
734 |
end ;
|
735 |
end ;
|
736 |
|
737 |
procedure TFSeqAliP.PBAli1InitChange (Sender : TObject) ;
|
738 |
begin
|
739 |
PBAli2Init.AsInteger := 100 - PBAli1Init.AsInteger ;
|
740 |
if not Update |
741 |
then
|
742 |
begin
|
743 |
Modified := TRUE ; |
744 |
PSeqAliP.Rule[NumRule].PctAli1Init := PBAli1Init.AsInteger ; |
745 |
if not CBTransit.Checked |
746 |
then // Pas de transition |
747 |
PBAli1Fin.AsInteger := PBAli1Init.AsInteger ; |
748 |
LBRule.Repaint ; |
749 |
end ;
|
750 |
end ;
|
751 |
|
752 |
procedure TFSeqAliP.PBAli1FinChange (Sender : TObject) ;
|
753 |
begin
|
754 |
PBAli2Fin.AsInteger := 100 - PBAli1Fin.AsInteger ;
|
755 |
if not Update |
756 |
then
|
757 |
begin
|
758 |
Modified := TRUE ; |
759 |
PSeqAliP.Rule[NumRule].PctAli1Fin := PBAli1Fin.AsInteger ; |
760 |
LBRule.Repaint ; |
761 |
end ;
|
762 |
end ;
|
763 |
|
764 |
function TFSeqAliP.StrModeFin (n : integer) : string ; |
765 |
begin
|
766 |
if n = PSeqAliP.NbRule
|
767 |
then // Fin de simulation |
768 |
result := _('End of simulation')
|
769 |
else
|
770 |
with PSeqAliP.Rule[n] do |
771 |
case ModeFin of |
772 |
0, 1 : // Dur?e ou Age |
773 |
result := Format ('%s = %1.0f %s', [CBModeFin.Items[ModeFin], ValFin, StrJ]) ;
|
774 |
2, 3 : // Poids vif ou Cumul aliment |
775 |
result := Format ('%s = %1.0f %s', [CBModeFin.Items[ModeFin], ValFin, StrKg]) ;
|
776 |
else
|
777 |
result := '' ;
|
778 |
end ;
|
779 |
end ;
|
780 |
|
781 |
function TFSeqAliP.StrAliment (n : integer) : string ; |
782 |
begin
|
783 |
with PSeqAliP.Rule[n] do |
784 |
if NumAli1 = -1 |
785 |
then
|
786 |
result := ''
|
787 |
else
|
788 |
if NumAli2 = -1 |
789 |
then // 1 aliment |
790 |
result := FindNomAliment (NumAli1) |
791 |
else // 2 aliments |
792 |
if PctAli1Init = PctAli1Fin
|
793 |
then
|
794 |
result := Format ('%s (%d %%) - %s (%d %%)', [FindNomAliment (NumAli1), PctAli1Init, FindNomAliment (NumAli2), 100 - PctAli1Init]) |
795 |
else // Transition |
796 |
result := Format ('%s : %s (%d-%d %%) - %s (%d-%d %%)', [_('Transition'), FindNomAliment (NumAli1), PctAli1Init, PctAli1Fin, FindNomAliment (NumAli2), 100 - PctAli1Init, 100 - PctAli1Fin]) ; |
797 |
end ;
|
798 |
|
799 |
end.
|