root / UFSeqAliT.pas @ 5
Historique | Voir | Annoter | Télécharger (26,103 ko)
1 |
unit UFSeqAliT ;
|
---|---|
2 |
|
3 |
interface
|
4 |
|
5 |
uses
|
6 |
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
7 |
Dialogs, StdCtrls, ExtCtrls, Buttons, ComCtrls, PBNumEdit, JvExControls, |
8 |
JvComponent, JvEnterTab, UVariables, gnugettext; |
9 |
|
10 |
type
|
11 |
TFSeqAliT = 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 |
TC: TTabControl; |
49 |
SBSave: TSpeedButton; |
50 |
SBPrint: TSpeedButton; |
51 |
GBParam: TGroupBox; |
52 |
PSeqAli: TPanel; |
53 |
JvEnterAsTab: TJvEnterAsTab; |
54 |
procedure FormShow(Sender: TObject);
|
55 |
procedure FormClose(Sender: TObject; var Action: TCloseAction); |
56 |
procedure LBRuleDrawItem(Control: TWinControl; Index: Integer;
|
57 |
Rect: TRect; State: TOwnerDrawState); |
58 |
procedure CBSeqAliChange(Sender: TObject);
|
59 |
procedure SBAddSeqAliClick(Sender: TObject);
|
60 |
procedure SBDelSeqAliClick(Sender: TObject);
|
61 |
procedure SBAddRuleClick(Sender: TObject);
|
62 |
procedure SBDelRuleClick(Sender: TObject);
|
63 |
procedure LBRuleClick(Sender: TObject);
|
64 |
procedure CBTwoAliClick(Sender: TObject);
|
65 |
procedure CBTransitClick(Sender: TObject);
|
66 |
procedure PBAli1InitChange(Sender: TObject);
|
67 |
procedure PBAli1FinChange(Sender: TObject);
|
68 |
procedure CBAli1Change(Sender: TObject);
|
69 |
procedure CBAli2Change(Sender: TObject);
|
70 |
procedure FormActivate(Sender: TObject);
|
71 |
procedure FormDeactivate(Sender: TObject);
|
72 |
procedure SBRenameClick(Sender: TObject);
|
73 |
procedure SBCommentClick(Sender: TObject);
|
74 |
procedure PBValFinChange(Sender: TObject);
|
75 |
procedure TCChange(Sender: TObject);
|
76 |
procedure SBSaveClick(Sender: TObject);
|
77 |
procedure SBPrintClick(Sender: TObject);
|
78 |
procedure FormCreate(Sender: TObject);
|
79 |
private
|
80 |
{ D?clarations priv?es }
|
81 |
Update, Modified : boolean ; |
82 |
IdxSeqAliT, NbRule, NumRule : integer ; |
83 |
Rule : array[1..MAX_RULE] of RecRuleSeqAliT ; |
84 |
procedure Save ;
|
85 |
public
|
86 |
{ D?clarations publiques }
|
87 |
function StrModeFin (etat, regle : integer) : string ; |
88 |
function StrAliment (etat, regle : integer) : string ; |
89 |
end;
|
90 |
|
91 |
var
|
92 |
FSeqAliT: TFSeqAliT; |
93 |
|
94 |
implementation
|
95 |
|
96 |
uses
|
97 |
UStrings, UInit, UUtil, UFindRec, UEchelle, UFComment, UFRapSeqAliT ; |
98 |
|
99 |
{$R *.dfm}
|
100 |
|
101 |
{ TFSeqAliT }
|
102 |
|
103 |
procedure TFSeqAliT.FormCreate(Sender: TObject);
|
104 |
begin
|
105 |
if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1 |
106 |
then
|
107 |
Font.Name := 'Arial Unicode MS';
|
108 |
TranslateComponent(Self); |
109 |
Constraints.MinWidth := 616 + (Width - ClientWidth);
|
110 |
Width := Constraints.MinWidth; |
111 |
Constraints.MinHeight := 460 + (Height - ClientHeight);
|
112 |
Height := Constraints.MinHeight; |
113 |
CBModeFin.ItemIndex := 0;
|
114 |
end;
|
115 |
|
116 |
procedure TFSeqAliT.FormShow (Sender : TObject) ;
|
117 |
begin
|
118 |
Modified := FALSE ; |
119 |
StringsSeqAliT (CBSeqAli.Items, TRUE) ; |
120 |
SBAddSeqAli.Enabled := IsComplete or (ListSeqAliT.Count < 5) ; |
121 |
SBSave.Enabled := IsComplete or IsEducation ;
|
122 |
IdxSeqAliT := -1 ;
|
123 |
// CBSeqAliChange (nil) ;
|
124 |
end ;
|
125 |
|
126 |
procedure TFSeqAliT.FormClose (Sender : TObject ; var Action : TCloseAction) ; |
127 |
begin
|
128 |
if Modified then Save ; |
129 |
Action := caFree ; |
130 |
NumWinSeqAliT := -1 ;
|
131 |
end ;
|
132 |
|
133 |
procedure TFSeqAliT.FormActivate (Sender : TObject) ;
|
134 |
var
|
135 |
i : integer ; |
136 |
begin
|
137 |
CBAli1.Clear ; |
138 |
CBAli2.Clear ; |
139 |
if ListAliment.Count > 0 |
140 |
then
|
141 |
for i := 0 to ListAliment.Count - 1 do |
142 |
begin
|
143 |
PAliment := ListAliment[i] ; |
144 |
if AlimentValid (PAliment) and (PAliment.Typ <> 1) |
145 |
then
|
146 |
begin
|
147 |
CBAli1.Items.Add (PAliment.Nom) ; |
148 |
CBAli2.Items.Add (PAliment.Nom) ; |
149 |
end ;
|
150 |
end ;
|
151 |
// if IdxSeqAliT <> -1
|
152 |
// then
|
153 |
// begin
|
154 |
// PSeqAliT := ListSeqAliT[IdxSeqAliT] ;
|
155 |
// with Rule[NumRule] do
|
156 |
// begin
|
157 |
// if NumAli1 <> -1
|
158 |
// then
|
159 |
// CBAli1.ItemIndex := CBAli1.Items.IndexOf (FindNomAliment (NumAli1)) ;
|
160 |
// if NumAli2 <> -1
|
161 |
// then
|
162 |
// CBAli2.ItemIndex := CBAli2.Items.IndexOf (FindNomAliment (NumAli2)) ;
|
163 |
// end ;
|
164 |
// end ;
|
165 |
CBSeqAliChange (nil) ;
|
166 |
GBParam.Enabled := IsComplete or IsEducation or IsEvaluation ; |
167 |
SBAddRule.Visible := GBParam.Enabled ; |
168 |
SBDelRule.Visible := GBParam.Enabled ; |
169 |
end ;
|
170 |
|
171 |
procedure TFSeqAliT.FormDeactivate (Sender : TObject) ;
|
172 |
begin
|
173 |
if Modified then Save ; |
174 |
end ;
|
175 |
|
176 |
procedure TFSeqAliT.Save ;
|
177 |
var
|
178 |
s : string ;
|
179 |
begin
|
180 |
Modified := FALSE ; |
181 |
if IsComplete or IsEducation |
182 |
then
|
183 |
if MessageDlg (Caption + sLineBreak + MsgSave, mtConfirmation, [mbYes, mbNo], 0) = mrYes |
184 |
then
|
185 |
begin
|
186 |
SaveSeqAliT ; |
187 |
if not SeqAliTValid (PSeqAliT) |
188 |
then
|
189 |
MessageDlg(Format (MsgInvalidData, [Caption, PSeqAliT.Nom]), mtWarning, [mbOK], 0) ;
|
190 |
end
|
191 |
else
|
192 |
begin
|
193 |
LoadSeqAliT ; |
194 |
s := CBSeqAli.Text ; |
195 |
StringsSeqAliT (CBSeqAli.Items, TRUE) ; |
196 |
if FindIdxSeqAliT (s) = -1 |
197 |
then
|
198 |
begin
|
199 |
IdxSeqAliT := -1 ;
|
200 |
CBSeqAliChange (nil) ;
|
201 |
end
|
202 |
else
|
203 |
CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (s) ; |
204 |
end ;
|
205 |
end ;
|
206 |
|
207 |
procedure TFSeqAliT.CBSeqAliChange (Sender : TObject) ;
|
208 |
begin
|
209 |
if (IdxSeqAliT <> -1) and (CBSeqAli.Text <> PSeqAliT.Nom) |
210 |
then
|
211 |
if Modified then Save ; |
212 |
IdxSeqAliT := FindIdxSeqAliT (CBSeqAli.Text) ; |
213 |
if IdxSeqAliT = -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 |
TC.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 |
TC.Visible := TRUE ; |
232 |
PSeqAliT := ListSeqAliT[IdxSeqAliT] ; |
233 |
with PSeqAliT^ do |
234 |
CBSeqAli.Hint := Memo ; |
235 |
TCChange (nil) ;
|
236 |
end ;
|
237 |
end ;
|
238 |
|
239 |
procedure TFSeqAliT.SBAddSeqAliClick (Sender : TObject) ;
|
240 |
var
|
241 |
i, n, q : integer ; |
242 |
s : string ;
|
243 |
ok : boolean ; |
244 |
PBackup : PRecSeqAliT ; |
245 |
begin
|
246 |
if Modified then Save ; |
247 |
if IdxSeqAliT = -1 |
248 |
then
|
249 |
q := mrNo |
250 |
else
|
251 |
q := MessageDlg (MsgCopy, mtConfirmation, [mbYes, mbNo], 0) ;
|
252 |
// Saisie du nouveau nom
|
253 |
s := '' ;
|
254 |
repeat
|
255 |
if InputQuery (FSeqAliT.Caption, MsgName, s)
|
256 |
then // V?rification du nom |
257 |
begin
|
258 |
s := Trim (s) ; // Suppression des espaces au d?but et ? la fin
|
259 |
if s = '' |
260 |
then // Pas de nom |
261 |
begin
|
262 |
ok := FALSE ; |
263 |
MessageDlg (MsgNameEmpty, mtWarning, [mbOk], 0) ;
|
264 |
end
|
265 |
else
|
266 |
if Length (s) > 25 |
267 |
then // Nom trop long |
268 |
begin
|
269 |
ok := FALSE ; |
270 |
MessageDlg (Format (MsgNameTooLarge, [25]), mtWarning, [mbOk], 0) ; |
271 |
s := Copy (s, 1, 25) ; |
272 |
end
|
273 |
else
|
274 |
begin
|
275 |
ok := TRUE ; |
276 |
i := 0 ;
|
277 |
while ok and (i < ListSeqAliT.Count) do |
278 |
begin
|
279 |
PSeqAliT := ListSeqAliT[i] ; |
280 |
if PSeqAliT.Nom = s
|
281 |
then // Nom d?j? utilis? |
282 |
begin
|
283 |
ok := FALSE ; |
284 |
MessageDlg (MsgNameExists, mtWarning, [mbOk], 0) ;
|
285 |
end
|
286 |
else
|
287 |
Inc (i) ; |
288 |
end ;
|
289 |
end ;
|
290 |
end
|
291 |
else // Annulation |
292 |
begin
|
293 |
s := '' ;
|
294 |
if (IdxSeqAliT <> -1) |
295 |
then
|
296 |
PSeqAliT := ListSeqAliT[IdxSeqAliT] ; |
297 |
ok := TRUE ; |
298 |
end ;
|
299 |
until ok ;
|
300 |
if s <> '' |
301 |
then // Cr?ation du nouvel enregistrement |
302 |
begin
|
303 |
// Recherche du premier num?ro libre
|
304 |
n := 0 ;
|
305 |
repeat
|
306 |
Inc (n) ; |
307 |
ok := TRUE ; |
308 |
i := 0 ;
|
309 |
while ok and (i < ListSeqAliT.Count) do |
310 |
begin
|
311 |
PSeqAliT := ListSeqAliT[i] ; |
312 |
if PSeqAliT.Num = n
|
313 |
then
|
314 |
ok := FALSE |
315 |
else
|
316 |
Inc (i) ; |
317 |
end ;
|
318 |
until ok ;
|
319 |
New (PSeqAliT) ; |
320 |
with PSeqAliT^ do |
321 |
begin
|
322 |
Nom := s ; |
323 |
Num := n ; |
324 |
if q = mrYes
|
325 |
then
|
326 |
begin
|
327 |
PBackup := ListSeqAliT[IdxSeqAliT] ; |
328 |
Memo := PBackup.Memo ; |
329 |
NbRuleGest := PBackup.NbRuleGest ; |
330 |
RuleGest := PBackup.RuleGest ; |
331 |
NbRuleLact := PBackup.NbRuleLact ; |
332 |
RuleLact := PBackup.RuleLact ; |
333 |
NbRuleISSF := PBackup.NbRuleISSF ; |
334 |
RuleISSF := PBackup.RuleISSF ; |
335 |
end
|
336 |
else
|
337 |
begin
|
338 |
Memo := '' ;
|
339 |
NbRuleGest := 1 ;
|
340 |
for i := 1 to MAX_RULE do |
341 |
with RuleGest[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 |
NbRuleLact := 1 ;
|
351 |
for i := 1 to MAX_RULE do |
352 |
with RuleLact[i] do |
353 |
begin
|
354 |
ModeFin := -1 ;
|
355 |
ValFin := 0 ;
|
356 |
NumAli1 := -1 ;
|
357 |
NumAli2 := -1 ;
|
358 |
PctAli1Init := 100 ;
|
359 |
PctAli1Fin := 100 ;
|
360 |
end ;
|
361 |
NbRuleISSF := 1 ;
|
362 |
for i := 1 to MAX_RULE do |
363 |
with RuleISSF[i] do |
364 |
begin
|
365 |
ModeFin := -1 ;
|
366 |
ValFin := 0 ;
|
367 |
NumAli1 := -1 ;
|
368 |
NumAli2 := -1 ;
|
369 |
PctAli1Init := 100 ;
|
370 |
PctAli1Fin := 100 ;
|
371 |
end ;
|
372 |
end ;
|
373 |
end ;
|
374 |
ListSeqAliT.Add (PSeqAliT) ; |
375 |
CBSeqAli.Items.Add (PSeqAliT.Nom) ; |
376 |
CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (PSeqAliT.Nom) ; |
377 |
CBSeqAliChange (nil) ;
|
378 |
Modified := TRUE ; |
379 |
SBAddSeqAli.Enabled := IsComplete or (ListSeqAliT.Count < 5) ; |
380 |
SBCommentClick (nil) ;
|
381 |
end ;
|
382 |
end ;
|
383 |
|
384 |
procedure TFSeqAliT.SBDelSeqAliClick (Sender : TObject) ;
|
385 |
var
|
386 |
i, j : integer ; |
387 |
begin
|
388 |
if SeqAliTUsed (PSeqAliT.Num)
|
389 |
then // Enregistrement utilis? |
390 |
MessageDlg (MsgDelErr, mtWarning, [mbOk], 0)
|
391 |
else // Suppression de l'enregistrement |
392 |
if MessageDlg (MsgDel, mtConfirmation, [mbYes, mbNo], 0) = mrYes |
393 |
then
|
394 |
begin
|
395 |
// Mise ? jour du 30/11/2006
|
396 |
// Suppression des r?f?rences masqu?es dans des simulations
|
397 |
if ListSimulT.Count > 0 |
398 |
then
|
399 |
for i := 0 to ListSimulT.Count - 1 do |
400 |
begin
|
401 |
PSimulT := ListSimulT[i] ; |
402 |
for j := 1 to NB_CYCLES do |
403 |
if PSimulT.SeqAli[j] = PSeqAliT.Num
|
404 |
then
|
405 |
PSimulT.SeqAli[j] := -1 ;
|
406 |
end ;
|
407 |
SaveSimulT ; // Sauvegarde !
|
408 |
// Fin de mise ? jour
|
409 |
Dispose (PSeqAliT) ; |
410 |
ListSeqAliT.Delete (IdxSeqAliT) ; |
411 |
SaveSeqAliT ; // Sauvegarde !
|
412 |
Modified := FALSE ; |
413 |
CBSeqAli.DeleteSelected ; |
414 |
IdxSeqAliT := -1 ;
|
415 |
CBSeqAli.ItemIndex := -1 ;
|
416 |
CBSeqAliChange (nil) ;
|
417 |
SBAddSeqAli.Enabled := IsComplete or (ListSeqAliT.Count < 5) ; |
418 |
end ;
|
419 |
end ;
|
420 |
|
421 |
procedure TFSeqAliT.SBRenameClick (Sender : TObject) ;
|
422 |
var
|
423 |
i : integer ; |
424 |
s : string ;
|
425 |
ok : boolean ; |
426 |
begin
|
427 |
// Saisie du nouveau nom
|
428 |
s := CBSeqAli.Text ; |
429 |
repeat
|
430 |
if InputQuery (FSeqAliT.Caption, MsgRename, s) and (s <> CBSeqAli.Text) |
431 |
then // V?rification du nom |
432 |
begin
|
433 |
s := Trim (s) ; // Suppression des espaces au d?but et ? la fin
|
434 |
if s = '' |
435 |
then // Pas de nom |
436 |
begin
|
437 |
ok := FALSE ; |
438 |
MessageDlg (MsgNameEmpty, mtWarning, [mbOk], 0) ;
|
439 |
end
|
440 |
else
|
441 |
if Length (s) > 25 |
442 |
then // Nom trop long |
443 |
begin
|
444 |
ok := FALSE ; |
445 |
MessageDlg (Format (MsgNameTooLarge, [25]), mtWarning, [mbOk], 0) ; |
446 |
s := Copy (s, 1, 25) ; |
447 |
end
|
448 |
else
|
449 |
begin
|
450 |
ok := TRUE ; |
451 |
i := 0 ;
|
452 |
while ok and (i < ListSeqAliT.Count) do |
453 |
begin
|
454 |
PSeqAliT := ListSeqAliT[i] ; |
455 |
if PSeqAliT.Nom = s
|
456 |
then // Nom d?j? utilis? |
457 |
begin
|
458 |
ok := FALSE ; |
459 |
MessageDlg (MsgNameExists, mtWarning, [mbOk], 0) ;
|
460 |
end
|
461 |
else
|
462 |
Inc (i) ; |
463 |
end ;
|
464 |
end ;
|
465 |
end
|
466 |
else // Annulation |
467 |
begin
|
468 |
s := '' ;
|
469 |
ok := TRUE ; |
470 |
end ;
|
471 |
until ok ;
|
472 |
PSeqAliT := ListSeqAliT[IdxSeqAliT] ; |
473 |
if s <> '' |
474 |
then // Renommer l'enregistrement |
475 |
begin
|
476 |
PSeqAliT.Nom := s ; |
477 |
Modified := TRUE ; |
478 |
StringsSeqAliT (CBSeqAli.Items, TRUE) ; |
479 |
CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (s) ; |
480 |
end ;
|
481 |
end ;
|
482 |
|
483 |
procedure TFSeqAliT.SBCommentClick (Sender : TObject) ;
|
484 |
begin
|
485 |
// Saisie du commentaire
|
486 |
FComment := TFComment.Create (Self) ; |
487 |
with FComment do |
488 |
begin
|
489 |
Memo.Text := PSeqAliT.Memo ; |
490 |
if ShowModal = mrOk
|
491 |
then // Commenter l'enregistrement |
492 |
begin
|
493 |
PSeqAliT.Memo := Memo.Text ; |
494 |
Modified := TRUE ; |
495 |
CBSeqAli.Hint := PSeqAliT.Memo ; |
496 |
end ;
|
497 |
Release ; |
498 |
end ;
|
499 |
end ;
|
500 |
|
501 |
procedure TFSeqAliT.SBSaveClick(Sender: TObject);
|
502 |
begin
|
503 |
SaveSeqAliT ; |
504 |
if not SeqAliTValid (PSeqAliT) |
505 |
then
|
506 |
MessageDlg(Format (MsgInvalidData, [Caption, PSeqAliT.Nom]), mtWarning, [mbOK], 0) ;
|
507 |
Modified := FALSE ; |
508 |
end;
|
509 |
|
510 |
procedure TFSeqAliT.SBPrintClick(Sender: TObject);
|
511 |
begin
|
512 |
FRapSeqAliT := TFRapSeqAliT.Create (Self) ; |
513 |
FRapSeqAliT.QRRapport.PreviewModal ; |
514 |
FRapSeqAliT.Release ; |
515 |
end;
|
516 |
|
517 |
procedure TFSeqAliT.TCChange (Sender : TObject) ;
|
518 |
var
|
519 |
i : integer ; |
520 |
begin
|
521 |
case TC.TabIndex of |
522 |
0 : // Gestation |
523 |
with PSeqAliT^ do |
524 |
begin
|
525 |
NbRule := NbRuleGest ; |
526 |
for i := 1 to MAX_RULE do |
527 |
Rule[i] := RuleGest[i] ; |
528 |
end ;
|
529 |
1 : // Lactation |
530 |
with PSeqAliT^ do |
531 |
begin
|
532 |
NbRule := NbRuleLact ; |
533 |
for i := 1 to MAX_RULE do |
534 |
Rule[i] := RuleLact[i] ; |
535 |
end ;
|
536 |
2 : // I.S.S.F. |
537 |
with PSeqAliT^ do |
538 |
begin
|
539 |
NbRule := NbRuleISSF ; |
540 |
for i := 1 to MAX_RULE do |
541 |
Rule[i] := RuleISSF[i] ; |
542 |
end ;
|
543 |
end ;
|
544 |
LBRule.Clear ; |
545 |
with PSeqAliT^ do |
546 |
for i := 1 to NbRule do |
547 |
LBRule.Items.Add ('') ;
|
548 |
LBRule.ItemIndex := 0 ;
|
549 |
LBRuleClick (nil) ;
|
550 |
end ;
|
551 |
|
552 |
procedure TFSeqAliT.LBRuleClick (Sender : TObject) ;
|
553 |
begin
|
554 |
NumRule := LBRule.ItemIndex + 1 ;
|
555 |
if LBRule.Items.Count < MAX_RULE
|
556 |
then
|
557 |
SBAddRule.Enabled := TRUE |
558 |
else
|
559 |
SBAddRule.Enabled := FALSE ; |
560 |
if NumRule = NbRule
|
561 |
then // Fin |
562 |
SBDelRule.Enabled := FALSE |
563 |
else
|
564 |
SBDelRule.Enabled := TRUE ; |
565 |
GBEnd.Visible := SBDelRule.Enabled ; |
566 |
with Rule[NumRule] do |
567 |
begin
|
568 |
Update := TRUE ; |
569 |
PBValFin.AsInteger := ValFin ; |
570 |
if NumAli1 = -1 |
571 |
then
|
572 |
CBAli1.ItemIndex := -1
|
573 |
else
|
574 |
CBAli1.ItemIndex := CBAli1.Items.IndexOf (FindNomAliment (NumAli1)) ; |
575 |
if CBAli1.ItemIndex = -1 |
576 |
then
|
577 |
CBAli1.Hint := ''
|
578 |
else
|
579 |
begin
|
580 |
PAliment := ListAliment[FindIdxAliment (CBAli1.Text)] ; |
581 |
CBAli1.Hint := PAliment.Memo ; |
582 |
end ;
|
583 |
if NumAli2 = -1 |
584 |
then
|
585 |
begin
|
586 |
CBAli2.ItemIndex := -1 ;
|
587 |
if CBTwoAli.Checked
|
588 |
then
|
589 |
CBTwoAli.Checked := FALSE |
590 |
else
|
591 |
CBTwoAliClick (nil) ;
|
592 |
end
|
593 |
else // 2 aliments |
594 |
begin
|
595 |
CBAli2.ItemIndex := CBAli2.Items.IndexOf (FindNomAliment (NumAli2)) ; |
596 |
PBAli1Init.AsInteger := PctAli1Init ; |
597 |
if PctAli1Init = PctAli1Fin
|
598 |
then
|
599 |
if CBTransit.Checked
|
600 |
then
|
601 |
CBTransit.Checked := FALSE |
602 |
else
|
603 |
CBTransitClick (nil)
|
604 |
else // transition |
605 |
begin
|
606 |
PBAli1Fin.AsInteger := PctAli1Fin ; |
607 |
CBTransit.Checked := TRUE ; |
608 |
end ;
|
609 |
CBTwoAli.Checked := TRUE ; |
610 |
end ;
|
611 |
if CBAli2.ItemIndex = -1 |
612 |
then
|
613 |
CBAli2.Hint := ''
|
614 |
else
|
615 |
begin
|
616 |
PAliment := ListAliment[FindIdxAliment (CBAli2.Text)] ; |
617 |
CBAli1.Hint := PAliment.Memo ; |
618 |
end ;
|
619 |
Update := FALSE ; |
620 |
end ;
|
621 |
end ;
|
622 |
|
623 |
procedure TFSeqAliT.LBRuleDrawItem(Control: TWinControl; Index: Integer;
|
624 |
Rect: TRect; State: TOwnerDrawState); |
625 |
begin
|
626 |
with (Control as TListBox).Canvas do |
627 |
begin
|
628 |
// Cadre principal
|
629 |
FillRect(Rect); |
630 |
// Texte
|
631 |
SetTextAlign(Handle, TA_LEFT); |
632 |
Rect.Left := 22;
|
633 |
TextRect(Rect, Rect.Left, Rect.Top, StrModeFin(TC.TabIndex, Index + 1));
|
634 |
Rect.Left := 150;
|
635 |
TextRect(Rect, Rect.Left, Rect.Top, StrAliment(TC.TabIndex, Index + 1));
|
636 |
Rect.Left := 0;
|
637 |
// Num?ro
|
638 |
SetTextAlign(Handle, TA_RIGHT); |
639 |
Rect.Right := 14;
|
640 |
TextRect(Rect, Rect.Right, Rect.Top, Format('%d', [Index + 1])); |
641 |
end;
|
642 |
end;
|
643 |
|
644 |
procedure TFSeqAliT.SBAddRuleClick (Sender : TObject) ;
|
645 |
var
|
646 |
i : integer ; |
647 |
begin
|
648 |
for i := NbRule downto NumRule do |
649 |
Rule[i + 1] := Rule[i] ;
|
650 |
with Rule[NumRule] do |
651 |
begin
|
652 |
ModeFin := 0 ;
|
653 |
ValFin := 0 ;
|
654 |
end ;
|
655 |
Inc (NbRule) ; |
656 |
case TC.TabIndex of |
657 |
0 : // Gestation |
658 |
with PSeqAliT^ do |
659 |
begin
|
660 |
NbRuleGest := NbRule ; |
661 |
for i := 1 to MAX_RULE do |
662 |
RuleGest[i] := Rule[i] ; |
663 |
end ;
|
664 |
1 : // Lactation |
665 |
with PSeqAliT^ do |
666 |
begin
|
667 |
NbRuleLact := NbRule ; |
668 |
for i := 1 to MAX_RULE do |
669 |
RuleLact[i] := Rule[i] ; |
670 |
end ;
|
671 |
2 : // I.S.S.F. |
672 |
with PSeqAliT^ do |
673 |
begin
|
674 |
NbRuleISSF := NbRule ; |
675 |
for i := 1 to MAX_RULE do |
676 |
RuleISSF[i] := Rule[i] ; |
677 |
end ;
|
678 |
end ;
|
679 |
LBRule.Items.Add ('') ;
|
680 |
LBRule.ItemIndex := NumRule - 1 ;
|
681 |
LBRuleClick (nil) ;
|
682 |
Modified := TRUE ; |
683 |
ActiveControl := PBValFin ; |
684 |
end ;
|
685 |
|
686 |
procedure TFSeqAliT.SBDelRuleClick (Sender : TObject) ;
|
687 |
var
|
688 |
i : integer ; |
689 |
begin
|
690 |
Dec (NbRule) ; |
691 |
for i := NumRule to NbRule do |
692 |
Rule[i] := Rule[i + 1] ;
|
693 |
case TC.TabIndex of |
694 |
0 : // Gestation |
695 |
with PSeqAliT^ do |
696 |
begin
|
697 |
NbRuleGest := NbRule ; |
698 |
for i := 1 to MAX_RULE do |
699 |
RuleGest[i] := Rule[i] ; |
700 |
end ;
|
701 |
1 : // Lactation |
702 |
with PSeqAliT^ do |
703 |
begin
|
704 |
NbRuleLact := NbRule ; |
705 |
for i := 1 to MAX_RULE do |
706 |
RuleLact[i] := Rule[i] ; |
707 |
end ;
|
708 |
2 : // I.S.S.F. |
709 |
with PSeqAliT^ do |
710 |
begin
|
711 |
NbRuleISSF := NbRule ; |
712 |
for i := 1 to MAX_RULE do |
713 |
RuleISSF[i] := Rule[i] ; |
714 |
end ;
|
715 |
end ;
|
716 |
i := NumRule ; // Position courante
|
717 |
LBRule.DeleteSelected ; |
718 |
LBRule.ItemIndex := i - 1 ;
|
719 |
LBRuleClick (nil) ;
|
720 |
ActiveControl := LBRule ; |
721 |
Modified := TRUE ; |
722 |
end ;
|
723 |
|
724 |
procedure TFSeqAliT.PBValFinChange (Sender : TObject) ;
|
725 |
begin
|
726 |
if not Update |
727 |
then
|
728 |
begin
|
729 |
Modified := TRUE ; |
730 |
Rule[NumRule].ValFin := PBValFin.AsInteger ; |
731 |
case TC.TabIndex of |
732 |
0 : // Gestation |
733 |
with PSeqAliT^ do |
734 |
begin
|
735 |
NbRuleGest := NbRule ; |
736 |
RuleGest[NumRule] := Rule[NumRule] ; |
737 |
end ;
|
738 |
1 : // Lactation |
739 |
with PSeqAliT^ do |
740 |
begin
|
741 |
NbRuleLact := NbRule ; |
742 |
RuleLact[NumRule] := Rule[NumRule] ; |
743 |
end ;
|
744 |
2 : // I.S.S.F. |
745 |
with PSeqAliT^ do |
746 |
begin
|
747 |
NbRuleISSF := NbRule ; |
748 |
RuleISSF[NumRule] := Rule[NumRule] ; |
749 |
end ;
|
750 |
end ;
|
751 |
LBRule.Repaint ; |
752 |
end ;
|
753 |
end ;
|
754 |
|
755 |
procedure TFSeqAliT.CBTwoAliClick (Sender : TObject) ;
|
756 |
begin
|
757 |
if CBTwoAli.Checked
|
758 |
then
|
759 |
begin
|
760 |
if CBAli1.ItemIndex = -1 |
761 |
then
|
762 |
CBAli2.Enabled := FALSE |
763 |
else
|
764 |
CBAli2.Enabled := TRUE ; |
765 |
PInit.Visible := TRUE ; |
766 |
CBTransit.Visible := TRUE |
767 |
end
|
768 |
else
|
769 |
begin
|
770 |
if CBAli2.Text <> '' |
771 |
then
|
772 |
begin
|
773 |
Modified := TRUE ; |
774 |
CBAli2.ItemIndex := -1 ;
|
775 |
Rule[NumRule].NumAli2 := -1 ;
|
776 |
case TC.TabIndex of |
777 |
0 : // Gestation |
778 |
with PSeqAliT^ do |
779 |
begin
|
780 |
NbRuleGest := NbRule ; |
781 |
RuleGest[NumRule] := Rule[NumRule] ; |
782 |
end ;
|
783 |
1 : // Lactation |
784 |
with PSeqAliT^ do |
785 |
begin
|
786 |
NbRuleLact := NbRule ; |
787 |
RuleLact[NumRule] := Rule[NumRule] ; |
788 |
end ;
|
789 |
2 : // I.S.S.F. |
790 |
with PSeqAliT^ do |
791 |
begin
|
792 |
NbRuleISSF := NbRule ; |
793 |
RuleISSF[NumRule] := Rule[NumRule] ; |
794 |
end ;
|
795 |
end ;
|
796 |
end ;
|
797 |
CBAli2.Enabled := FALSE ; |
798 |
PInit.Visible := FALSE ; |
799 |
CBTransit.Visible := FALSE ; |
800 |
PBAli1Init.AsInteger := 100 ;
|
801 |
if CBTransit.Checked
|
802 |
then
|
803 |
CBTransit.Checked := FALSE |
804 |
else
|
805 |
CBTransitClick (nil) ;
|
806 |
end ;
|
807 |
LBRule.Repaint ; |
808 |
end ;
|
809 |
|
810 |
procedure TFSeqAliT.CBTransitClick (Sender : TObject) ;
|
811 |
begin
|
812 |
if CBTransit.Checked
|
813 |
then
|
814 |
begin
|
815 |
PFin.Visible := TRUE ; |
816 |
LInit.Visible := TRUE ; |
817 |
end
|
818 |
else
|
819 |
begin
|
820 |
PFin.Visible := FALSE ; |
821 |
LInit.Visible := FALSE ; |
822 |
PBAli1Fin.AsInteger := PBAli1Init.AsInteger ; |
823 |
end ;
|
824 |
LBRule.Repaint ; |
825 |
end ;
|
826 |
|
827 |
procedure TFSeqAliT.CBAli1Change (Sender : TObject) ;
|
828 |
begin
|
829 |
if CBAli1.ItemIndex > -1 |
830 |
then
|
831 |
CBAli2.Enabled := CBTwoAli.Checked ; |
832 |
if not Update and (CBAli1.Text <> '') |
833 |
then
|
834 |
begin
|
835 |
Modified := TRUE ; |
836 |
Rule[NumRule].NumAli1 := FindNumAliment (CBAli1.Text) ; |
837 |
case TC.TabIndex of |
838 |
0 : // Gestation |
839 |
with PSeqAliT^ do |
840 |
begin
|
841 |
NbRuleGest := NbRule ; |
842 |
RuleGest[NumRule] := Rule[NumRule] ; |
843 |
end ;
|
844 |
1 : // Lactation |
845 |
with PSeqAliT^ do |
846 |
begin
|
847 |
NbRuleLact := NbRule ; |
848 |
RuleLact[NumRule] := Rule[NumRule] ; |
849 |
end ;
|
850 |
2 : // I.S.S.F. |
851 |
with PSeqAliT^ do |
852 |
begin
|
853 |
NbRuleISSF := NbRule ; |
854 |
RuleISSF[NumRule] := Rule[NumRule] ; |
855 |
end ;
|
856 |
end ;
|
857 |
LBRule.Repaint ; |
858 |
end ;
|
859 |
end ;
|
860 |
|
861 |
procedure TFSeqAliT.CBAli2Change (Sender : TObject) ;
|
862 |
begin
|
863 |
if not Update and (CBAli2.Text <> '') |
864 |
then
|
865 |
begin
|
866 |
Modified := TRUE ; |
867 |
Rule[NumRule].NumAli2 := FindNumAliment (CBAli2.Text) ; |
868 |
case TC.TabIndex of |
869 |
0 : // Gestation |
870 |
with PSeqAliT^ do |
871 |
begin
|
872 |
NbRuleGest := NbRule ; |
873 |
RuleGest[NumRule] := Rule[NumRule] ; |
874 |
end ;
|
875 |
1 : // Lactation |
876 |
with PSeqAliT^ do |
877 |
begin
|
878 |
NbRuleLact := NbRule ; |
879 |
RuleLact[NumRule] := Rule[NumRule] ; |
880 |
end ;
|
881 |
2 : // I.S.S.F. |
882 |
with PSeqAliT^ do |
883 |
begin
|
884 |
NbRuleISSF := NbRule ; |
885 |
RuleISSF[NumRule] := Rule[NumRule] ; |
886 |
end ;
|
887 |
end ;
|
888 |
LBRule.Repaint ; |
889 |
end ;
|
890 |
end ;
|
891 |
|
892 |
procedure TFSeqAliT.PBAli1InitChange (Sender : TObject) ;
|
893 |
begin
|
894 |
PBAli2Init.AsInteger := 100 - PBAli1Init.AsInteger ;
|
895 |
if not Update |
896 |
then
|
897 |
begin
|
898 |
Modified := TRUE ; |
899 |
Rule[NumRule].PctAli1Init := PBAli1Init.AsInteger ; |
900 |
if not CBTransit.Checked |
901 |
then // Pas de transition |
902 |
PBAli1Fin.AsInteger := PBAli1Init.AsInteger ; |
903 |
case TC.TabIndex of |
904 |
0 : // Gestation |
905 |
with PSeqAliT^ do |
906 |
begin
|
907 |
NbRuleGest := NbRule ; |
908 |
RuleGest[NumRule] := Rule[NumRule] ; |
909 |
end ;
|
910 |
1 : // Lactation |
911 |
with PSeqAliT^ do |
912 |
begin
|
913 |
NbRuleLact := NbRule ; |
914 |
RuleLact[NumRule] := Rule[NumRule] ; |
915 |
end ;
|
916 |
2 : // I.S.S.F. |
917 |
with PSeqAliT^ do |
918 |
begin
|
919 |
NbRuleISSF := NbRule ; |
920 |
RuleISSF[NumRule] := Rule[NumRule] ; |
921 |
end ;
|
922 |
end ;
|
923 |
LBRule.Repaint ; |
924 |
end ;
|
925 |
end ;
|
926 |
|
927 |
procedure TFSeqAliT.PBAli1FinChange (Sender : TObject) ;
|
928 |
begin
|
929 |
PBAli2Fin.AsInteger := 100 - PBAli1Fin.AsInteger ;
|
930 |
if not Update |
931 |
then
|
932 |
begin
|
933 |
Modified := TRUE ; |
934 |
Rule[NumRule].PctAli1Fin := PBAli1Fin.AsInteger ; |
935 |
case TC.TabIndex of |
936 |
0 : // Gestation |
937 |
with PSeqAliT^ do |
938 |
begin
|
939 |
NbRuleGest := NbRule ; |
940 |
RuleGest[NumRule] := Rule[NumRule] ; |
941 |
end ;
|
942 |
1 : // Lactation |
943 |
with PSeqAliT^ do |
944 |
begin
|
945 |
NbRuleLact := NbRule ; |
946 |
RuleLact[NumRule] := Rule[NumRule] ; |
947 |
end ;
|
948 |
2 : // I.S.S.F. |
949 |
with PSeqAliT^ do |
950 |
begin
|
951 |
NbRuleISSF := NbRule ; |
952 |
RuleISSF[NumRule] := Rule[NumRule] ; |
953 |
end ;
|
954 |
end ;
|
955 |
LBRule.Repaint ; |
956 |
end ;
|
957 |
end ;
|
958 |
|
959 |
function TFSeqAliT.StrModeFin (etat, regle : integer) : string ; |
960 |
var
|
961 |
Nb : integer ; |
962 |
Rec : RecRuleSeqAliT ; |
963 |
begin
|
964 |
case etat of |
965 |
0 : // Gestation |
966 |
Nb := PSeqAliT.NbRuleGest ; |
967 |
1 : // Lactation |
968 |
Nb := PSeqAliT.NbRuleLact ; |
969 |
else // I.S.S.F. |
970 |
Nb := PSeqAliT.NbRuleISSF ; |
971 |
end ;
|
972 |
if regle = Nb
|
973 |
then // Fin |
974 |
case etat of |
975 |
0 : // Gestation |
976 |
result := StrMiseBas ; |
977 |
1 : // Lactation |
978 |
result := StrSevrage ; |
979 |
2 : // I.S.S.F. |
980 |
result := StrSaillie ; |
981 |
end
|
982 |
else
|
983 |
begin
|
984 |
case etat of |
985 |
0 : // Gestation |
986 |
Rec := PSeqAliT.RuleGest[regle] ; |
987 |
1 : // Lactation |
988 |
Rec := PSeqAliT.RuleLact[regle] ; |
989 |
2 : // I.S.S.F. |
990 |
Rec := PSeqAliT.RuleISSF[regle] ; |
991 |
end ;
|
992 |
with Rec do |
993 |
case ModeFin of |
994 |
0 : // Dur?e |
995 |
result := Format ('%s = %d %s', [CBModeFin.Items[ModeFin], ValFin, StrJ]) ;
|
996 |
else
|
997 |
result := '' ;
|
998 |
end ;
|
999 |
end ;
|
1000 |
end ;
|
1001 |
|
1002 |
function TFSeqAliT.StrAliment (etat, regle : integer) : string ; |
1003 |
var
|
1004 |
Rec : RecRuleSeqAliT ; |
1005 |
begin
|
1006 |
case etat of |
1007 |
0 : // Gestation |
1008 |
Rec := PSeqAliT.RuleGest[regle] ; |
1009 |
1 : // Lactation |
1010 |
Rec := PSeqAliT.RuleLact[regle] ; |
1011 |
2 : // I.S.S.F. |
1012 |
Rec := PSeqAliT.RuleISSF[regle] ; |
1013 |
end ;
|
1014 |
with Rec do |
1015 |
if NumAli1 = -1 |
1016 |
then
|
1017 |
result := ''
|
1018 |
else
|
1019 |
if NumAli2 = -1 |
1020 |
then // 1 aliment |
1021 |
result := FindNomAliment (NumAli1) |
1022 |
else // 2 aliments |
1023 |
if PctAli1Init = PctAli1Fin
|
1024 |
then
|
1025 |
result := Format ('%s (%d %%) - %s (%d %%)', [FindNomAliment (NumAli1), PctAli1Init, FindNomAliment (NumAli2), 100 - PctAli1Init]) |
1026 |
else // Transition |
1027 |
result := Format ('%s : %s (%d-%d %%) - %s (%d-%d %%)', [_('Transition'), FindNomAliment (NumAli1), PctAli1Init, PctAli1Fin, FindNomAliment (NumAli2), 100 - PctAli1Init, 100 - PctAli1Fin]) ; |
1028 |
end ;
|
1029 |
|
1030 |
end.
|