Statistiques
| Révision:

root / UFBesGestT.pas @ 5

Historique | Voir | Annoter | Télécharger (41,192 ko)

1
unit UFBesGestT ;
2

    
3
interface
4

    
5
uses
6
  Windows, Forms, Classes, Controls, StdCtrls, ComCtrls, PBNumEdit, PBSuperSpin,
7
  Buttons, ExtCtrls, UVariables;
8

    
9
type
10
  TFBesGestT = class(TForm)
11
    GBProfil: TGroupBox;
12
    GBResult: TGroupBox;
13
    GBLoge: TGroupBox;
14
    CBProfil: TComboBox;
15
    CBLoge: TComboBox;
16
    GBComport: TGroupBox;
17
    LDebout: TLabel;
18
    LCalme: TLabel;
19
    LMoyenne: TLabel;
20
    LActive: TLabel;
21
    TBAct: TTrackBar;
22
    GBParam: TGroupBox;
23
    LTyp: TLabel;
24
    LSol: TLabel;
25
    LTemp: TLabel;
26
    CBTyp: TComboBox;
27
    CBSol: TComboBox;
28
    PBTemp: TPBSuperSpin;
29
    GBSaillie: TGroupBox;
30
    GBMiseBas: TGroupBox;
31
    LAgeSail: TLabel;
32
    LPdsSail: TLabel;
33
    LP2Sail: TLabel;
34
    PBAgeSail: TPBNumEdit;
35
    PBPdsSail: TPBNumEdit;
36
    PBP2Sail: TPBNumEdit;
37
    ChkAgeSail: TCheckBox;
38
    ChkPdsSail: TCheckBox;
39
    ChkP2Sail: TCheckBox;
40
    LP2MB: TLabel;
41
    PBPdsApMB: TPBNumEdit;
42
    PBP2MB: TPBNumEdit;
43
    LPdsApMB: TLabel;
44
    ChkPdsApMB: TCheckBox;
45
    ChkP2MB: TCheckBox;
46
    LNesTotaux: TLabel;
47
    PBNesTotaux: TPBNumEdit;
48
    LPdsNais: TLabel;
49
    PBPdsNais: TPBNumEdit;
50
    ChkNesTotaux: TCheckBox;
51
    ChkPdsNais: TCheckBox;
52
    GBAliment: TGroupBox;
53
    LRation: TLabel;
54
    LSeqAli: TLabel;
55
    CBRation: TComboBox;
56
    CBSeqAli: TComboBox;
57
    LAppAli: TLabel;
58
    LEMAli: TLabel;
59
    PBAppAli: TPBNumEdit;
60
    PBEMAli: TPBNumEdit;
61
    LPortee: TLabel;
62
    PBPortee: TPBSuperSpin;
63
    LRegle: TLabel;
64
    PBRegle: TPBSuperSpin;
65
    ChkLoge: TCheckBox;
66
    ChkSeqAli: TCheckBox;
67
    ChkRation: TCheckBox;
68
    ChkAppAli: TCheckBox;
69
    ChkEMAli: TCheckBox;
70
    PAct: TPanel;
71
    PRegle: TPanel;
72
    PBAct: TPBNumEdit;
73
    PBAliment: TPBNumEdit;
74
    PBEM: TPBNumEdit;
75
    PBEN: TPBNumEdit;
76
    PBdLys: TPBNumEdit;
77
    LAliment: TLabel;
78
    LEM: TLabel;
79
    LEN: TLabel;
80
    LdLys: TLabel;
81
    LBesoins: TLabel;
82
    BBRapGest: TBitBtn;
83
    BBResGest: TBitBtn;
84
    CBRationProfil: TComboBox;
85
    LNbRegles: TLabel;
86
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
87
    procedure FormActivate(Sender: TObject);
88
    procedure CBProfilChange(Sender: TObject);
89
    procedure PBAgeSailChange(Sender: TObject);
90
    procedure ChkAgeSailClick(Sender: TObject);
91
    procedure PBPdsSailChange(Sender: TObject);
92
    procedure ChkPdsSailClick(Sender: TObject);
93
    procedure PBP2SailChange(Sender: TObject);
94
    procedure ChkP2SailClick(Sender: TObject);
95
    procedure PBPdsApMBChange(Sender: TObject);
96
    procedure ChkPdsApMBClick(Sender: TObject);
97
    procedure PBP2MBChange(Sender: TObject);
98
    procedure ChkP2MBClick(Sender: TObject);
99
    procedure PBNesTotauxChange(Sender: TObject);
100
    procedure ChkNesTotauxClick(Sender: TObject);
101
    procedure PBPdsNaisChange(Sender: TObject);
102
    procedure ChkPdsNaisClick(Sender: TObject);
103
    procedure CBLogeChange(Sender: TObject);
104
    procedure CBTypChange(Sender: TObject);
105
    procedure CBSolChange(Sender: TObject);
106
    procedure PBTempChange(Sender: TObject);
107
    procedure TBActChange(Sender: TObject);
108
    procedure CBSeqAliChange(Sender: TObject);
109
    procedure CBRationChange(Sender: TObject);
110
    procedure PBPorteeChange(Sender: TObject);
111
    procedure ChkSeqAliClick(Sender: TObject);
112
    procedure ChkRationClick(Sender: TObject);
113
    procedure ChkLogeClick(Sender: TObject);
114
    procedure PBRegleChange(Sender: TObject);
115
    procedure ChkAppAliClick(Sender: TObject);
116
    procedure PBAppAliChange(Sender: TObject);
117
    procedure PBEMAliChange(Sender: TObject);
118
    procedure ChkEMAliClick(Sender: TObject);
119
    procedure BBResGestClick(Sender: TObject);
120
    procedure BBRapGestClick(Sender: TObject);
121
    procedure FormShow(Sender: TObject);
122
    procedure FormCreate(Sender: TObject);
123
  private
124
    { D?clarations priv?es }
125
    Update, Modal: boolean;
126
    cycle, regle: integer;
127
//    pmax, a, b: double;
128
    procedure CalcApport;
129
    procedure CalcResult;
130
    procedure AjustEnabled;
131
  public
132
    { D?clarations publiques }
133
    AppAliTot, AppEDTot, AppEMTot, AppENTot: double;
134
    BesEMTot, BesEMEntTot, BesEMActTot, BesEMTheTot, BesEMPortTot, BesEMResTot: double;
135
    AppAli, AppED, AppEM, AppEN: array [1..DureeGest] of double;
136
    BesEMEnt, BesEMAct, BesEMThe, BesEMPort, BesP, BesCa: array [1..DureeGest] of double;
137
    AppAA, BesAA, BesAAEnt, BesAAPort, BesAARes: array[1..14, 1..DureeGest] of double;
138
  end;
139

    
140
var
141
  FBesGestT: TFBesGestT;
142

    
143
implementation
144

    
145
uses
146
  Math, SysUtils, gnugettext, UStrings, UInit, UFindRec, UCalcul, UFResBesGestT,
147
  UFRapBesGestT;
148

    
149
{$R *.dfm}
150

    
151
{ TFBesGestT }
152

    
153
procedure TFBesGestT.FormCreate(Sender: TObject);
154
begin
155
  if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1
156
  then
157
    Font.Name := 'Arial Unicode MS';
158
  TranslateComponent(Self);
159
  Constraints.MinWidth := 624 + (Width - ClientWidth);
160
  Width := Constraints.MinWidth;
161
  Constraints.MaxWidth := Constraints.MinWidth;
162
  Constraints.MinHeight := 464 + (Height - ClientHeight);
163
  Height := Constraints.MinHeight;
164
  Constraints.MaxHeight := Constraints.MinHeight;
165
  CBRationProfil.ItemIndex := 0;
166
  LTemp.Caption := Format('%s (%s)', [LTemp.Caption, StrDegC]);
167
end;
168

    
169
procedure TFBesGestT.FormShow(Sender: TObject);
170
begin
171
  Modal := False;
172
  Update := TRUE;
173
  PBTemp.AsInteger := 20;
174
  Update := FALSE;
175
end;
176

    
177
procedure TFBesGestT.FormClose(Sender: TObject; var Action: TCloseAction);
178
begin
179
  Action := caFree;
180
  NumWinBesGestT := -1;
181
end;
182

    
183
procedure TFBesGestT.FormActivate(Sender: TObject);
184
var
185
  i: integer;
186
begin
187
  if not Modal
188
  then
189
  begin
190
    StringsProfilT(CBProfil.Items, False);
191
    CBLoge.Clear;
192
    CBLoge.Items.Add(StrSaisieManuelle);
193
    if ListLogeT.Count > 0
194
    then
195
      for i := 0 to ListLogeT.Count - 1 do
196
      begin
197
        PLogeT := ListLogeT[i];
198
        if LogeTValid(PLogeT)
199
        then
200
          CBLoge.Items.Add(PLogeT.Nom);
201
      end;
202
    CBLoge.ItemIndex := 0;
203
    CBLogeChange(nil);
204
    StringsSeqAliT(CBSeqAli.Items, False);
205
    StringsRationT(CBRation.Items, False);
206
    CBProfilChange(nil);
207
  end;
208
end;
209

    
210
procedure TFBesGestT.CBProfilChange(Sender: TObject);
211
{
212
const
213
  DELTA = 0.3 ;
214
  SEUIL = 0.001 ;
215
  MAX_TOURS = 1000 ;
216
var
217
  i, j, tour, mini : integer ;
218
  delta_pmax, delta_a, delta_b : double ;
219
  tab_pmax, tab_a, tab_b, tab_ecart : array[0..NB_CYCLES] of double ;
220
  ok : boolean ;
221
}
222
begin
223
  if CBProfil.ItemIndex = -1
224
  then
225
  begin
226
    CBProfil.Hint := '' ;
227
    Update := TRUE ;
228
    ChkAgeSail.Checked := FALSE ;
229
    ChkPdsSail.Checked := FALSE ;
230
    ChkP2Sail.Checked := FALSE ;
231
    ChkPdsApMB.Checked := FALSE ;
232
    ChkP2MB.Checked := FALSE ;
233
    ChkNesTotaux.Checked := FALSE ;
234
    ChkPdsNais.Checked := FALSE ;
235
    ChkLoge.Checked := FALSE ;
236
    ChkSeqAli.Checked := FALSE ;
237
    ChkRation.Checked := FALSE ;
238
    ChkAppAli.Checked := FALSE ;
239
    ChkEMAli.Checked := FALSE ;
240
    CalcApport ; // L'apport est recalcul? avec des teneurs standards
241
    CalcResult ;
242
    Update := FALSE ;
243
  end
244
  else
245
  begin
246
    PProfilT := ListProfilT[FindIdxProfilT (CBProfil.Text)] ;
247
    CBProfil.Hint := PProfilT.Memo ;
248
{
249
    // Recherche des param?tres pour la courbe de poids apr?s mise-bas
250
    tab_pmax[0] := 0 ;
251
    for i := 1 to NB_CYCLES do
252
      with PProfilT.Truies[i] do
253
        if PdsApMB > tab_pmax[0]
254
        then
255
          tab_pmax[0] := PdsApMB ;
256
    tab_a[0] := 1.5 ;
257
    tab_b[0] := 1.1 ;
258
    delta_pmax := tab_pmax[0] * DELTA ;
259
    delta_a := tab_a[0] * DELTA ;
260
    delta_b := tab_b[0] * DELTA ;
261
    tour := 0 ;
262
    repeat
263
      // ?value les points
264
      for i := 1 to NB_CYCLES do
265
        tab_pmax[i] := tab_pmax[0] + Power (-1, i) * delta_pmax ;
266
      for i := 1 to NB_CYCLES do
267
        tab_a[i] := tab_a[0] + Power (-1, i) * delta_a ;
268
      for i := 1 to NB_CYCLES do
269
        tab_b[i] := tab_b[0] + Power (-1, (i + 1) div 2) * delta_b ;
270
      for j := 0 to NB_CYCLES do
271
      begin
272
        tab_ecart[j] := 0 ;
273
        for i := 1 to NB_CYCLES do
274
          with PProfilT.Truies[i] do
275
            tab_ecart[j] := tab_ecart[j] + Power (tab_pmax[j] * (1 - Exp ((- tab_a[j] / 1000) * Power (AgeSail + 114, tab_b[j]))) - PdsApMB, 2) ;
276
      end ;
277
      // recherche le meilleur point
278
      mini := 0 ;
279
      for i := 1 to NB_CYCLES do
280
        if tab_ecart[i] < tab_ecart[mini]
281
        then
282
          mini := i ;
283
      // d?termine le point central
284
      if mini = 0
285
      then
286
      begin
287
        delta_pmax := delta_pmax * 0.8 ;
288
        delta_a := delta_a * 0.8 ;
289
        delta_b := delta_b * 0.8 ;
290
      end
291
      else
292
      begin
293
        tab_pmax[0] := tab_pmax[mini] ;
294
        tab_a[0] := tab_a[mini] ;
295
        tab_b[0] := tab_b[mini] ;
296
      end ;
297
     // ?value si les crit?res de sortie sont satisfaits
298
      ok := (delta_pmax < Abs (tab_pmax [mini] * SEUIL))
299
        and (delta_a < Abs (tab_a [mini] * SEUIL))
300
        and (delta_b < Abs (tab_b [mini] * SEUIL)) ;
301
      Inc (tour) ;
302
    until ok or (tour > MAX_TOURS) ;
303
    if ok
304
    then
305
    begin
306
      pmax := tab_pmax[0] ;
307
      a := tab_a[0] ;
308
      b := tab_b[0] ;
309
    end ;
310
}
311
    // Remplissage des champs avec les valeurs du profil
312
    Update := TRUE ;
313
    if ChkAgeSail.Checked
314
    then
315
      ChkAgeSailClick (nil)
316
    else
317
      ChkAgeSail.Checked := TRUE ;
318
    if ChkPdsSail.Checked
319
    then
320
      ChkPdsSailClick (nil)
321
    else
322
      ChkPdsSail.Checked := TRUE ;
323
    if ChkP2Sail.Checked
324
    then
325
      ChkP2SailClick (nil)
326
    else
327
      ChkP2Sail.Checked := TRUE ;
328
    if ChkPdsApMB.Checked
329
    then
330
      ChkPdsApMBClick (nil)
331
    else
332
      ChkPdsApMB.Checked := TRUE ;
333
    if ChkP2MB.Checked
334
    then
335
      ChkP2MBClick (nil)
336
    else
337
      ChkP2MB.Checked := TRUE ;
338
    if ChkNesTotaux.Checked
339
    then
340
      ChkNesTotauxClick (nil)
341
    else
342
      ChkNesTotaux.Checked := TRUE ;
343
    if ChkPdsNais.Checked
344
    then
345
      ChkPdsNaisClick (nil)
346
    else
347
      ChkPdsNais.Checked := TRUE ;
348
    if ChkLoge.Checked
349
    then
350
      ChkLogeClick (nil)
351
    else
352
      ChkLoge.Checked := TRUE ;
353
    regle := 1 ;
354
    if PBRegle.AsInteger = regle
355
    then
356
      PBRegleChange (nil)
357
    else
358
      PBRegle.AsInteger := regle ;
359
    PBRegle.MaxValue := PLogeT.NbRuleGest ;
360
    LNbRegles.Caption := Format ('/ %d', [PLogeT.NbRuleGest]) ;
361
    // Remplissage des champs avec les valeurs du logement
362
    CBTyp.ItemIndex := PLogeT.RuleGest[regle].Typ ;
363
    if CBTyp.ItemIndex = 2
364
    then // Plein-air
365
    begin
366
      CBSol.ItemIndex := -1 ;
367
      CBSol.Enabled := FALSE ;
368
    end
369
    else
370
      CBSol.ItemIndex := PLogeT.RuleGest[regle].Sol ;
371
    PBTemp.AsInteger := PLogeT.RuleGest[regle].Temp ;
372
    TBAct.Position := PLogeT.RuleGest[regle].Act ;
373
    if ChkSeqAli.Checked
374
    then
375
      ChkSeqAliClick (nil)
376
    else
377
      ChkSeqAli.Checked := TRUE ;
378
    if ChkRation.Checked
379
    then
380
      ChkRationClick (nil)
381
    else
382
      ChkRation.Checked := TRUE ;
383
    ChkAppAli.Checked := TRUE ;
384
    ChkEMAli.Checked := TRUE ;
385
    CalcApport ;
386
    ChkAppAliClick (nil) ;
387
    ChkEMAliClick (nil) ;
388
    CalcResult ;
389
    Update := FALSE ;
390
  end ;
391
  AjustEnabled ;
392
end;
393

    
394
procedure TFBesGestT.PBPorteeChange(Sender: TObject);
395
begin
396
  cycle := PBPortee.AsInteger ;
397
  if CBProfil.ItemIndex <> -1
398
  then
399
  begin
400
    // Remplissage des champs avec les valeurs du profil
401
    Update := TRUE ;
402
    if ChkAgeSail.Checked
403
    then
404
      ChkAgeSailClick (nil)
405
    else
406
      ChkAgeSail.Checked := TRUE ;
407
    if ChkPdsSail.Checked
408
    then
409
      ChkPdsSailClick (nil)
410
    else
411
      ChkPdsSail.Checked := TRUE ;
412
    if ChkP2Sail.Checked
413
    then
414
      ChkP2SailClick (nil)
415
    else
416
      ChkP2Sail.Checked := TRUE ;
417
    if ChkPdsApMB.Checked
418
    then
419
      ChkPdsApMBClick (nil)
420
    else
421
      ChkPdsApMB.Checked := TRUE ;
422
    if ChkP2MB.Checked
423
    then
424
      ChkP2MBClick (nil)
425
    else
426
      ChkP2MB.Checked := TRUE ;
427
    if ChkNesTotaux.Checked
428
    then
429
      ChkNesTotauxClick (nil)
430
    else
431
      ChkNesTotaux.Checked := TRUE ;
432
    if ChkPdsNais.Checked
433
    then
434
      ChkPdsNaisClick (nil)
435
    else
436
      ChkPdsNais.Checked := TRUE ;
437
    if ChkRation.Checked
438
    then
439
      ChkRationClick (nil)
440
    else
441
      ChkRation.Checked := TRUE ;
442
    ChkAppAli.Checked := TRUE ;
443
    ChkEMAli.Checked := TRUE ;
444
    CalcApport ;
445
    ChkAppAliClick (nil) ;
446
    ChkEMAliClick (nil) ;
447
    CalcResult ;
448
    Update := FALSE ;
449
  end ;
450
end;
451

    
452
procedure TFBesGestT.PBAgeSailChange(Sender: TObject);
453
begin
454
  if not Update
455
  then
456
  begin
457
    Update := TRUE ;
458
    if ChkPdsApMB.Checked
459
    then
460
      ChkPdsApMBClick (nil) ;
461
    CalcResult ;
462
    Update := FALSE ;
463
  end ;
464
end;
465

    
466
procedure TFBesGestT.ChkAgeSailClick(Sender: TObject);
467
begin
468
  PBAgeSail.Enabled := not ChkAgeSail.Checked ;
469
  if ChkAgeSail.Checked
470
  then
471
    if not Update
472
    then
473
    begin
474
      Update := TRUE ;
475
      PBAgeSail.AsInteger := PProfilT.Truies[cycle].AgeSail ;
476
      if ChkPdsApMB.Checked
477
      then
478
        ChkPdsApMBClick (nil) ;
479
      CalcResult ;
480
      Update := FALSE ;
481
    end
482
    else
483
      PBAgeSail.AsInteger := PProfilT.Truies[cycle].AgeSail ;
484
end;
485

    
486
procedure TFBesGestT.PBPdsSailChange(Sender: TObject);
487
begin
488
  if not Update
489
  then
490
  begin
491
    Update := TRUE ;
492
    CalcResult ;
493
    Update := FALSE ;
494
  end ;
495
end;
496

    
497
procedure TFBesGestT.ChkPdsSailClick(Sender: TObject);
498
begin
499
  PBPdsSail.Enabled := not ChkPdsSail.Checked ;
500
  if ChkPdsSail.Checked
501
  then
502
    if not Update
503
    then
504
    begin
505
      Update := TRUE ;
506
      PBPdsSail.AsFloat := PProfilT.Truies[cycle].PdsSail ;
507
      CalcResult ;
508
      Update := FALSE ;
509
    end
510
    else
511
      PBPdsSail.AsFloat := PProfilT.Truies[cycle].PdsSail ;
512
end;
513

    
514
procedure TFBesGestT.PBP2SailChange(Sender: TObject);
515
begin
516
  if not Update
517
  then
518
  begin
519
    Update := TRUE ;
520
    CalcResult ;
521
    Update := FALSE ;
522
  end ;
523
end;
524

    
525
procedure TFBesGestT.ChkP2SailClick(Sender: TObject);
526
begin
527
  PBP2Sail.Enabled := not ChkP2Sail.Checked ;
528
  if ChkP2Sail.Checked
529
  then
530
    if not Update
531
    then
532
    begin
533
      Update := TRUE ;
534
      PBP2Sail.AsFloat := PProfilT.Truies[cycle].P2Sail ;
535
      CalcResult ;
536
      Update := FALSE ;
537
    end
538
    else
539
      PBP2Sail.AsFloat := PProfilT.Truies[cycle].P2Sail ;
540
end;
541

    
542
procedure TFBesGestT.PBPdsApMBChange(Sender: TObject);
543
begin
544
  if not Update
545
  then
546
  begin
547
    Update := TRUE ;
548
    CalcResult ;
549
    Update := FALSE ;
550
  end ;
551
end;
552

    
553
procedure TFBesGestT.ChkPdsApMBClick(Sender: TObject);
554
begin
555
  PBPdsApMB.Enabled := not ChkPdsApMB.Checked ;
556
  if ChkPdsApMB.Checked
557
  then
558
    if not Update
559
    then
560
    begin
561
      Update := TRUE ;
562
      // Calcul de PdsApMB ? partir de AgeSail
563
      PBPdsApMB.AsFloat := PProfilT.pmax * (1 - Exp ((- PProfilT.a / 1000) * Power (PBAgeSail.AsInteger + DureeGest, PProfilT.b))) ;
564
      CalcResult ;
565
      Update := FALSE ;
566
    end
567
    else
568
      // Calcul de PdsApMB ? partir de AgeSail
569
      PBPdsApMB.AsFloat := PProfilT.pmax * (1 - Exp ((- PProfilT.a / 1000) * Power (PBAgeSail.AsInteger + DureeGest, PProfilT.b))) ;
570
end;
571

    
572
procedure TFBesGestT.PBP2MBChange(Sender: TObject);
573
begin
574
  if not Update
575
  then
576
  begin
577
    Update := TRUE ;
578
    CalcResult ;
579
    Update := FALSE ;
580
  end ;
581
end;
582

    
583
procedure TFBesGestT.ChkP2MBClick(Sender: TObject);
584
begin
585
  PBP2MB.Enabled := not ChkP2MB.Checked ;
586
  if ChkP2MB.Checked
587
  then
588
    if not Update
589
    then
590
    begin
591
      Update := TRUE ;
592
      PBP2MB.AsFloat := PProfilT.Truies[cycle].P2MB ;
593
      CalcResult ;
594
      Update := FALSE ;
595
    end
596
    else
597
      PBP2MB.AsFloat := PProfilT.Truies[cycle].P2MB ;
598
end;
599

    
600
procedure TFBesGestT.PBNesTotauxChange(Sender: TObject);
601
begin
602
  if not Update
603
  then
604
  begin
605
    Update := TRUE ;
606
    CalcResult ;
607
    Update := FALSE ;
608
  end ;
609
end;
610

    
611
procedure TFBesGestT.ChkNesTotauxClick(Sender: TObject);
612
begin
613
  PBNesTotaux.Enabled := not ChkNesTotaux.Checked ;
614
  if ChkNesTotaux.Checked
615
  then
616
    if not Update
617
    then
618
    begin
619
      Update := TRUE ;
620
      PBNesTotaux.AsFloat := PProfilT.Porcelets[cycle].NesTotaux ;
621
      CalcResult ;
622
      Update := FALSE ;
623
    end
624
    else
625
      PBNesTotaux.AsFloat := PProfilT.Porcelets[cycle].NesTotaux ;
626
end;
627

    
628
procedure TFBesGestT.PBPdsNaisChange(Sender: TObject);
629
begin
630
  if not Update
631
  then
632
  begin
633
    Update := TRUE ;
634
    CalcResult ;
635
    Update := FALSE ;
636
  end ;
637
end;
638

    
639
procedure TFBesGestT.ChkPdsNaisClick(Sender: TObject);
640
begin
641
  PBPdsNais.Enabled := not ChkPdsNais.Checked ;
642
  if ChkPdsNais.Checked
643
  then
644
    if not Update
645
    then
646
    begin
647
      Update := TRUE ;
648
      PBPdsNais.AsFloat := PProfilT.Porcelets[cycle].PdsNais ;
649
      CalcResult ;
650
      Update := FALSE ;
651
    end
652
    else
653
      PBPdsNais.AsFloat := PProfilT.Porcelets[cycle].PdsNais ;
654
end;
655

    
656
procedure TFBesGestT.CBLogeChange(Sender: TObject);
657
begin
658
  if CBLoge.ItemIndex > 0
659
  then // Logement
660
  begin
661
    PLogeT := ListLogeT[FindIdxLogeT (CBLoge.Text)] ;
662
    CBLoge.Hint := PLogeT.Memo ;
663
    PRegle.Visible := TRUE ;
664
    CBTyp.Enabled := FALSE ;
665
    CBSol.Enabled := FALSE ;
666
    PBTemp.Enabled := FALSE ;
667
    TBAct.Enabled := FALSE ;
668
    if not Update
669
    then
670
    begin
671
      Update := TRUE ;
672
      regle := 1 ;
673
      if PBRegle.AsInteger = regle
674
      then
675
        PBRegleChange (nil)
676
      else
677
        PBRegle.AsInteger := regle ;
678
      PBRegle.MaxValue := PLogeT.NbRuleGest ;
679
      LNbRegles.Caption := Format ('/ %d', [PLogeT.NbRuleGest]) ;
680
      // Remplissage des champs avec les valeurs du logement
681
      CBTyp.ItemIndex := PLogeT.RuleGest[regle].Typ ;
682
      if CBTyp.ItemIndex = 2
683
      then // Plein-air
684
      begin
685
        CBSol.ItemIndex := -1 ;
686
        CBSol.Enabled := FALSE ;
687
      end
688
      else
689
        CBSol.ItemIndex := PLogeT.RuleGest[regle].Sol ;
690
      PBTemp.AsInteger := PLogeT.RuleGest[regle].Temp ;
691
      TBAct.Position := PLogeT.RuleGest[regle].Act ;
692
      CalcResult ;
693
      Update := FALSE ;
694
    end ;
695
    CalcResult ;
696
  end
697
  else // Saisie manuelle
698
  begin
699
    PRegle.Visible := FALSE ;
700
    CBTyp.Enabled := TRUE ;
701
    CBSol.Enabled := TRUE ;
702
    PBTemp.Enabled := TRUE ;
703
    TBAct.Enabled := TRUE ;
704
    Update := TRUE ;
705
    CalcResult ;
706
    Update := FALSE ;
707
  end ;
708
end;
709

    
710
procedure TFBesGestT.ChkLogeClick(Sender: TObject);
711
begin
712
  CBLoge.Enabled := not ChkLoge.Checked ;
713
  if ChkLoge.Checked
714
  then
715
    if not Update
716
    then
717
    begin
718
      Update := TRUE ;
719
      CBLoge.ItemIndex := CBLoge.Items.IndexOf (FindNomLogeT (PProfilT.Loge)) ;
720
      CBLogeChange (nil) ;
721
      regle := 1 ;
722
      if PBRegle.AsInteger = regle
723
      then
724
        PBRegleChange (nil)
725
      else
726
        PBRegle.AsInteger := regle ;
727
      PBRegle.MaxValue := PLogeT.NbRuleGest ;
728
      LNbRegles.Caption := Format ('/ %d', [PLogeT.NbRuleGest]) ;
729
      // Remplissage des champs avec les valeurs du logement
730
      CBTyp.ItemIndex := PLogeT.RuleGest[regle].Typ ;
731
      if CBTyp.ItemIndex = 2
732
      then // Plein-air
733
      begin
734
        CBSol.ItemIndex := -1 ;
735
        CBSol.Enabled := FALSE ;
736
      end
737
      else
738
        CBSol.ItemIndex := PLogeT.RuleGest[regle].Sol ;
739
      PBTemp.AsInteger := PLogeT.RuleGest[regle].Temp ;
740
      TBAct.Position := PLogeT.RuleGest[regle].Act ;
741
      CalcResult ;
742
      Update := FALSE ;
743
    end
744
    else
745
    begin
746
      CBLoge.ItemIndex := CBLoge.Items.IndexOf (FindNomLogeT (PProfilT.Loge)) ;
747
      CBLogeChange (nil) ;
748
    end ;
749
end;
750

    
751
procedure TFBesGestT.PBRegleChange(Sender: TObject);
752
begin
753
  if not Update
754
  then
755
  begin
756
    Update := TRUE ;
757
    regle := PBRegle.AsInteger ;
758
    // Remplissage des champs avec les valeurs du logement
759
    CBTyp.ItemIndex := PLogeT.RuleGest[regle].Typ ;
760
    if CBTyp.ItemIndex = 2
761
    then // Plein-air
762
    begin
763
      CBSol.ItemIndex := -1 ;
764
      CBSol.Enabled := FALSE ;
765
    end
766
    else
767
      CBSol.ItemIndex := PLogeT.RuleGest[regle].Sol ;
768
    PBTemp.AsInteger := PLogeT.RuleGest[regle].Temp ;
769
    TBAct.Position := PLogeT.RuleGest[regle].Act ;
770
    Update := FALSE ;
771
  end ;
772
end;
773

    
774
procedure TFBesGestT.CBTypChange(Sender: TObject);
775
begin
776
  if not Update
777
  then
778
  begin
779
    Update := TRUE ;
780
    if CBTyp.ItemIndex = 2
781
    then // Plein-air
782
    begin
783
      CBSol.ItemIndex := -1 ;
784
      CBSol.Enabled := FALSE ;
785
    end
786
    else
787
      if CBSol.ItemIndex = -1
788
      then
789
      begin
790
        CBSol.ItemIndex := 0 ;
791
        CBSol.Enabled := TRUE ;
792
      end ;
793
    CalcResult ;
794
    Update := FALSE ;
795
  end ;
796
end;
797

    
798
procedure TFBesGestT.CBSolChange(Sender: TObject);
799
begin
800
  if not Update
801
  then
802
  begin
803
    Update := TRUE ;
804
    CalcResult ;
805
    Update := FALSE ;
806
  end ;
807
end;
808

    
809
procedure TFBesGestT.PBTempChange(Sender: TObject);
810
begin
811
  if not Update
812
  then
813
  begin
814
    Update := TRUE ;
815
    CalcResult ;
816
    Update := FALSE ;
817
  end ;
818
end;
819

    
820
procedure TFBesGestT.TBActChange(Sender: TObject);
821
begin
822
  TBAct.SelEnd := TBAct.Position ;
823
  PBAct.AsInteger := TBAct.Position ;
824
  if not Update
825
  then
826
  begin
827
    Update := TRUE ;
828
    CalcResult ;
829
    Update := FALSE ;
830
  end ;
831
end;
832

    
833
procedure TFBesGestT.CBSeqAliChange(Sender: TObject);
834
begin
835
  if CBSeqAli.ItemIndex = -1
836
  then
837
    CBSeqAli.Hint := ''
838
  else
839
  begin
840
    PSeqAliT := ListSeqAliT[FindIdxSeqAliT (CBSeqAli.Text)] ;
841
    CBSeqAli.Hint := PSeqAliT.Memo ;
842
    if not Update
843
    then
844
    begin
845
      Update := TRUE ;
846
      ChkEMAli.Checked := TRUE ;
847
      CalcApport ;
848
      ChkAppAliClick (nil) ;
849
      ChkEMAliClick (nil) ;
850
      CalcResult ;
851
      Update := FALSE ;
852
    end ;
853
  end ;
854
  AjustEnabled ;
855
end;
856

    
857
procedure TFBesGestT.ChkSeqAliClick(Sender: TObject);
858
begin
859
  CBSeqAli.Enabled := not ChkSeqAli.Checked ;
860
  if ChkSeqAli.Checked
861
  then
862
    if not Update
863
    then
864
    begin
865
      Update := TRUE ;
866
      CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (FindNomSeqAliT (PProfilT.SeqAli)) ;
867
      CBSeqAliChange (nil) ;
868
      ChkEMAli.Checked := TRUE ;
869
      CalcApport ;
870
      ChkAppAliClick (nil) ;
871
      ChkEMAliClick (nil) ;
872
      CalcResult ;
873
      Update := FALSE ;
874
    end
875
    else
876
    begin
877
      CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (FindNomSeqAliT (PProfilT.SeqAli)) ;
878
      CBSeqAliChange (nil) ;
879
    end ;
880
end;
881

    
882
procedure TFBesGestT.CBRationChange(Sender: TObject);
883
begin
884
  if CBRation.ItemIndex = -1
885
  then
886
    CBRation.Hint := ''
887
  else
888
  begin
889
    PRationT := ListRationT[FindIdxRationT (CBRation.Text)] ;
890
    CBRation.Hint := PRationT.Memo ;
891
    if not Update
892
    then
893
    begin
894
      Update := TRUE ;
895
      ChkAppAli.Checked := TRUE ;
896
      CalcApport ;
897
      ChkAppAliClick (nil) ;
898
      if ChkEMAli.Checked
899
      then
900
        ChkEMAliClick (nil) ;
901
      CalcResult ;
902
      Update := FALSE ;
903
    end ;
904
  end ;
905
  AjustEnabled ;
906
end;
907

    
908
procedure TFBesGestT.ChkRationClick(Sender: TObject);
909
begin
910
  CBRation.Visible := not ChkRation.Checked ;
911
  CBRationProfil.Visible := ChkRation.Checked ;
912
  if ChkRation.Checked
913
  then
914
    if not Update
915
    then
916
    begin
917
      Update := TRUE ;
918
      CBRation.ItemIndex := -1 ;
919
      CBRationChange (nil) ;
920
      ChkAppAli.Checked := TRUE ;
921
      CalcApport ;
922
      ChkAppAliClick (nil) ;
923
      if ChkEMAli.Checked
924
      then
925
        ChkEMAliClick (nil) ;
926
      CalcResult ;
927
      Update := FALSE ;
928
    end
929
    else
930
    begin
931
      CBRation.ItemIndex := -1 ;
932
      CBRationChange (nil) ;
933
    end ;
934
end;
935

    
936
procedure TFBesGestT.PBAppAliChange(Sender: TObject);
937
begin
938
  if not Update
939
  then
940
  begin
941
    Update := TRUE ;
942
    CalcApport ;
943
    if ChkEMAli.Checked
944
    then
945
      ChkEMAliClick (nil) ;
946
    CalcResult ;
947
    Update := FALSE ;
948
  end ;
949
end;
950

    
951
procedure TFBesGestT.ChkAppAliClick(Sender: TObject);
952
begin
953
  PBAppAli.Enabled := not ChkAppAli.Checked ;
954
  if ChkAppAli.Checked
955
  then
956
    if not Update
957
    then
958
    begin
959
      Update := TRUE ;
960
      CalcApport ;
961
      PBAppAli.AsFloat := AppAliTot / DureeGest ;
962
      if ChkEMAli.Checked
963
      then
964
        ChkEMAliClick (nil) ;
965
      CalcResult ;
966
      Update := FALSE ;
967
    end
968
    else
969
      PBAppAli.AsFloat := AppAliTot / DureeGest ;
970
end;
971

    
972
procedure TFBesGestT.PBEMAliChange(Sender: TObject);
973
begin
974
  if not Update
975
  then
976
  begin
977
    Update := TRUE ;
978
    CalcApport ;
979
    CalcResult ;
980
    Update := FALSE ;
981
  end ;
982
end;
983

    
984
procedure TFBesGestT.ChkEMAliClick(Sender: TObject);
985
begin
986
  PBEMAli.Enabled := not ChkEMAli.Checked ;
987
  if ChkEMAli.Checked
988
  then
989
    if not Update
990
    then
991
    begin
992
      Update := TRUE ;
993
      CalcApport ;
994
      if AppAliTot = 0
995
      then
996
        PBEMAli.Text := ''
997
      else
998
        PBEMAli.AsFloat := AppEMTot / AppAliTot ;
999
      CalcResult ;
1000
      Update := FALSE ;
1001
    end
1002
    else
1003
      if AppAliTot = 0
1004
      then
1005
        PBEMAli.Text := ''
1006
      else
1007
        PBEMAli.AsFloat := AppEMTot / AppAliTot
1008
  else
1009
    if not Update
1010
    then
1011
    begin
1012
      Update := TRUE ;
1013
      CalcApport ; // L'apport est recalcul? avec des teneurs standards
1014
      CalcResult ;
1015
      Update := FALSE ;
1016
    end ;
1017
end;
1018

    
1019
procedure TFBesGestT.CalcApport ;
1020
var
1021
  i, Jour, AA, Unite : integer ;
1022
  PctAli1, PctAli2, Quantite, Ingere, IngSec1, IngSec2 : double ;
1023
  NumRuleSeqAli, NumRuleRation : integer ;
1024
  RuleSeqAli : array[1..MAX_RULE] of RecRuleSeqAliT ;
1025
  RuleRation : array[1..MAX_RULE] of RecRuleRationT ;
1026
  RuleSeqAliInit, RuleRationInit, Ecart : integer ;
1027
  RecCC1, RecCC2 : CompositionChimique ;
1028
  TabAAtotal1, TabAAtotal2, TabCUDAA1, TabCUDAA2 : array[0..12] of double ;
1029
  ok : boolean ;
1030
begin
1031
  // Initialisation
1032
  AppAliTot := 0 ;
1033
  AppEDTot := 0 ;
1034
  AppEMTot := 0 ;
1035
  AppENTot := 0 ;
1036
  for Jour := 1 to DureeGest do
1037
  begin
1038
    AppAli[Jour] := 0 ;
1039
    AppED[Jour] := 0 ;
1040
    AppEM[Jour] := 0 ;
1041
    AppEN[Jour] := 0 ;
1042
    for AA := 1 to 14 do
1043
      AppAA[AA, Jour] := 0 ;
1044
  end ;
1045
  if ChkEMAli.Checked
1046
  then // S?quence alimentaire
1047
    if CBSeqAli.ItemIndex = -1
1048
    then
1049
      Exit
1050
    else // Chargement des r?gles
1051
      for i := 1 to PSeqAliT.NbRuleGest do
1052
        RuleSeqAli[i] := PSeqAliT.RuleGest[i]
1053
  else // Teneur en EM
1054
    if PBEMAli.AsFloat = 0
1055
    then
1056
      Exit
1057
    else
1058
      if CBSeqAli.ItemIndex = -1
1059
      then // Cr?ation d'une r?gle sans aliment
1060
        with RuleSeqAli[1] do
1061
        begin
1062
          ModeFin := -1 ;
1063
          NumAli1 := -1 ;
1064
          NumAli2 := -1 ;
1065
          PctAli1Init := 100 ;
1066
          PctAli1Fin := 100 ;
1067
        end
1068
      else // Chargement des r?gles
1069
        for i := 1 to PSeqAliT.NbRuleGest do
1070
          RuleSeqAli[i] := PSeqAliT.RuleGest[i] ;
1071
  NumRuleSeqAli := 1 ;
1072
  RuleSeqAliInit := 1 ;
1073
  if ChkAppAli.Checked
1074
  then
1075
    if ChkRation.Checked
1076
    then // Profil animal
1077
      if CBProfil.ItemIndex = -1
1078
      then
1079
        Exit
1080
      else // Cr?ation d'une r?gle ? partir du profil animal
1081
      begin
1082
        with RuleRation[1] do
1083
        begin
1084
          ModeFin := -1 ;
1085
          Equation := 0 ; // Constant
1086
          a := PProfilT.Gest[Cycle] ;
1087
        end ;
1088
        Unite := PProfilT.Unite ;
1089
      end
1090
    else // Plan de rationnement
1091
      if CBRation.ItemIndex = -1
1092
      then
1093
        Exit
1094
      else // Chargement des r?gles
1095
      begin
1096
        for i := 1 to PRationT.NbRuleGest do
1097
          RuleRation[i] := PRationT.RuleGest[i] ;
1098
        Unite := PRationT.UniteGest ;
1099
      end
1100
  else // Consommation moyenne
1101
    if PBAppAli.AsFloat = 0
1102
    then
1103
      Exit
1104
    else // Cr?ation d'une r?gle ? partir de la consommation moyenne
1105
    begin
1106
      with RuleRation[1] do
1107
      begin
1108
        ModeFin := -1 ;
1109
        Equation := 0 ; // Constant
1110
        a := PBAppAli.AsFloat ;
1111
      end ;
1112
      Unite := 0 ; // Quantit?
1113
    end ;
1114
  NumRuleRation := 1 ;
1115
  RuleRationInit := 1 ;
1116
  // Boucle des jours
1117
  for Jour := 1 to DureeGest do
1118
  begin
1119
    // Aliment(s) distribu?(s)
1120
    repeat
1121
      ok := TRUE ;
1122
      with RuleSeqAli[NumRuleSeqAli] do
1123
        if ModeFin = 0
1124
        then // Dur?e
1125
          if (Jour - RuleSeqAliInit + 1 > ValFin) then ok := FALSE ;
1126
      if not (ok)
1127
      then // Changement de r?gle
1128
      begin
1129
        Inc (NumRuleSeqAli) ;
1130
        RuleSeqAliInit := Jour ;
1131
      end ;
1132
    until ok ;
1133
    with RuleSeqAli[NumRuleSeqAli] do
1134
    begin
1135
      // Composition aliment 1
1136
      if NumAli1 = -1
1137
      then
1138
      begin
1139
        RecCC1 := CCVide ;
1140
        for i := 0 to 12 do
1141
          TabAAtotal1[i] := 0 ;
1142
        for i := 0 to 12 do
1143
          TabCUDAA1[i] := 0 ;
1144
      end
1145
      else
1146
      begin
1147
        PAliment := ListAliment[FindIdxAliment (FindNomAliment (NumAli1))] ;
1148
        RecCC1 := PAliment.CC ;
1149
        for i := 0 to 12 do
1150
          TabAAtotal1[i] := PAliment.AAtotal[i] ;
1151
        for i := 0 to 12 do
1152
          TabCUDAA1[i] := PAliment.CUDAA[i] ;
1153
      end ;
1154
      if not ChkEMAli.Checked
1155
      then // Teneur en EM
1156
        with RecCC1 do
1157
        begin
1158
          ED_T := (PBEMAli.AsFloat / 0.96) / MS * 1000 ;
1159
          EM_T := (PBEMAli.AsFloat) / MS * 1000 ;
1160
          EN_T := (PBEMAli.AsFloat * 0.74) / MS * 1000 ;
1161
        end ;
1162
      // Composition aliment 2
1163
      if NumAli2 = -1
1164
      then
1165
      begin
1166
        RecCC2 := CCVide ;
1167
        for i := 0 to 12 do
1168
          TabAAtotal2[i] := 0 ;
1169
        for i := 0 to 12 do
1170
          TabCUDAA2[i] := 0 ;
1171
      end
1172
      else
1173
      begin
1174
        PAliment := ListAliment[FindIdxAliment (FindNomAliment (NumAli2))] ;
1175
        RecCC2 := PAliment.CC ;
1176
        for i := 0 to 12 do
1177
          TabAAtotal2[i] := PAliment.AAtotal[i] ;
1178
        for i := 0 to 12 do
1179
          TabCUDAA2[i] := PAliment.CUDAA[i] ;
1180
      end ;
1181
      if not ChkEMAli.Checked
1182
      then // Teneur en EM
1183
        with RecCC2 do
1184
        begin
1185
          ED_T := (PBEMAli.AsFloat / 0.96) / MS * 1000 ;
1186
          EM_T := (PBEMAli.AsFloat) / MS * 1000 ;
1187
          EN_T := (PBEMAli.AsFloat * 0.74) / MS * 1000 ;
1188
        end ;
1189
      // Calcul des % aliments
1190
      if PctAli1Init = PctAli1Fin
1191
      then
1192
        PctAli1 := PctAli1Init
1193
      else // Transition
1194
      begin
1195
        Ecart := PctAli1Fin - PctAli1Init ;
1196
        if ModeFin = 0
1197
        then // Dur?e
1198
          PctAli1 := PctAli1Init + (Jour - RuleSeqAliInit) * Ecart / ValFin
1199
        else // Fin
1200
          PctAli1 := PctAli1Init + (Jour - RuleSeqAliInit) * Ecart / (DureeGest - RuleSeqAliInit) ;
1201
      end ;
1202
    end ;
1203
    PctAli2 := 100 - PctAli1 ;
1204
    // Quantit?(s) distribu?e(s)
1205
    repeat
1206
      ok := TRUE ;
1207
      with RuleRation[NumRuleRation] do
1208
        if ModeFin = 0
1209
        then // Dur?e
1210
          if Jour - RuleRationInit + 1 > ValFin then ok := FALSE ;
1211
      if not (ok)
1212
      then // Changement de r?gle
1213
      begin
1214
        Inc (NumRuleRation) ;
1215
        RuleRationInit := Jour ;
1216
      end ;
1217
    until ok ;
1218
    with RuleRation[NumRuleRation] do
1219
    begin
1220
      // Calcul des quantit?s
1221
      case Equation of
1222
        0 : // Constant
1223
          Quantite := a ;
1224
        1 : // Lin?aire
1225
          Quantite := a + b * (Jour - RuleRationInit) ;
1226
        2 : // Lin?aire-plateau
1227
          Quantite := LPvaleur (a, b, c, Jour - RuleRationInit + 1, d) ;
1228
        3 : // Curvilin?aire
1229
          Quantite := CLvaleur (a, c, Jour - RuleRationInit + 1, d) ;
1230
        else
1231
          Quantite := 0 ;
1232
      end ;
1233
      // Convertion de ED, EM, EN en quantit? si besoin
1234
      case Unite of
1235
        1 : // ED (MJ/j)
1236
          Ingere := Quantite
1237
            / (PctAli1 / 100 * RecCC1.ED_T * RecCC1.MS / 1000
1238
              + PctAli2 / 100 * RecCC2.ED_T * RecCC2.MS / 1000) ;
1239
        2 : // EM (MJ/j)
1240
          Ingere := Quantite
1241
            / (PctAli1 / 100 * RecCC1.EM_T * RecCC1.MS / 1000
1242
              + PctAli2 / 100 * RecCC2.EM_T * RecCC2.MS / 1000) ;
1243
        3 : // EN (MJ/j)
1244
          Ingere := Quantite
1245
            / (PctAli1 / 100 * RecCC1.EN_T * RecCC1.MS / 1000
1246
              + PctAli2 / 100 * RecCC2.EN_T * RecCC2.MS / 1000) ;
1247
        4 : // MS (kg/j)
1248
          Ingere := Quantite
1249
            / (PctAli1 / 100 * RecCC1.MS / 1000
1250
              + PctAli2 / 100 * RecCC2.MS / 1000) ;
1251
        else // QI (kg/j)
1252
          Ingere := Quantite ;
1253
      end ;
1254
    end ;
1255
    // Aliment ing?r?
1256
    AppAli[Jour] := Ingere ;
1257
    IngSec1 := Ingere * PctAli1 / 100 * RecCC1.MS / 1000 ;
1258
    IngSec2 := Ingere * PctAli2 / 100 * RecCC2.MS / 1000 ;
1259
    // Energie ing?r?e
1260
    AppED[Jour] := IngSec1 * RecCC1.ED_T + IngSec2 * RecCC2.ED_T ;
1261
    AppEM[Jour] := IngSec1 * RecCC1.EM_T + IngSec2 * RecCC2.EM_T ;
1262
    AppEN[Jour] := IngSec1 * RecCC1.EN_T + IngSec2 * RecCC2.EN_T ;
1263
    // Acides amin?s digestibles
1264
    for AA := 1 to 12 do
1265
      AppAA[AA, Jour] := IngSec1 * TabAAtotal1[AA] * TabCUDAA1[AA] / 100
1266
        + IngSec2 * TabAAtotal2[AA] * TabCUDAA2[AA] / 100 ;
1267
    // met+cys
1268
    AppAA[13, Jour] := AppAA[2, Jour] + AppAA[3, Jour] ;
1269
    // phe+tyr
1270
    AppAA[14, Jour] := AppAA[6, Jour] + AppAA[7, Jour] ;
1271
  end ;
1272
  // Totaux
1273
  AppAliTot := Sum (AppAli) ;
1274
  AppEDTot := Sum (AppED) ;
1275
  AppEMTot := Sum (AppEM) ;
1276
  AppENTot := Sum (AppEN) ;
1277
end ;
1278

    
1279
procedure TFBesGestT.CalcResult ;
1280
var
1281
  i, Temperature, Jour, AA, NumRuleLoge, RuleLogeInit, Ecart : integer ;
1282
  PdsPort, PdsAvMB, EMSail, EMApMB, GMQ, PV, PFoetus, PPlacenta : double ;
1283
  BesEMBaseTot, EMEntSail, CorrJ, CorrNR, NRUterus, NR, LysRet, LysEnt : double ;
1284
  BesEMBase : array [1..DureeGest] of double ;
1285
  EMPortCum : array [0..DureeGest] of double ;
1286
  RuleLoge : array[1..MAX_RULE] of RecRuleLogeT ;
1287
  ok : boolean ;
1288
begin
1289
  if (PBPdsSail.AsFloat > 0)
1290
    and (PBP2Sail.AsFloat > 0)
1291
    and (PBPdsApMB.AsFloat >= PBPdsSail.AsFloat)
1292
    and (PBP2MB.AsFloat >= PBP2Sail.AsFloat)
1293
    and (PBNesTotaux.AsFloat > 0)
1294
    and (PBPdsNais.AsFloat > 0)
1295
    and (PBAppAli.AsFloat > 0)
1296
    and (PBEMAli.AsFloat > 0)
1297
  then
1298
  begin
1299
    //
1300
    // Besoins ?n?rg?tiques
1301
    //
1302
    if CBLoge.ItemIndex > 0
1303
    then // Logement
1304
      for i := 1 to PLogeT.NbRuleGest do
1305
        RuleLoge[i] := PLogeT.RuleGest[i]
1306
    else // Saisie manuelle
1307
      with RuleLoge[1] do
1308
      begin
1309
        ModeFin := -1 ;
1310
        Typ := CBTyp.ItemIndex ;
1311
        Sol := CBSol.ItemIndex ;
1312
        Temp := PBTemp.AsInteger ;
1313
        Act := TBAct.Position ;
1314
      end ;
1315
    NumRuleLoge := 1 ;
1316
    RuleLogeInit := 1 ;
1317
    // Poids port?e
1318
    PdsPort := PBNesTotaux.AsFloat * PBPdsNais.AsFloat ;
1319
    // Poids avant mise-bas
1320
    PdsAvMB := PBPdsApMB.AsFloat + 0.3 + 1.329 * PdsPort ;
1321
    // Gain de poids (lin?aire)
1322
    GMQ := (PdsAvMB - PBPdsSail.AsFloat) / DureeGest ;
1323
    // Energie pour la constitution de r?serves
1324
    EMSail := (-256.8 + 3.2672 * PBPdsSail.AsFloat * PV2PVV + 10.992 * PBP2Sail.AsFloat) * 4.18 ;
1325
    EMApMB := (-256.8 + 3.2672 * PBPdsApMB.AsFloat * PV2PVV + 10.992 * PBP2MB.AsFloat) * 4.18 ;
1326
    BesEMResTot := (EMApMB - EMSail) / DureeGest / 0.77 ;
1327
    EMPortCum[0] := 0 ;
1328
    for Jour := 1 to DureeGest do
1329
    begin
1330
      repeat
1331
        ok := TRUE ;
1332
        with RuleLoge[NumRuleLoge] do
1333
          if ModeFin = 0
1334
          then // Dur?e
1335
            if Jour - RuleLogeInit + 1 > ValFin then ok := FALSE ;
1336
        if not (ok)
1337
        then // Changement de r?gle
1338
        begin
1339
          Inc (NumRuleLoge) ;
1340
          RuleLogeInit := Jour ;
1341
        end ;
1342
      until ok ;
1343
      PV := PBPdsSail.AsFloat + GMQ * Jour ;
1344
      BesEMEnt[Jour] := Power (PV, 0.75) * EEGest
1345
        - 0.3 * Power (PV, 0.75) * 240 / 1000 ;
1346
      EMPortCum[Jour] := Exp (11.72 - 8.62 * Exp (-0.01382 * Jour) + 0.0932 * PBNesTotaux.AsFloat) / 1000
1347
        * (PdsPort * 1.3 * 4.18) / (Exp (11.72 - 8.62 * Exp (-0.01382 * DureeGest) + 0.0932 * PBNesTotaux.AsFloat) / 1000) ;
1348
      BesEMPort[Jour] := (EMPortCum[Jour] - EMPortCum[Jour - 1]) / 0.48 ;
1349
      BesEMBase[Jour] := BesEMEnt[Jour] + BesEMPort[Jour] + BesEMResTot
1350
        + 0.3 * Power (PV, 0.75) * 240 / 1000 ; // Activit? de base
1351
      BesEMAct[Jour] := 0.3 * Power (PV, 0.75) * RuleLoge[NumRuleLoge].Act / 1000 ;
1352
      if (RuleLoge[NumRuleLoge].Sol = 1)
1353
      then // Paill?
1354
        Temperature := RuleLoge[NumRuleLoge].Temp + 3
1355
      else
1356
        Temperature := RuleLoge[NumRuleLoge].Temp ;
1357
      if (RuleLoge[NumRuleLoge].Typ = 1)
1358
      then // Collectif
1359
        if Temperature < TCICol
1360
        then
1361
          BesEMThe[Jour] := (TCICol - Temperature) * Power (PV, 0.75) * EThCol / 1000
1362
        else
1363
          BesEMThe[Jour] := 0
1364
      else
1365
        if Temperature < TCIInd
1366
        then
1367
          BesEMThe[Jour] := (TCIInd - Temperature) * Power (PV, 0.75) * EThInd / 1000
1368
        else
1369
          BesEMThe[Jour] := 0 ;
1370
    end ;
1371
    BesEMEntTot := Mean (BesEMEnt) ;
1372
    BesEMPortTot := Mean (BesEMPort) ;
1373
    BesEMBaseTot := Mean (BesEMBase) ;
1374
    BesEMActTot := Mean (BesEMAct) ;
1375
    BesEMTheTot := Mean (BesEMThe) ;
1376
    // Besoin total en ?nergie
1377
    BesEMTot := BesEMEntTot + BesEMActTot + BesEMResTot + BesEMPortTot + BesEMTheTot ;
1378
    //
1379
    // Besoins en acides amin?s
1380
    //
1381
    EMEntSail := Power (PBPdsSail.AsFloat, 0.75) * EEGest ;
1382
    for Jour := 1 to DureeGest do
1383
    begin
1384
      NRUterus := Exp (8.09 - 8.71 * Exp (-0.01494 * Jour) + 0.0872 * PBNesTotaux.AsFloat) / 6.25
1385
        - Exp (8.09 - 8.71 * Exp (-0.01494 * (Jour - 1)) + 0.0872 * PBNesTotaux.AsFloat) / 6.25 ;
1386
      if (Jour < 98)
1387
      then
1388
        CorrJ := Jour
1389
      else
1390
        CorrJ := Jour - 6 / 16 * (Jour - 98) ;
1391
      Case cycle of
1392
        1 : // Port?e 1
1393
          CorrNR := 0.5708 ;
1394
        2 : // Port?e 2
1395
          CorrNR := 0.4345 ;
1396
        else
1397
          CorrNR := 0.3664 ;
1398
      end ;
1399
      NR := (-0.43 + 45.92 * CorrJ / 100 - 105.35 * Power (CorrJ / 100, 2) + 64.388 * Power (CorrJ / 100, 3)
1400
        + CorrNR * (BesEMBaseTot - EMEntSail) + NRUterus) * 0.85 ;
1401
      LysRet := NR * 6.25 * 0.067 ;
1402
      LysEnt := power ((PBPdsSail.AsFloat + (Jour * (PdsAvMB - PBPdsSail.AsFloat) / DureeGest)), 0.75) * 0.036 ;
1403
      // 1) Besoin total
1404
      BesAA[1, Jour] := (LysRet / 0.65) + LysEnt ;
1405
      for AA := 2 to 12 do
1406
        BesAA[AA, Jour] := BesAA[1, Jour] * ProtIdGest[AA] / 100 ;
1407
      // met+cys
1408
      BesAA[13, Jour] := BesAA[1, Jour] * (ProtIdGest[2] + ProtIdGest[3]) / 100 ;
1409
      // phe+tyr
1410
      BesAA[14, Jour] := BesAA[1, Jour] * (ProtIdGest[6] + ProtIdGest[7]) / 100 ;
1411
      // 2) Besoin d'entretien
1412
      BesAAEnt[1, Jour] := LysEnt ;
1413
      for AA := 2 to 12 do
1414
        BesAAEnt[AA, Jour] := BesAAEnt[1, Jour] * ProtIdEnt[AA] / 100 ;
1415
      // met+cys
1416
      BesAAEnt[13, Jour] := BesAAEnt[1, Jour] * (ProtIdEnt[2] + ProtIdEnt[3]) / 100 ;
1417
      // phe+tyr
1418
      BesAAEnt[14, Jour] := BesAAEnt[1, Jour] * (ProtIdEnt[6] + ProtIdEnt[7]) / 100 ;
1419
      // 3) Besoin pour la port?e
1420
      for AA := 1 to 14 do
1421
        BesAAPort[AA, Jour] := (BesAA[AA, Jour] - BesAAEnt[AA, Jour]) / NR * NRUterus ;
1422
      // 4) Besoin pour la constitution de r?serves
1423
      for AA := 1 to 14 do
1424
        BesAARes[AA, Jour] := BesAA[AA, Jour] - BesAAEnt[AA, Jour] - BesAAPort[AA, Jour] ;
1425
    end ;
1426
    //
1427
    // Besoin en min?raux
1428
    //
1429
    for Jour := 1 to DureeGest do
1430
    begin
1431
      PV := PBPdsSail.AsFloat + GMQ * Jour ;
1432
      PFoetus := (Exp (4.591 - 6.389 * Exp (0.02398 * (45 - Jour)) + 0.0897 * PBNesTotaux.AsFloat)
1433
          - Exp (4.591 - 6.389 * Exp (0.02398 * (45 - (Jour - 1))) + 0.0897 * PBNesTotaux.AsFloat))
1434
        * PdsPort * 6.25 / Exp (4.591 - 6.389 * Exp (0.02398 * (45 - DureeGest)) + 0.0897 * PBNesTotaux.AsFloat) ;
1435
      PPlacenta := Exp (7.34264 - 1.40598 * Exp (0.0625 * (45 - Jour)) + 0.00759 * Jour + 0.06339 * PBNesTotaux.AsFloat) * 0.0096 / 23.8
1436
        - Exp (7.34264 - 1.40598 * Exp (0.0625 * (45 - (Jour - 1))) + 0.00759 * (Jour - 1) + 0.06339 * PBNesTotaux.AsFloat) * 0.0096 / 23.8 ;
1437
      // Phosphore digestible
1438
      BesP[Jour] := 10 * PV / 1000
1439
        + (5.42 - 0.002857 * 2 * PV) * (PBPdsApMB.AsFloat - PBPdsSail.AsFloat) / DureeGest
1440
        + PFoetus + PPlacenta ;
1441
      // Calcium total
1442
      BesCa[Jour] := BesP[Jour] * 3.6 ;
1443
    end ;
1444
    //
1445
    // Affichage des r?sultats
1446
    //
1447
    if (AppEMTot = 0)
1448
    then
1449
      PBAliment.AsFloat := 0
1450
    else
1451
      PBAliment.AsFloat := BesEMTot * AppAliTot / AppEMTot ;
1452
    PBEM.AsFloat := BesEMTot ;
1453
    if (AppEMTot = 0)
1454
    then
1455
      PBEN.AsFloat := 0
1456
    else
1457
      PBEN.AsFloat := BesEMTot * AppENTot / AppEMTot ;
1458
    if (PBAliment.AsFloat = 0)
1459
    then
1460
      PBdLys.AsFloat := 0
1461
    else
1462
      PBdLys.AsFloat := BesAA[1, 105] ;
1463
    BBResGest.Enabled := TRUE ;
1464
    BBRapGest.Enabled := TRUE ;
1465
  end
1466
  else
1467
  begin
1468
    PBAliment.Text := '' ;
1469
    PBEM.Text := '' ;
1470
    PBEN.Text := '' ;
1471
    PBdLys.Text := '' ;
1472
    BBResGest.Enabled := FALSE ;
1473
    BBRapGest.Enabled := FALSE ;
1474
  end ;
1475
end ;
1476

    
1477
procedure TFBesGestT.BBResGestClick(Sender: TObject);
1478
begin
1479
  Modal := True;
1480
  FResBesGestT := TFResBesGestT.Create (Self) ;
1481
  FResBesGestT.ShowModal ;
1482
  FResBesGestT.Release ;
1483
  Modal := False;
1484
end;
1485

    
1486
procedure TFBesGestT.BBRapGestClick(Sender: TObject);
1487
begin
1488
  Modal := True;
1489
  FRapBesGestT := TFRapBesGestT.Create(Self);
1490
  FRapBesGestT.QRRapport.PreviewModal ;
1491
  FRapBesGestT.Release;
1492
  Modal := False;
1493
end;
1494

    
1495
procedure TFBesGestT.AjustEnabled;
1496
begin
1497
  ChkAgeSail.Visible := CBProfil.ItemIndex <> -1 ;
1498
  ChkPdsSail.Visible := CBProfil.ItemIndex <> -1 ;
1499
  ChkP2Sail.Visible := CBProfil.ItemIndex <> -1 ;
1500
  ChkPdsApMB.Visible := CBProfil.ItemIndex <> -1 ;
1501
  ChkP2MB.Visible := CBProfil.ItemIndex <> -1 ;
1502
  ChkNesTotaux.Visible := CBProfil.ItemIndex <> -1 ;
1503
  ChkPdsNais.Visible := CBProfil.ItemIndex <> -1 ;
1504
  ChkLoge.Visible := CBProfil.ItemIndex <> -1 ;
1505
  ChkSeqAli.Visible := CBProfil.ItemIndex <> -1 ;
1506
  ChkRation.Visible := CBProfil.ItemIndex <> -1 ;
1507
  ChkAppAli.Visible := (CBProfil.ItemIndex <> -1) or (CBRation.ItemIndex <> -1) ;
1508
  ChkEMAli.Visible := (CBProfil.ItemIndex <> -1) or (CBSeqAli.ItemIndex <> -1) ;
1509
end;
1510

    
1511
end.