Statistiques
| Révision:

root / UFSimulP.pas @ 5

Historique | Voir | Annoter | Télécharger (84,621 ko)

1
unit UFSimulP ;
2

    
3
interface
4

    
5
uses
6
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7
  Dialogs, ComCtrls, StdCtrls, Buttons, ExtCtrls, DB, DBClient, ComObj, 
8
  PBNumEdit, PBSuperSpin, JvExControls, JvComponent, JvEnterTab, UVariables, 
9
  gnugettext;
10

    
11
type
12
  TFSimulP = class(TForm)
13
    PC: TPageControl;
14
    ResSimul: TTabSheet;
15
    CompSimul: TTabSheet;
16
    SensSimul: TTabSheet;
17
    GBSimul: TGroupBox;
18
    SBAddSimul: TSpeedButton;
19
    SBDelSimul: TSpeedButton;
20
    CBSimul: TComboBox;
21
    CBProfil: TComboBox;
22
    CBRation: TComboBox;
23
    CBSeqAli: TComboBox;
24
    CBCompSimul1: TComboBox;
25
    CBCompSimul2: TComboBox;
26
    CBCompSimul3: TComboBox;
27
    CBCompSimul4: TComboBox;
28
    CBCompSimul5: TComboBox;
29
    ChkCompSimul1: TCheckBox;
30
    ChkCompSimul2: TCheckBox;
31
    ChkCompSimul3: TCheckBox;
32
    ChkCompSimul4: TCheckBox;
33
    ChkCompSimul5: TCheckBox;
34
    LVariation: TLabel;
35
    PBVariation: TPBSuperSpin;
36
    CBSensSimul: TComboBox;
37
    LSensSimul: TLabel;
38
    LProfil: TLabel;
39
    LSeqAli: TLabel;
40
    LRation: TLabel;
41
    BBResSimul: TBitBtn;
42
    BBSensSimul: TBitBtn;
43
    BBTabSimul: TBitBtn;
44
    SBRename: TSpeedButton;
45
    SBComment: TSpeedButton;
46
    BBRapSimul: TBitBtn;
47
    PResSimul: TPanel;
48
    PCompSimul: TPanel;
49
    BBCompSimul: TBitBtn;
50
    PSensSimul: TPanel;
51
    PSimul: TPanel;
52
    GBInit: TGroupBox;
53
    LPVInit: TLabel;
54
    LAgeInit: TLabel;
55
    RBProtInit: TRadioButton;
56
    RBLipInit: TRadioButton;
57
    PBLipInit: TPBSuperSpin;
58
    PBProtInit: TPBSuperSpin;
59
    PBAgeInit: TPBSuperSpin;
60
    PBPVInit: TPBSuperSpin;
61
    GBFin: TGroupBox;
62
    RBDuree: TRadioButton;
63
    PBDuree: TPBSuperSpin;
64
    PBPVFin: TPBSuperSpin;
65
    RBPVFin: TRadioButton;
66
    ChkAgeInit: TCheckBox;
67
    ChkPVInit: TCheckBox;
68
    ChkProtLipInit: TCheckBox;
69
    ChkFin: TCheckBox;
70
    LPV4Age: TLabel;
71
    LAge4PV: TLabel;
72
    GBCompBase: TGroupBox;
73
    RBCompSimul: TRadioButton;
74
    RBCompProfil: TRadioButton;
75
    RBCompSeqAli: TRadioButton;
76
    RBCompRation: TRadioButton;
77
    GBComp1a5: TGroupBox;
78
    CBCompSimulRef: TComboBox;
79
    SBSave: TSpeedButton;
80
    BBRapCompSimul: TBitBtn;
81
    BBRapSensSimul: TBitBtn;
82
    GBModulation: TGroupBox;
83
    LVariable: TLabel;
84
    CBVariable: TComboBox;
85
    PConfig: TPanel;
86
    RBCompElem: TRadioButton;
87
    LCompProfilRef: TLabel;
88
    LCompSeqAliRef: TLabel;
89
    LCompRationRef: TLabel;
90
    GBCompElem: TGroupBox;
91
    GBCompSimulRef: TGroupBox;
92
    PCompElem: TPanel;
93
    JvEnterAsTab: TJvEnterAsTab;
94
    BBTabCompSimul: TBitBtn;
95
    BBTabSensSimul: TBitBtn;
96
    BBTabSimulPlus: TBitBtn;
97
    OpenDialogFile: TOpenDialog;
98
    procedure FormShow(Sender: TObject);
99
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
100
    procedure CBSimulChange(Sender: TObject);
101
    procedure FormActivate(Sender: TObject);
102
    procedure FormDeactivate(Sender: TObject);
103
    procedure SBAddSimulClick(Sender: TObject);
104
    procedure SBDelSimulClick(Sender: TObject);
105
    procedure PCChange(Sender: TObject);
106
    procedure BBResSimulClick(Sender: TObject);
107
    procedure BBCompSimulClick(Sender: TObject);
108
    procedure BBSensSimulClick(Sender: TObject);
109
    procedure CBProfilChange(Sender: TObject);
110
    procedure CBRationChange(Sender: TObject);
111
    procedure CBSeqAliChange(Sender: TObject);
112
    procedure ChkCompSimulClick(Sender: TObject);
113
    procedure BBTabSimulClick(Sender: TObject);
114
    procedure SBRenameClick(Sender: TObject);
115
    procedure SBCommentClick(Sender: TObject);
116
    procedure CBSensSimulChange(Sender: TObject);
117
    procedure CBCompSimul1Change(Sender: TObject);
118
    procedure CBCompSimul2Change(Sender: TObject);
119
    procedure CBCompSimul3Change(Sender: TObject);
120
    procedure CBCompSimul4Change(Sender: TObject);
121
    procedure CBCompSimul5Change(Sender: TObject);
122
    procedure BBRapSimulClick(Sender: TObject);
123
    procedure PBAgeInitChange(Sender: TObject);
124
    procedure ChkAgeInitClick(Sender: TObject);
125
    procedure PBPVInitChange(Sender: TObject);
126
    procedure ChkPVInitClick(Sender: TObject);
127
    procedure RBProtLipInitClick(Sender: TObject);
128
    procedure PBProtInitChange(Sender: TObject);
129
    procedure PBLipInitChange(Sender: TObject);
130
    procedure ChkProtLipInitClick(Sender: TObject);
131
    procedure RBModeFinClick(Sender: TObject);
132
    procedure PBDureeChange(Sender: TObject);
133
    procedure PBPVFinChange(Sender: TObject);
134
    procedure ChkFinClick(Sender: TObject);
135
    procedure CBCompSimulRefChange(Sender: TObject);
136
    procedure SBSaveClick(Sender: TObject);
137
    procedure BBRapSensSimulClick(Sender: TObject);
138
    procedure BBRapCompSimulClick(Sender: TObject);
139
    procedure FormCreate(Sender: TObject);
140
    procedure CBVariableChange(Sender: TObject);
141
    procedure RBCompSimulClick(Sender: TObject);
142
    procedure RBCompElemClick(Sender: TObject);
143
    procedure RBCompProfilClick(Sender: TObject);
144
    procedure RBCompSeqAliClick(Sender: TObject);
145
    procedure RBCompRationClick(Sender: TObject);
146
    procedure BBTabCompSimulClick(Sender: TObject);
147
    procedure BBTabSensSimulClick(Sender: TObject);
148
    procedure BBTabSimulPlusClick(Sender: TObject);
149
  private
150
    { D?clarations priv?es }
151
    Update, Modified, Modal: boolean;
152
    IdxSimulP: integer;
153
    ProtR, LipR: double; // valeurs non arrondies
154
    procedure Save;
155
    procedure ValidBBResSimul;
156
    procedure ValidBBCompSimul;
157
    procedure ValidBBSensSimul;
158
  public
159
    { D?clarations publiques }
160
  end;
161

    
162
var
163
  FSimulP: TFSimulP;
164

    
165
implementation
166

    
167
uses
168
  ShellAPI, SHFolder, ShlObj, UStrings, UInit, UUtil, UFindRec, UCalcul,
169
  UFComment, UCalcSimulP, UFResSimulP, UFRapSimulP, {UFTabSimulP,} UFCompSimulP,
170
  UFRapCompSimulP, UFRapSensSimulP;
171

    
172
{$R *.dfm}
173

    
174
{ TFSimulP }
175

    
176
procedure TFSimulP.FormCreate(Sender: TObject);
177
begin
178
  if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1
179
  then
180
    Font.Name := 'Arial Unicode MS';
181
  TranslateComponent(Self);
182
  Constraints.MinWidth := 616 + ResSimul.Left + ResSimul.Left + (Width - ClientWidth);
183
  Width := Constraints.MinWidth;
184
  Constraints.MinHeight := 376 + ResSimul.Top + ResSimul.Left + (Height - ClientHeight);
185
  Height := Constraints.MinHeight;
186
end;
187

    
188
procedure TFSimulP.FormShow(Sender: TObject);
189
begin
190
  Modified := False;
191
  Modal := False;
192
  PC.ActivePageIndex := 0;
193
  StringsSimulP(CBSimul.Items, True);
194
  SBAddSimul.Enabled := IsComplete or (ListSimulP.Count < 5);
195
  SBSave.Enabled := IsComplete or IsEducation;
196
  IdxSimulP := -1;
197
//  CBSimulChange(nil);
198
end;
199

    
200
procedure TFSimulP.FormClose(Sender: TObject; var Action: TCloseAction);
201
begin
202
  if Modified then Save;
203
  Action := caFree;
204
  NumWinSimulP := -1;
205
end;
206

    
207
procedure TFSimulP.FormActivate(Sender: TObject);
208
begin
209
  if not Modal
210
  then
211
  begin
212
    StringsProfilP(CBProfil.Items, False);
213
    StringsSeqAliP(CBSeqAli.Items, False);
214
    StringsRationP(CBRation.Items, False);
215
    PCChange(nil);
216
    PSimul.Enabled := IsComplete or IsEducation or IsEvaluation;
217
  end;
218
end;
219

    
220
procedure TFSimulP.FormDeactivate(Sender: TObject);
221
begin
222
  if Modified and not Modal then Save;
223
end;
224

    
225
procedure TFSimulP.PCChange(Sender: TObject);
226
begin
227
//  if Modified then Save ;
228
  case PC.ActivePageIndex of
229
    0: // Simulation simple
230
      CBSimulChange(nil);
231
    1: // Comparaison
232
    begin
233
      if RBCompSimul.Checked
234
      then
235
        RBCompSimulClick(nil)
236
      else
237
        RBCompElemClick(nil);
238
      StringsSimulP(CBCompSimulRef.Items, False);
239
      CBCompSimulRefChange(nil);
240
    end;
241
    2: // Sensibilit?
242
    begin
243
      StringsSimulP (CBSensSimul.Items, False);
244
      CBSensSimulChange(nil);
245
    end;
246
  end;
247
end;
248

    
249
// Simulation simple
250

    
251
procedure TFSimulP.Save;
252
var
253
  s: string;
254
begin
255
  Modified := False;
256
  if IsComplete or IsEducation
257
  then
258
    if MessageDlg(Caption + sLineBreak + MsgSave, mtConfirmation, [mbYes, mbNo], 0) = mrYes
259
    then
260
    begin
261
      SaveSimulP;
262
      if not SimulPValid(PSimulP)
263
      then
264
        MessageDlg(Format(MsgInvalidData, [Caption, PSimulP.Nom]), mtWarning, [mbOK], 0);
265
    end
266
    else
267
    begin
268
      LoadSimulP;
269
      s := CBSimul.Text;
270
      StringsSimulP(CBSimul.Items, True);
271
      if FindIdxSimulP(s) = -1
272
      then
273
      begin
274
        IdxSimulP := -1;
275
        CBSimulChange(nil);
276
      end
277
      else
278
        CBSimul.ItemIndex := CBSimul.Items.IndexOf(s);
279
    end;
280
end;
281

    
282
procedure TFSimulP.CBSimulChange(Sender: TObject);
283
begin
284
  if (IdxSimulP <> -1) and (CBSimul.Text <> PSimulP.Nom)
285
  then
286
    if Modified then Save;
287
  IdxSimulP := FindIdxSimulP(CBSimul.Text);
288
  if IdxSimulP = -1
289
  then // Pas d'enregistrement
290
  begin
291
    CBSimul.Repaint ;
292
    SBDelSimul.Enabled := FALSE ;
293
    SBRename.Enabled := FALSE ;
294
    SBComment.Enabled := FALSE ;
295
    SBSave.Enabled := FALSE ;
296
    PSimul.Visible := FALSE ;
297
    BBResSimul.Enabled := FALSE ;
298
    BBRapSimul.Enabled := FALSE ;
299
    BBTabSimul.Enabled := FALSE ;
300
    BBTabSimulPlus.Enabled := FALSE ;
301
  end
302
  else // Affichage de l'enregistrement
303
  begin
304
    SBDelSimul.Enabled := TRUE ;
305
    SBRename.Enabled := TRUE ;
306
    SBComment.Enabled := TRUE ;
307
    SBSave.Enabled := TRUE ;
308
    PSimul.Visible := TRUE ;
309
//    BBResSimul.Enabled := TRUE ;
310
//    BBRapSimul.Enabled := TRUE ;
311
//    BBTabSimul.Enabled := TRUE ;
312
//    BBTabSimulPlus.Enabled := TRUE ;
313
    PSimulP := ListSimulP[IdxSimulP] ;
314
    with PSimulP^ do
315
    begin
316
      CBSimul.Hint := Memo ;
317
      Update := TRUE ;
318
      if Profil = -1
319
      then
320
        CBProfil.ItemIndex := -1
321
      else
322
        CBProfil.ItemIndex := CBProfil.Items.IndexOf (FindNomProfilP (Profil)) ;
323
      if CBProfil.ItemIndex = -1
324
      then
325
        CBProfil.Hint := ''
326
      else
327
      begin
328
        PProfilP := ListProfilP[FindIdxProfilP (CBProfil.Text)] ;
329
        CBProfil.Hint := PProfilP.Memo ;
330
      end ;
331
      if SeqAli = -1
332
      then
333
        CBSeqAli.ItemIndex := -1
334
      else
335
        CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (FindNomSeqAliP (SeqAli)) ;
336
      if CBSeqAli.ItemIndex = -1
337
      then
338
        CBSeqAli.Hint := ''
339
      else
340
      begin
341
        PSeqAliP := ListSeqAliP[FindIdxSeqAliP (CBSeqAli.Text)] ;
342
        CBSeqAli.Hint := PSeqAliP.Memo ;
343
      end ;
344
      if Ration = -1
345
      then
346
        CBRation.ItemIndex := -1
347
      else
348
        CBRation.ItemIndex := CBRation.Items.IndexOf (FindNomRationP (Ration)) ;
349
      if CBRation.ItemIndex = -1
350
      then
351
        CBRation.Hint := ''
352
      else
353
      begin
354
        PRationP := ListRationP[FindIdxRationP (CBRation.Text)] ;
355
        CBRation.Hint := PRationP.Memo ;
356
      end ;
357
      if AgeInitProfil
358
      then
359
        if ChkAgeInit.Checked
360
        then
361
          ChkAgeInitClick (nil)
362
        else
363
          ChkAgeInit.Checked := TRUE
364
      else
365
      begin
366
        ChkAgeInit.Checked := FALSE ;
367
        PBAgeInit.AsInteger := AgeInit ;
368
      end ;
369
      if PVInitProfil
370
      then
371
        if ChkPVInit.Checked
372
        then
373
          ChkPVInitClick (nil)
374
        else
375
          ChkPVInit.Checked := TRUE
376
      else
377
      begin
378
        ChkPVInit.Checked := FALSE ;
379
        PBPVInit.AsFloat := PVInit ;
380
      end ;
381
      if ProtLipInitProfil
382
      then
383
        if ChkProtLipInit.Checked
384
        then
385
          ChkProtLipInitClick (nil)
386
        else
387
          ChkProtLipInit.Checked := TRUE
388
      else
389
      begin
390
        ChkProtLipInit.Checked := FALSE ;
391
        ProtR := ProtInit ;
392
        LipR := LipInit ;
393
        PBProtInit.AsFloat := ProtR ;
394
//        PBProtInit.Hint := FloatToStr (ProtR) ;
395
        PBLipInit.AsFloat := LipR ;
396
//        PBLipInit.Hint := FloatToStr (LipR) ;
397
      end ;
398
      if FinProfil
399
      then
400
        if ChkFin.Checked
401
        then
402
          ChkFinClick (nil)
403
        else
404
          ChkFin.Checked := TRUE
405
      else
406
      begin
407
        ChkFin.Checked := FALSE ;
408
        if ModeFin = 0
409
        then
410
          RBDuree.Checked := TRUE
411
        else
412
          RBPVFin.Checked := TRUE ;
413
        PBDuree.AsInteger := Duree ;
414
        PBPVFin.AsFloat := PVFin ;
415
      end ;
416
      Update := FALSE ;
417
    end ;
418
    RBProtInit.Checked := True;
419
    ValidBBResSimul;
420
  end;
421
end;
422

    
423
procedure TFSimulP.SBAddSimulClick (Sender : TObject) ;
424
var
425
  i, n, q : integer ;
426
  s : string ;
427
  ok : boolean ;
428
  PBackup : PRecSimulP ;
429
begin
430
  if Modified then Save ;
431
  if IdxSimulP = -1
432
  then
433
    q := mrNo
434
  else
435
    q := MessageDlg (MsgCopy, mtConfirmation, [mbYes, mbNo], 0) ;
436
  // saisie du nouveau nom
437
  s := '' ;
438
  repeat
439
    if InputQuery (FSimulP.Caption, MsgName, s)
440
    then // V?rification du nom
441
    begin
442
      s := Trim (s) ; // Suppression des espaces au d?but et ? la fin
443
      if s = ''
444
      then // Pas de nom
445
      begin
446
        ok := FALSE ;
447
        MessageDlg (MsgNameEmpty, mtWarning, [mbOk], 0) ;
448
      end
449
      else
450
        if Length (s) > 25
451
        then // Nom trop long
452
        begin
453
          ok := FALSE ;
454
          MessageDlg (Format (MsgNameTooLarge, [25]), mtWarning, [mbOk], 0) ;
455
          s := Copy (s, 1, 25) ;
456
        end
457
        else
458
        begin
459
          ok := TRUE ;
460
          i := 0 ;
461
          while ok and (i < ListSimulP.Count) do
462
          begin
463
            PSimulP := ListSimulP[i] ;
464
            if PSimulP.Nom = s
465
            then // Nom d?j? utilis?
466
            begin
467
              ok := FALSE ;
468
              MessageDlg (MsgNameExists, mtWarning, [mbOk], 0) ;
469
            end
470
            else
471
              Inc (i) ;
472
          end ;
473
        end ;
474
    end
475
    else // Annulation
476
    begin
477
      s := '' ;
478
      if (IdxSimulP <> -1)
479
      then
480
        PSimulP := ListSimulP[IdxSimulP] ;
481
      ok := TRUE ;
482
    end ;
483
  until ok ;
484
  if s <> ''
485
  then // Cr?ation du nouvel enregistrement
486
  begin
487
    // recherche du premier num?ro libre
488
    n := 0 ;
489
    repeat
490
      Inc (n) ;
491
      ok := TRUE ;
492
      i := 0 ;
493
      while ok and (i < ListSimulP.Count) do
494
      begin
495
        PSimulP := ListSimulP[i] ;
496
        if PSimulP.Num = n
497
        then
498
          ok := FALSE
499
        else
500
          Inc (i) ;
501
      end ;
502
    until ok ;
503
    New (PSimulP) ;
504
    with PSimulP^ do
505
    begin
506
      Nom := s ;
507
      Num := n ;
508
      if q = mrYes
509
      then
510
      begin
511
        PBackup := ListSimulP[IdxSimulP] ;
512
        Memo := PBackup.Memo ;
513
        Profil := PBackup.Profil ;
514
        SeqAli := PBackup.SeqAli ;
515
        Ration := PBackup.Ration ;
516
        AgeInitProfil := PBackup.AgeInitProfil ;
517
        PVInitProfil := PBackup.PVInitProfil ;
518
        ProtLipInitProfil := PBackup.ProtLipInitProfil ;
519
        FinProfil := PBackup.FinProfil ;
520
        AgeInit := PBackup.AgeInit ;
521
        PVInit := PBackup.PVInit ;
522
        ProtInit := PBackup.ProtInit ;
523
        LipInit := PBackup.LipInit ;
524
        ModeFin := PBackup.ModeFin ;
525
        Duree := PBackup.Duree ;
526
        PVFin := PBackup.PVFin ;
527
      end
528
      else
529
      begin
530
        Memo := '' ;
531
        Profil := -1 ;
532
        SeqAli := -1 ;
533
        Ration := -1 ;
534
        AgeInitProfil := TRUE ;
535
        PVInitProfil := TRUE ;
536
        ProtLipInitProfil := TRUE ;
537
        FinProfil := TRUE ;
538
        AgeInit := 0 ;
539
        PVInit := 0 ;
540
        ProtInit := 0 ;
541
        LipInit := 0 ;
542
        ModeFin := 0 ;
543
        Duree := 0 ;
544
        PVFin := 0 ;
545
      end ;
546
    end ;
547
    ListSimulP.Add (PSimulP) ;
548
    CBSimul.Items.Add (PSimulP.Nom) ;
549
    CBSimul.ItemIndex := CBSimul.Items.IndexOf (PSimulP.Nom) ;
550
    CBSimulChange (nil) ;
551
    Modified := TRUE ;
552
    SBAddSimul.Enabled := IsComplete or (ListSimulP.Count < 5) ;
553
    SBCommentClick (nil) ;
554
  end ;
555
end ;
556

    
557
procedure TFSimulP.SBDelSimulClick (Sender : TObject) ;
558
begin
559
  if MessageDlg (MsgDel, mtConfirmation, [mbYes, mbNo], 0) = mrYes
560
  then
561
  begin
562
    Dispose (PSimulP) ;
563
    ListSimulP.Delete (IdxSimulP) ;
564
    SaveSimulP ; // Sauvegarde !
565
    Modified := FALSE ;
566
    CBSimul.DeleteSelected ;
567
    IdxSimulP := -1 ;
568
    CBSimul.ItemIndex := -1 ;
569
    CBSimulChange (nil) ;
570
    SBAddSimul.Enabled := IsComplete or (ListSimulP.Count < 5) ;
571
  end ;
572
end ;
573

    
574
procedure TFSimulP.SBRenameClick (Sender : TObject) ;
575
var
576
  i : integer ;
577
  s : string ;
578
  ok : boolean ;
579
begin
580
  // Saisie du nouveau nom
581
  s := CBSimul.Text ;
582
  repeat
583
    if InputQuery (FSimulP.Caption, MsgRename, s) and (s <> CBSimul.Text)
584
    then // V?rification du nom
585
    begin
586
      s := Trim (s) ; // Suppression des espaces au d?but et ? la fin
587
      if s = ''
588
      then // Pas de nom
589
      begin
590
        ok := FALSE ;
591
        MessageDlg (MsgNameEmpty, mtWarning, [mbOk], 0) ;
592
      end
593
      else
594
        if Length (s) > 25
595
        then // Nom trop long
596
        begin
597
          ok := FALSE ;
598
          MessageDlg (Format (MsgNameTooLarge, [25]), mtWarning, [mbOk], 0) ;
599
          s := Copy (s, 1, 25) ;
600
        end
601
        else
602
        begin
603
          ok := TRUE ;
604
          i := 0 ;
605
          while ok and (i < ListSimulP.Count) do
606
          begin
607
            PSimulP := ListSimulP[i] ;
608
            if PSimulP.Nom = s
609
            then // Nom d?j? utilis?
610
            begin
611
              ok := FALSE ;
612
              MessageDlg (MsgNameExists, mtWarning, [mbOk], 0) ;
613
            end
614
            else
615
              Inc (i) ;
616
          end ;
617
        end ;
618
    end
619
    else // Annulation
620
    begin
621
      s := '' ;
622
      ok := TRUE ;
623
    end ;
624
  until ok ;
625
  PSimulP := ListSimulP[IdxSimulP] ;
626
  if s <> ''
627
  then // Renommer l'enregistrement
628
  begin
629
    PSimulP.Nom := s ;
630
    Modified := TRUE ;
631
    StringsSimulP (CBSimul.Items, TRUE) ;
632
    CBSimul.ItemIndex := CBSimul.Items.IndexOf (s) ;
633
  end ;
634
end ;
635

    
636
procedure TFSimulP.SBCommentClick (Sender : TObject) ;
637
begin
638
  // Saisie du commentaire
639
  FComment := TFComment.Create (Self) ;
640
  with FComment do
641
  begin
642
    Memo.Text := PSimulP.Memo ;
643
    if ShowModal = mrOk
644
    then // Commenter l'enregistrement
645
    begin
646
      PSimulP.Memo := Memo.Text ;
647
      Modified := TRUE ;
648
      CBSimul.Hint := PSimulP.Memo ;
649
    end ;
650
    Release ;
651
  end ;
652
end ;
653

    
654
procedure TFSimulP.SBSaveClick(Sender: TObject);
655
begin
656
  SaveSimulP ;
657
  if not SimulPValid (PSimulP)
658
  then
659
    MessageDlg(Format (MsgInvalidData, [Caption, PSimulP.Nom]), mtWarning, [mbOK], 0) ;
660
  Modified := FALSE ;
661
end;
662

    
663
procedure TFSimulP.CBProfilChange (Sender : TObject) ;
664
begin
665
  if CBProfil.ItemIndex = -1
666
  then
667
    CBProfil.Hint := ''
668
  else
669
  begin
670
    PProfilP := ListProfilP[FindIdxProfilP (CBProfil.Text)] ;
671
    CBProfil.Hint := PProfilP.Memo ;
672
  end ;
673
  if not Update
674
  then
675
  begin
676
    PBProtInit.MaxValue := 0 ;
677
    PBProtInit.MinValue := 0 ;
678
    PBLipInit.MaxValue := 0 ;
679
    PBLipInit.MinValue := 0 ;
680
    Modified := TRUE ;
681
    PSimulP.Profil := FindNumProfilP (CBProfil.Text) ;
682
    // Remplissage des champs avec les valeurs du profil
683
    Update := TRUE ;
684
    PSimulP.AgeInitProfil := TRUE ;
685
    if ChkAgeInit.Checked
686
    then
687
      ChkAgeInitClick (nil)
688
    else
689
      ChkAgeInit.Checked := TRUE ;
690
    PSimulP.PVInitProfil := TRUE ;
691
    if ChkPVInit.Checked
692
    then
693
      ChkPVInitClick (nil)
694
    else
695
      ChkPVInit.Checked := TRUE ;
696
    PSimulP.ProtLipInitProfil := TRUE ;
697
    if ChkProtLipInit.Checked
698
    then
699
      ChkProtLipInitClick (nil)
700
    else
701
      ChkProtLipInit.Checked := TRUE ;
702
    PSimulP.FinProfil := TRUE ;
703
    if ChkFin.Checked
704
    then
705
      ChkFinClick (nil)
706
    else
707
      ChkFin.Checked := TRUE ;
708
    Update := FALSE ;
709
    PBProtInit.MaxValue := 0.18 * CalcPVV (PBPVInit.AsFloat) ;
710
    PBProtInit.MinValue := 0.14 * CalcPVV (PBPVInit.AsFloat) ;
711
    PBLipInit.MaxValue := CalcLipProt (PBPVInit.AsFloat, PBProtInit.MinValue) ;
712
    PBLipInit.MinValue := CalcLipProt (PBPVInit.AsFloat, PBProtInit.MaxValue) ;
713
    PBPVFin.MinValue := PBPVInit.AsFloat ;
714
    ValidBBResSimul ;
715
  end ;
716
end ;
717

    
718
procedure TFSimulP.CBSeqAliChange (Sender : TObject) ;
719
begin
720
  if CBSeqAli.ItemIndex = -1
721
  then
722
    CBSeqAli.Hint := ''
723
  else
724
  begin
725
    PSeqAliP := ListSeqAliP[FindIdxSeqAliP (CBSeqAli.Text)] ;
726
    CBSeqAli.Hint := PSeqAliP.Memo ;
727
  end ;
728
  if not Update
729
  then
730
  begin
731
    Modified := TRUE ;
732
    PSimulP.SeqAli := FindNumSeqAliP (CBSeqAli.Text) ;
733
    ValidBBResSimul ;
734
  end ;
735
end ;
736

    
737
procedure TFSimulP.CBRationChange (Sender : TObject) ;
738
begin
739
  if CBRation.ItemIndex = -1
740
  then
741
    CBRation.Hint := ''
742
  else
743
  begin
744
    PRationP := ListRationP[FindIdxRationP (CBRation.Text)] ;
745
    CBRation.Hint := PRationP.Memo ;
746
  end ;
747
  if not Update
748
  then
749
  begin
750
    Modified := TRUE ;
751
    PSimulP.Ration := FindNumRationP (CBRation.Text) ;
752
    ValidBBResSimul ;
753
  end ;
754
end ;
755

    
756
procedure TFSimulP.PBAgeInitChange(Sender: TObject);
757
begin
758
  if not Update and (PBAgeInit.AsInteger >= PBAgeInit.MinValue)
759
  then
760
  begin
761
    Modified := TRUE ;
762
    PSimulP.AgeInit := PBAgeInit.AsInteger ;
763
    ValidBBResSimul ;
764
  end ;
765
end;
766

    
767
procedure TFSimulP.ChkAgeInitClick(Sender: TObject);
768
begin
769
  if ChkAgeInit.Checked
770
  then
771
  begin
772
    PBAgeInit.Enabled := FALSE ;
773
    if CBProfil.ItemIndex <> -1
774
    then
775
      PBAgeInit.MinValue := PProfilP.AgeInit ;
776
      if not Update
777
      then
778
      begin
779
        Update := TRUE ;
780
        PBAgeInit.AsInteger := PProfilP.AgeInit ;
781
        Update := FALSE ;
782
      end
783
      else
784
        PBAgeInit.AsInteger := PProfilP.AgeInit ;
785
  end
786
  else
787
    PBAgeInit.Enabled := TRUE ;
788
  if not Update
789
  then
790
  begin
791
    Modified := TRUE ;
792
    PSimulP.AgeInitProfil := ChkAgeInit.Checked ;
793
    PSimulP.AgeInit := PBAgeInit.AsInteger ;
794
    ValidBBResSimul ;
795
  end ;
796
end;
797

    
798
procedure TFSimulP.PBPVInitChange(Sender: TObject);
799
begin
800
  if PBPVInit.AsFloat >= PBPVInit.MinValue
801
  then
802
  begin
803
    PBProtInit.MinValue := 0 ;
804
    PBProtInit.MaxValue := 0 ;
805
    PBProtInit.MaxValue := 0.18 * CalcPVV (PBPVInit.AsFloat) ;
806
    PBProtInit.MinValue := 0.14 * CalcPVV (PBPVInit.AsFloat) ;
807
    PBLipInit.MinValue := 0 ;
808
    PBLipInit.MaxValue := 0 ;
809
    PBLipInit.MaxValue := CalcLipProt (PBPVInit.AsFloat, PBProtInit.MinValue) ;
810
    PBLipInit.MinValue := CalcLipProt (PBPVInit.AsFloat, PBProtInit.MaxValue) ;
811
    PBPVFin.MinValue := PBPVInit.AsFloat ;
812
  end ;
813
  if not Update and (PBPVInit.AsFloat >= PBPVInit.MinValue)
814
  then
815
  begin
816
    Modified := TRUE ;
817
    Update := TRUE ;
818
    PSimulP.ProtLipInitProfil := TRUE ;
819
    if ChkProtLipInit.Checked
820
    then
821
      ChkProtLipInitClick (nil)
822
    else
823
      ChkProtLipInit.Checked := TRUE ;
824
    Update := FALSE ;
825
    PSimulP.PVInit := PBPVInit.AsFloat ;
826
    ValidBBResSimul ;
827
  end ;
828
end;
829

    
830
procedure TFSimulP.ChkPVInitClick(Sender: TObject);
831
begin
832
  if ChkPVInit.Checked
833
  then
834
  begin
835
    PBPVInit.Enabled := FALSE ;
836
    if CBProfil.ItemIndex <> -1
837
    then
838
//      PBPVInit.MaxValue := PProfilP.PVFin ;
839
      PBPVInit.MinValue := PProfilP.PVInit ;
840
      if not Update
841
      then
842
      begin
843
        Update := TRUE ;
844
        PBPVInit.AsFloat := PProfilP.PVInit ;
845
        Update := FALSE ;
846
      end
847
      else
848
        PBPVInit.AsFloat := PProfilP.PVInit ;
849
  end
850
  else
851
    PBPVInit.Enabled := TRUE ;
852
  if not Update
853
  then
854
  begin
855
    Modified := TRUE ;
856
    PSimulP.PVInitProfil := ChkPVInit.Checked ;
857
    PSimulP.PVInit := PBPVInit.AsFloat ;
858
    ValidBBResSimul ;
859
  end ;
860
end;
861

    
862
procedure TFSimulP.RBProtLipInitClick(Sender: TObject);
863
begin
864
  PBProtInit.Enabled := RBProtInit.Checked and RBProtInit.Enabled ;
865
  PBLipInit.Enabled := RBLipInit.Checked and RBLipInit.Enabled ;
866
end;
867

    
868
procedure TFSimulP.PBProtInitChange(Sender: TObject);
869
begin
870
  if not Update and (PBProtInit.AsFloat >= PBProtInit.MinValue)
871
  then
872
  begin
873
    Modified := TRUE ;
874
    ProtR := PBProtInit.AsFloat ;
875
    Update := TRUE ;
876
    LipR := CalcLipProt (PBPVInit.AsFloat, PBProtInit.AsFloat) ;
877
    PBLipInit.AsFloat := LipR ;
878
//    PBLipInit.Hint := FloatToStr (LipR) ;
879
    Update := FALSE ;
880
    PSimulP.ProtInit := ProtR ;
881
    PSimulP.LipInit := LipR ;
882
    ValidBBResSimul ;
883
  end ;
884
end;
885

    
886
procedure TFSimulP.PBLipInitChange(Sender: TObject);
887
begin
888
  if not Update and (PBLipInit.AsFloat >= PBLipInit.MinValue)
889
  then
890
  begin
891
    Modified := TRUE ;
892
    LipR := PBLipInit.AsFloat ;
893
    Update := TRUE ;
894
    ProtR := CalcProtLip (PBPVInit.AsFloat, LipR) ;
895
    PBProtInit.AsFloat := ProtR ;
896
//    PBProtInit.Hint := FloatToStr (ProtR) ;
897
    Update := FALSE ;
898
    PSimulP.LipInit := LipR ;
899
    PSimulP.ProtInit := ProtR ;
900
    ValidBBResSimul ;
901
  end ;
902
end;
903

    
904
procedure TFSimulP.ChkProtLipInitClick(Sender: TObject);
905
begin
906
  if ChkProtLipInit.Checked
907
  then
908
  begin
909
    RBProtInit.Enabled := FALSE ;
910
    RBLipInit.Enabled := FALSE ;
911
    PBProtInit.Enabled := FALSE ;
912
    PBLipInit.Enabled := FALSE ;
913
    if CBProfil.ItemIndex <> -1
914
    then
915
      if ChkPVInit.Checked
916
      then // Valeurs du profil
917
        if not Update
918
        then
919
        begin
920
          Update := TRUE ;
921
          ProtR := PProfilP.ProtInit ;
922
          PBProtInit.AsFloat := ProtR ;
923
          LipR := PProfilP.LipInit ;
924
          PBLipInit.AsFloat := LipR ;
925
          Update := FALSE ;
926
        end
927
        else
928
        begin
929
          ProtR := PProfilP.ProtInit ;
930
          PBProtInit.AsFloat := ProtR ;
931
          LipR := PProfilP.LipInit ;
932
          PBLipInit.AsFloat := LipR ;
933
        end
934
      else // Valeurs calcul?es
935
      begin
936
        if not Update
937
        then
938
        begin
939
          Update := TRUE ;
940
          ProtR := CalcProt (PBPVInit.AsFloat) ;
941
          PBProtInit.AsFloat := ProtR ;
942
          LipR := CalcLipProt (PBPVInit.AsFloat, ProtR) ;
943
          PBLipInit.AsFloat := LipR ;
944
          Update := FALSE ;
945
        end
946
        else
947
        begin
948
          ProtR := CalcProt (PBPVInit.AsFloat) ;
949
          PBProtInit.AsFloat := ProtR ;
950
          LipR := CalcLipProt (PBPVInit.AsFloat, ProtR) ;
951
          PBLipInit.AsFloat := LipR ;
952
        end ;
953
      end ;
954
  end
955
  else
956
  begin
957
    RBProtInit.Enabled := TRUE ;
958
    RBLipInit.Enabled := TRUE ;
959
    PBProtInit.Enabled := RBProtInit.Checked ;
960
    PBLipInit.Enabled := RBLipInit.Checked ;
961
  end ;
962
  if not Update
963
  then
964
  begin
965
    Modified := TRUE ;
966
    PSimulP.ProtLipInitProfil := ChkProtLipInit.Checked ;
967
    PSimulP.ProtInit := ProtR ;
968
    PSimulP.LipInit := LipR ;
969
    ValidBBResSimul ;
970
  end ;
971
end;
972

    
973
procedure TFSimulP.RBModeFinClick(Sender: TObject);
974
begin
975
  PBDuree.Enabled := RBDuree.Checked and RBDuree.Enabled ;
976
  PBPVFin.Enabled := RBPVFin.Checked and RBPVFin.Enabled ;
977
  if not Update
978
  then
979
  begin
980
    Modified := TRUE ;
981
    if RBDuree.Checked
982
    then
983
      PSimulP.ModeFin := 0
984
    else
985
      PSimulP.ModeFin := 1 ;
986
    ValidBBResSimul ;
987
  end ;
988
end;
989

    
990
procedure TFSimulP.PBDureeChange(Sender: TObject);
991
begin
992
  if not Update and (PBDuree.AsFloat > 1)
993
  then
994
  begin
995
    Modified := TRUE ;
996
    PSimulP.Duree := PBDuree.AsInteger ;
997
    ValidBBResSimul ;
998
  end ;
999
end;
1000

    
1001
procedure TFSimulP.PBPVFinChange(Sender: TObject);
1002
begin
1003
  if not Update and (PBPVFin.AsFloat > PBPVInit.AsFloat)
1004
  then
1005
  begin
1006
    Modified := TRUE ;
1007
    PSimulP.PVFin := PBPVFin.AsFloat ;
1008
    ValidBBResSimul ;
1009
  end ;
1010
end;
1011

    
1012
procedure TFSimulP.ChkFinClick(Sender: TObject);
1013
begin
1014
  if ChkFin.Checked
1015
  then
1016
  begin
1017
    RBDuree.Enabled := FALSE ;
1018
    RBPVFin.Enabled := FALSE ;
1019
    PBDuree.Enabled := FALSE ;
1020
    PBPVFin.Enabled := FALSE ;
1021
    if CBProfil.ItemIndex <> -1
1022
    then
1023
      if not Update
1024
      then
1025
      begin
1026
        Update := TRUE ;
1027
        if PProfilP.ModeFin = 0
1028
        then // Dur?e
1029
          RBDuree.Checked := TRUE
1030
        else // Poids vif
1031
          RBPVFin.Checked := TRUE ;
1032
        PBDuree.AsInteger := PProfilP.Duree ;
1033
        PBPVFin.AsFloat := PProfilP.PVFin ;
1034
        Update := FALSE ;
1035
      end
1036
      else
1037
      begin
1038
        if PProfilP.ModeFin = 0
1039
        then // Dur?e
1040
          RBDuree.Checked := TRUE
1041
        else // Poids vif
1042
          RBPVFin.Checked := TRUE ;
1043
        PBDuree.AsInteger := PProfilP.Duree ;
1044
        PBPVFin.AsFloat := PProfilP.PVFin ;
1045
      end ;
1046
  end
1047
  else
1048
  begin
1049
    RBDuree.Enabled := TRUE ;
1050
    RBPVFin.Enabled := TRUE ;
1051
    PBDuree.Enabled := RBDuree.Checked ;
1052
    PBPVFin.Enabled := RBPVFin.Checked ;
1053
  end ;
1054
  if not Update
1055
  then
1056
  begin
1057
    Modified := TRUE ;
1058
    PSimulP.FinProfil := ChkFin.Checked ;
1059
    if RBDuree.Checked
1060
    then
1061
      PSimulP.ModeFin := 0
1062
    else
1063
      PSimulP.ModeFin := 1 ;
1064
    PSimulP.Duree := PBDuree.AsInteger ;
1065
    PSimulP.PVFin := PBPVFin.AsFloat ;
1066
    ValidBBResSimul ;
1067
  end ;
1068
end;
1069

    
1070
procedure TFSimulP.BBResSimulClick(Sender: TObject);
1071
begin
1072
  Modal := True;
1073
  New(PResSimulP);
1074
  CalcSimulP(PSimulP.Num, -1, -1, -1, -1, 1, {1,} PResSimulP);
1075
  FResSimulP := TFResSimulP.Create(Self);
1076
  FResSimulP.ShowModal;
1077
  FResSimulP.Release;
1078
  Dispose(PResSimulP);
1079
  Modal := False;
1080
end;
1081

    
1082
procedure TFSimulP.BBRapSimulClick(Sender: TObject);
1083
begin
1084
  Modal := True;
1085
  New(PResSimulP);
1086
  CalcSimulP(PSimulP.Num, -1, -1, -1, -1, 1, {1,} PResSimulP);
1087
  FRapSimulP := TFRapSimulP.Create(Self);
1088
  FRapSimulP.QRRapport.PreviewModal;
1089
  FRapSimulP.Release;
1090
  Dispose(PResSimulP);
1091
  Modal := False;
1092
end;
1093

    
1094
procedure TFSimulP.BBTabSimulClick(Sender: TObject);
1095
var
1096
  vExcel, vWorkbook, vWorksheet, vCell: Variant;
1097
  aFileName, aSheetName, aValue: String;
1098
  aLig, aCol, j: Integer;
1099
  t: Double;
1100
begin
1101
  try // connexion ? une instance existante
1102
    vExcel := GetActiveOleObject('Excel.Application');
1103
  except
1104
    try // ouverture d'une nouvelle instance
1105
      vExcel := CreateOleObject('Excel.Application');
1106
    except
1107
      MessageDlg(MsgExcel, mtError, [mbOK], 0);
1108
      Exit;
1109
    end;
1110
  end;
1111
  vExcel.Visible:= True;
1112
  aFileName := ExcelFile;
1113
  try // utilisation d'un classeur ouvert
1114
    vWorkbook := vExcel.Workbooks[ExtractFileName(aFileName)];
1115
    vWorkbook.Activate;
1116
    vWorkbook.SaveAs(aFileName);
1117
  except
1118
    try // ouverture d'un fichier
1119
      vWorkbook := vExcel.Workbooks.Open(aFileName);
1120
    except // cr?ation d'un fichier
1121
      vWorkbook := vExcel.Workbooks.Add;
1122
      vWorkbook.SaveAs(aFileName);
1123
    end;
1124
  end;
1125
  aSheetName := Caption;
1126
  try // activation d'une feuille existante
1127
    vWorksheet := vWorkbook.Worksheets[aSheetName];
1128
    vWorksheet.Activate;
1129
  except // cr?ation d'une feuille
1130
    vWorksheet := vWorkbook.Worksheets.Add;
1131
    vWorksheet.Name := aSheetName;
1132
  end;
1133
  Modal := True;
1134
  New(PResSimulP);
1135
  CalcSimulP(PSimulP.Num, -1, -1, -1, -1, 1, {1,} PResSimulP);
1136
//  AGSimulP(PResSimulP);
1137
//  FTabSimulP := TFTabSimulP.Create(Self);
1138
//  FTabSimulP.ShowModal;
1139
//  FTabSimulP.Release;
1140
  for aLig := 1 to 6 do
1141
    for aCol := 1 to 16 do
1142
    begin
1143
      vCell := vWorksheet.Cells[aLig, aCol];
1144
      case aLig of
1145
        1: // Ligne de titre
1146
        begin
1147
          case aCol of
1148
            1: // Simulation
1149
              aValue := GBSimul.Caption;
1150
            2: // Profil animal
1151
              aValue := LProfil.Caption;
1152
            3: // S?quence alimentaire
1153
              aValue := LSeqAli.Caption;
1154
            4: // Plan de rationnement
1155
              aValue := LRation.Caption;
1156
            5: // Mode de fin
1157
              aValue := StrModeFin;
1158
            6: // Age initial
1159
              aValue := LAgeInit.Hint;
1160
            7: // Age final
1161
              aValue := Format('%s (%s)', [_('Final age'), _('d')]);
1162
            8: // Poids vif initial
1163
              aValue := LPVInit.Hint;
1164
            9: // Poids vif final
1165
              aValue := RBPVFin.Hint;
1166
            10: // Poids de prot?ines initial
1167
              aValue := RBProtInit.Hint;
1168
            11: // Poids de prot?ines final
1169
              aValue := Format('%s (%s)', [_('Final protein mass'), _('kg')]);
1170
            12: // Poids de lipides initial
1171
              aValue := RBLipInit.Hint;
1172
            13: // Poids de lipides final
1173
              aValue := Format('%s (%s)', [_('Final lipid mass'), _('kg')]);
1174
            14: // Aliment distribu?
1175
              aValue := Format('%s (%s)', [_('Feed usage'), _('kg')]);
1176
            15: // Co?t alimentaire
1177
              aValue := Format('%s (%s)', [_('Feed cost'), CurrencySign]);
1178
            16: // Rendement carcasse
1179
              aValue := Format('%s (%%)', [_('Dressing')]);
1180
          end;
1181
          vCell.Value := '''' + aValue;
1182
        end;
1183
        2: // Donn?es de simulation simple
1184
        begin
1185
          case aCol of
1186
            1: // Simulation
1187
              aValue := CBSimul.Text;
1188
            2: // Profil animal
1189
              aValue := CBProfil.Text;
1190
            3: // S?quence alimentaire
1191
              aValue := CBSeqAli.Text;
1192
            4: // Plan de rationnement
1193
              aValue := CBRation.Text;
1194
            5: // Mode de fin
1195
              if RBDuree.Checked
1196
              then
1197
                aValue := RBDuree.Caption
1198
              else
1199
                aValue := RBPVFin.Caption;
1200
            6: // Age initial
1201
              aValue := PBAgeInit.Text;
1202
            7: // Age final
1203
              aValue := FloatToStrF(PResSimulP.TabResult[1, PResSimulP.NbJSim] + 1, ffFixed, 15, 8);
1204
            8: // Poids vif initial
1205
              aValue := PBPVInit.Text;
1206
            9: // Poids vif final
1207
              aValue := FloatToStrF(PResSimulP.TabResult[2, PResSimulP.NbJSim] + PResSimulP.TabResult[84, PResSimulP.NbJSim], ffFixed, 15, 8);
1208
            10: // Poids de prot?ines initial
1209
              aValue := PBProtInit.Text;
1210
            11: // Poids de prot?ines final
1211
              aValue := FloatToStrF(PResSimulP.TabResult[49, PResSimulP.NbJSim] + PResSimulP.TabResult[79, PResSimulP.NbJSim] / 1000, ffFixed, 15, 8);
1212
            12: // Poids de lipides initial
1213
              aValue := PBLipInit.Text;
1214
            13: // Poids de lipides final
1215
              aValue := FloatToStrF(PResSimulP.TabResult[50, PResSimulP.NbJSim] + PResSimulP.TabResult[80, PResSimulP.NbJSim] / 1000, ffFixed, 15, 8);
1216
            14: // Aliment distribu?
1217
            begin
1218
              t := 0;
1219
              for j := 1 to PResSimulP.NbJSim do
1220
                t := t + PResSimulP.TabResult[113, j];
1221
              aValue := FloatToStrF(t, ffFixed, 15, 2);
1222
            end;
1223
            15: // Co?t alimentaire
1224
            begin
1225
              t := 0;
1226
              for j := 1 to PResSimulP.NbJSim do
1227
              begin
1228
                if PResSimulP.TabResult[7, j] <> -1
1229
                then // Aliment 1
1230
                begin
1231
                  PAliment := ListAliment[FindIdxAliment(FindNomAliment(Trunc(PResSimulP.TabResult[7, j])))];
1232
                  t := t + (PResSimulP.TabResult[11, j] * PResSimulP.TabResult[9, j] / 100) * PAliment.Prix / 1000 ;
1233
                end;
1234
                if PResSimulP.TabResult[8, j] <> -1
1235
                then // Aliment 2
1236
                begin
1237
                  PAliment := ListAliment[FindIdxAliment(FindNomAliment(Trunc(PResSimulP.TabResult[8, j])))];
1238
                  t := t + (PResSimulP.TabResult[11, j] * PResSimulP.TabResult[10, j] / 100) * PAliment.Prix / 1000 ;
1239
                end;
1240
              end;
1241
              aValue := FloatToStrF(t, ffFixed, 15, 2);
1242
            end;
1243
            16: // Rendement carcasse
1244
              aValue := FloatToStrF(CalcRC(PProfilP.PVFin, CalcRCStd(PProfilP.PVFin, PProfilP.Carcasse), PResSimulP.TabResult[2, PResSimulP.NbJSim] + PResSimulP.TabResult[84, PResSimulP.NbJSim]) * 100, ffFixed, 15, 15);
1245
          end;
1246
          vCell.Value := '''' + aValue;
1247
        end;
1248
        else // Effacement
1249
          vCell.Value := '';
1250
      end;
1251
    end;
1252
  Dispose(PResSimulP);
1253
  Modal := False;
1254
end;
1255

    
1256
procedure TFSimulP.BBTabSimulPlusClick(Sender: TObject);
1257
var
1258
  DesktopPath: array[0..MAX_PATH] of Char;
1259
  vExcel, vWorkbook, vWorksheet, vCell: Variant;
1260
  aFileName, aSheetName, aValue: String;
1261
  aLig, aCol, j: Integer;
1262
  t: Double;
1263
begin
1264
  SHGetFolderPath(0, CSIDL_DESKTOP, 0, SHGFP_TYPE_CURRENT, DesktopPath);
1265
  OpenDialogFile.InitialDir := DesktopPath;
1266
  if OpenDialogFile.Execute
1267
  then
1268
    aFileName := OpenDialogFile.FileName
1269
  else
1270
    Exit;
1271
  try // connexion ? une instance existante
1272
    vExcel := GetActiveOleObject('Excel.Application');
1273
  except
1274
    try // ouverture d'une nouvelle instance
1275
      vExcel := CreateOleObject('Excel.Application');
1276
    except
1277
      MessageDlg(MsgExcel, mtError, [mbOK], 0);
1278
      Exit;
1279
    end;
1280
  end;
1281
  vExcel.Visible:= True;
1282
  try // utilisation d'un classeur ouvert
1283
    vWorkbook := vExcel.Workbooks[ExtractFileName(aFileName)];
1284
    vWorkbook.Activate;
1285
    vWorkbook.SaveAs(aFileName);
1286
  except
1287
    try // ouverture d'un fichier
1288
      vWorkbook := vExcel.Workbooks.Open(aFileName);
1289
    except // cr?ation d'un fichier
1290
      vWorkbook := vExcel.Workbooks.Add;
1291
      vWorkbook.SaveAs(aFileName);
1292
    end;
1293
  end;
1294
  aSheetName := 'PResSimulP';
1295
  try // activation d'une feuille existante
1296
    vWorksheet := vWorkbook.Worksheets[aSheetName];
1297
    vWorksheet.Activate;
1298
  except // cr?ation d'une feuille
1299
    vWorksheet := vWorkbook.Worksheets.Add;
1300
    vWorksheet.Name := aSheetName;
1301
  end;
1302
  Modal := True;
1303
  New(PResSimulP);
1304
  CalcSimulP(PSimulP.Num, -1, -1, -1, -1, 1, {1,} PResSimulP);
1305
  // Ligne de titre
1306
  for aCol := 1 to NB_COL_PORC do
1307
  begin
1308
    vCell := vWorksheet.Cells[1, aCol];
1309
    case aCol of
1310
      1: aValue := 'Age';
1311
      2: aValue := 'PV';
1312
      3: aValue := 'RegleAli';
1313
      4: aValue := 'FinAli';
1314
      5: aValue := 'RegleQte';
1315
      6: aValue := 'FinQte';
1316
      7: aValue := 'NumAli1';
1317
      8: aValue := 'NumAli2';
1318
      9: aValue := 'PctAli1';
1319
      10: aValue := 'PctAli2';
1320
      11: aValue := 'Ingere';
1321
      12: aValue := 'EBIng';
1322
      13: aValue := 'MATIng';
1323
      14: aValue := 'LipIng';
1324
      15: aValue := 'AmidonIng';
1325
      16: aValue := 'SucresIng';
1326
      17: aValue := 'CBIng';
1327
      18: aValue := 'ResiduIng';
1328
      19: aValue := 'dNIng';
1329
      20: aValue := 'dLysIng';
1330
      21: aValue := 'dMetIng';
1331
      22: aValue := 'dCysIng';
1332
      23: aValue := 'dTrpIng';
1333
      24: aValue := 'dThrIng';
1334
      25: aValue := 'dPheIng';
1335
      26: aValue := 'dTyrIng';
1336
      27: aValue := 'dLeuIng';
1337
      28: aValue := 'dIleIng';
1338
      29: aValue := 'dValIng';
1339
      30: aValue := 'dHisIng';
1340
      31: aValue := 'dArgIng';
1341
      32: aValue := 'PDN';
1342
      33: aValue := 'PDLys';
1343
      34: aValue := 'PDMet';
1344
      35: aValue := 'PDCys';
1345
      36: aValue := 'PDTrp';
1346
      37: aValue := 'PDThr';
1347
      38: aValue := 'PDPhe';
1348
      39: aValue := 'PDTyr';
1349
      40: aValue := 'PDLeu';
1350
      41: aValue := 'PDIle';
1351
      42: aValue := 'PDVal';
1352
      43: aValue := 'PDHis';
1353
      44: aValue := 'PDArg';
1354
      45: aValue := 'PDMetCys';
1355
      46: aValue := 'PDPheTyr';
1356
      47: aValue := 'PDFirstLimit';
1357
      48: aValue := 'PVV';
1358
      49: aValue := 'p';
1359
      50: aValue := 'l';
1360
      51: aValue := 'mr';
1361
      52: aValue := 'F';
1362
      53: aValue := 'PfreeMAT';
1363
      54: aValue := 'PfreeLip';
1364
      55: aValue := 'PfreeAmidon';
1365
      56: aValue := 'PfreeSucres';
1366
      57: aValue := 'PfreeCB';
1367
      58: aValue := 'PfreeResidu';
1368
      59: aValue := 'PfreeNE';
1369
      60: aValue := 'ExcessProt';
1370
      61: aValue := 'ObligUrinEloss';
1371
      62: aValue := 'UrinEnergy';
1372
      63: aValue := 'MEExcessProt';
1373
      64: aValue := 'NEExcessProt';
1374
      65: aValue := 'PDfreeNEintake';
1375
      66: aValue := 'EnergyPD';
1376
      67: aValue := 'NEintakeSim';
1377
      68: aValue := 'PDfreeNEPD';
1378
      69: aValue := 'PDmaxE';
1379
      70: aValue := 'Standing';
1380
      71: aValue := 'NEmAL';
1381
      72: aValue := 'NEm';
1382
      73: aValue := 'PDfreeNEreq';
1383
      74: aValue := 'a';
1384
      75: aValue := 'b';
1385
      76: aValue := 'px1';
1386
      77: aValue := 'py1';
1387
      78: aValue := 'IngereAL';
1388
      79: aValue := 'PD';
1389
      80: aValue := 'LD';
1390
      81: aValue := 'pFin';
1391
      82: aValue := 'lFin';
1392
      83: aValue := 'PVfin';
1393
      84: aValue := 'GMQ';
1394
      85: aValue := 'Pmat';
1395
      86: aValue := 'MEintake';
1396
      87: aValue := 'DietME';
1397
      88: aValue := 'DietNE';
1398
      89: aValue := 'MEcrois';
1399
      90: aValue := 'NEcrois';
1400
      91: aValue := 'FHP60';
1401
      92: aValue := 'NEgrowth';
1402
      93: aValue := 'NIng';
1403
      94: aValue := 'LysIng';
1404
      95: aValue := 'MetIng';
1405
      96: aValue := 'CysIng';
1406
      97: aValue := 'TrpIng';
1407
      98: aValue := 'ThrIng';
1408
      99: aValue := 'PheIng';
1409
      100: aValue := 'TyrIng';
1410
      101: aValue := 'LeuIng';
1411
      102: aValue := 'IleIng';
1412
      103: aValue := 'ValIng';
1413
      104: aValue := 'HisIng';
1414
      105: aValue := 'ArgIng';
1415
      106: aValue := 'MSAliment';
1416
      107: aValue := 'AgeFin';
1417
      108: aValue := 'ProtFin';
1418
      109: aValue := 'DEcrois';
1419
      110: aValue := 'px1AL';
1420
      111: aValue := 'py1AL';
1421
      112: aValue := 'Gaspillage';
1422
      113: aValue := 'Distrib';
1423
      else
1424
        aValue := '';
1425
    end;
1426
    vCell.Value := '''' + aValue;
1427
  end;
1428
  // Tableau de r?sultat
1429
  for aLig := 1 to PResSimulP.NbJSim do
1430
    for aCol := 1 to NB_COL_PORC do
1431
    begin
1432
      vCell := vWorksheet.Cells[aLig + 1, aCol];
1433
      vCell.Value := PResSimulP.TabResult[aCol, aLig];
1434
    end;
1435
  Dispose(PResSimulP);
1436
  Modal := False;
1437
  vWorkbook.Save;
1438
end;
1439

    
1440
procedure TFSimulP.ValidBBResSimul;
1441
var
1442
  ok: boolean;
1443
  Jour, Age: integer;
1444
  PV: double;
1445
begin
1446
  ok := SimulPValid(PSimulP);
1447
  BBResSimul.Enabled := ok;
1448
  BBRapSimul.Enabled := ok;
1449
  BBTabSimul.Enabled := ok;
1450
  BBTabSimulPlus.Enabled := ok;
1451
  GBInit.Visible := ok;
1452
  GBFin.Visible := ok;
1453
  if ok
1454
  then
1455
  begin
1456
    New(PResSimulP);
1457
    CalcSimulP(-1, PProfilP.Num, PSeqAliP.Num, PRationP.Num, -1, 1, {1,} PResSimulP);
1458
    // PV propos?
1459
    if PBAgeInit.AsInteger - PProfilP.AgeInit + 1 > PResSimulP.NbJSim
1460
    then
1461
      LPV4Age.Caption := ''
1462
    else
1463
    begin
1464
      PV := PResSimulP.TabResult[2, PBAgeInit.AsInteger - PProfilP.AgeInit + 1];
1465
      LPV4Age.Caption := Format (StrPV4Age, [PBAgeInit.AsInteger, PV]);
1466
    end;
1467
    // Age propos?
1468
    Age := 0;
1469
    Jour := 1;
1470
    while (Age = 0) and (Jour <= PResSimulP.NbJSim) do
1471
      if PResSimulP.TabResult[83, Jour] > PBPVInit.AsFloat
1472
      then
1473
        Age := Trunc (PResSimulP.TabResult[1, Jour])
1474
      else
1475
        Inc (Jour);
1476
    if Age = 0
1477
    then
1478
      LAge4PV.Caption := ''
1479
    else
1480
      LAge4PV.Caption := Format(StrAge4PV, [PBPVInit.AsFloat, Age]);
1481
    Dispose(PResSimulP);
1482
  end;
1483
end;
1484

    
1485
// Comparaison
1486

    
1487
procedure TFSimulP.RBCompSimulClick(Sender: TObject);
1488
begin
1489
  RBCompProfil.Enabled := FALSE ;
1490
  RBCompSeqAli.Enabled := FALSE ;
1491
  RBCompRation.Enabled := FALSE ;
1492
  CBCompSimulRef.Enabled := FALSE ;
1493
  GBComp1a5.Caption := RBCompSimul.Caption ;
1494
  StringsSimulP (CBCompSimul1.Items, FALSE) ;
1495
  StringsSimulP (CBCompSimul2.Items, FALSE) ;
1496
  StringsSimulP (CBCompSimul3.Items, FALSE) ;
1497
  StringsSimulP (CBCompSimul4.Items, FALSE) ;
1498
  StringsSimulP (CBCompSimul5.Items, FALSE) ;
1499
  ValidBBCompSimul ;
1500
end;
1501

    
1502
procedure TFSimulP.RBCompElemClick(Sender: TObject);
1503
begin
1504
  RBCompProfil.Enabled := TRUE ;
1505
  RBCompSeqAli.Enabled := TRUE ;
1506
  RBCompRation.Enabled := TRUE ;
1507
  CBCompSimulRef.Enabled := TRUE ;
1508
  if RBCompProfil.Checked
1509
  then
1510
    RBCompProfilClick(nil) ;
1511
  if RBCompSeqAli.Checked
1512
  then
1513
    RBCompSeqAliClick(nil) ;
1514
  if RBCompRation.Checked
1515
  then
1516
    RBCompRationClick(nil) ;
1517
end;
1518

    
1519
procedure TFSimulP.RBCompProfilClick(Sender: TObject);
1520
begin
1521
  GBComp1a5.Caption := RBCompProfil.Caption ;
1522
  StringsProfilP (CBCompSimul1.Items, FALSE) ;
1523
  StringsProfilP (CBCompSimul2.Items, FALSE) ;
1524
  StringsProfilP (CBCompSimul3.Items, FALSE) ;
1525
  StringsProfilP (CBCompSimul4.Items, FALSE) ;
1526
  StringsProfilP (CBCompSimul5.Items, FALSE) ;
1527
  CBCompSimulRefChange (nil) ;
1528
end;
1529

    
1530
procedure TFSimulP.RBCompSeqAliClick(Sender: TObject);
1531
begin
1532
  GBComp1a5.Caption := RBCompSeqAli.Caption ;
1533
  StringsSeqAliP (CBCompSimul1.Items, FALSE) ;
1534
  StringsSeqAliP (CBCompSimul2.Items, FALSE) ;
1535
  StringsSeqAliP (CBCompSimul3.Items, FALSE) ;
1536
  StringsSeqAliP (CBCompSimul4.Items, FALSE) ;
1537
  StringsSeqAliP (CBCompSimul5.Items, FALSE) ;
1538
  CBCompSimulRefChange (nil) ;
1539
end;
1540

    
1541
procedure TFSimulP.RBCompRationClick(Sender: TObject);
1542
begin
1543
  GBComp1a5.Caption := RBCompRation.Caption ;
1544
  StringsRationP (CBCompSimul1.Items, FALSE) ;
1545
  StringsRationP (CBCompSimul2.Items, FALSE) ;
1546
  StringsRationP (CBCompSimul3.Items, FALSE) ;
1547
  StringsRationP (CBCompSimul4.Items, FALSE) ;
1548
  StringsRationP (CBCompSimul5.Items, FALSE) ;
1549
  CBCompSimulRefChange (nil) ;
1550
end;
1551

    
1552
procedure TFSimulP.CBCompSimulRefChange (Sender : TObject) ;
1553
begin
1554
  if CBCompSimulRef.ItemIndex = -1
1555
  then
1556
  begin
1557
    CBCompSimulRef.Hint := '' ;
1558
    LCompProfilRef.Caption := '' ;
1559
    LCompSeqAliRef.Caption := '' ;
1560
    LCompRationRef.Caption := '' ;
1561
  end
1562
  else
1563
  begin
1564
    PSimulP := ListSimulP[FindIdxSimulP (CBCompSimulRef.Text)] ;
1565
    CBCompSimulRef.Hint := PSimulP.Memo ;
1566
    LCompProfilRef.Caption := FindNomProfilP (PSimulP.Profil) ;
1567
    LCompSeqAliRef.Caption := FindNomSeqAliP (PSimulP.SeqAli) ;
1568
    LCompRationRef.Caption := FindNomRationP (PSimulP.Ration) ;
1569
    if CBCompSimul1.ItemIndex = -1
1570
    then // Simulation de r?f?rence
1571
    begin
1572
      if RBCompProfil.Checked
1573
      then // Profils animal
1574
        CBCompSimul1.ItemIndex := CBCompSimul1.Items.IndexOf (FindNomProfilP (PSimulP.Profil)) ;
1575
      if RBCompSeqAli.Checked
1576
      then // S?quences alimentaires
1577
        CBCompSimul1.ItemIndex := CBCompSimul1.Items.IndexOf (FindNomSeqAliP (PSimulP.SeqAli)) ;
1578
      if RBCompRation.Checked
1579
      then // Plans de rationnement
1580
        CBCompSimul1.ItemIndex := CBCompSimul1.Items.IndexOf (FindNomRationP (PSimulP.Ration)) ;
1581
    end ;
1582
  end ;
1583
  ValidBBCompSimul ;
1584
end ;
1585

    
1586
procedure TFSimulP.CBCompSimul1Change (Sender : TObject) ;
1587
begin
1588
  if CBCompSimul1.ItemIndex = -1
1589
  then
1590
    CBCompSimul1.Hint := ''
1591
  else
1592
  begin
1593
    if RBCompSimul.Checked
1594
    then // Simulations
1595
    begin
1596
      PSimulP := ListSimulP[FindIdxSimulP (CBCompSimul1.Text)] ;
1597
      CBCompSimul1.Hint := PSimulP.Memo ;
1598
    end ;
1599
    if RBCompElem.Checked and RBCompProfil.Checked
1600
    then // Profils animal
1601
    begin
1602
      PProfilP := ListProfilP[FindIdxProfilP (CBCompSimul1.Text)] ;
1603
      CBCompSimul1.Hint := PProfilP.Memo ;
1604
    end ;
1605
    if RBCompElem.Checked and RBCompSeqAli.Checked
1606
    then // S?quences alimentaires
1607
    begin
1608
      PSeqAliP := ListSeqAliP[FindIdxSeqAliP (CBCompSimul1.Text)] ;
1609
      CBCompSimul1.Hint := PSeqAliP.Memo ;
1610
    end ;
1611
    if RBCompElem.Checked and RBCompRation.Checked
1612
    then // Plans de rationnement
1613
    begin
1614
      PRationP := ListRationP[FindIdxRationP (CBCompSimul1.Text)] ;
1615
      CBCompSimul1.Hint := PRationP.Memo ;
1616
    end ;
1617
  end ;
1618
  ValidBBCompSimul ;
1619
end ;
1620

    
1621
procedure TFSimulP.CBCompSimul2Change (Sender : TObject) ;
1622
begin
1623
  if CBCompSimul2.ItemIndex = -1
1624
  then
1625
    CBCompSimul2.Hint := ''
1626
  else
1627
  begin
1628
    if RBCompSimul.Checked
1629
    then // Simulations
1630
    begin
1631
      PSimulP := ListSimulP[FindIdxSimulP (CBCompSimul2.Text)] ;
1632
      CBCompSimul2.Hint := PSimulP.Memo ;
1633
    end ;
1634
    if RBCompElem.Checked and RBCompProfil.Checked
1635
    then // Profils animal
1636
    begin
1637
      PProfilP := ListProfilP[FindIdxProfilP (CBCompSimul2.Text)] ;
1638
      CBCompSimul2.Hint := PProfilP.Memo ;
1639
    end ;
1640
    if RBCompElem.Checked and RBCompSeqAli.Checked
1641
    then // S?quences alimentaires
1642
    begin
1643
      PSeqAliP := ListSeqAliP[FindIdxSeqAliP (CBCompSimul2.Text)] ;
1644
      CBCompSimul2.Hint := PSeqAliP.Memo ;
1645
    end ;
1646
    if RBCompElem.Checked and RBCompRation.Checked
1647
    then // Plans de rationnement
1648
    begin
1649
      PRationP := ListRationP[FindIdxRationP (CBCompSimul2.Text)] ;
1650
      CBCompSimul2.Hint := PRationP.Memo ;
1651
    end ;
1652
  end ;
1653
  ValidBBCompSimul ;
1654
end ;
1655

    
1656
procedure TFSimulP.CBCompSimul3Change (Sender : TObject) ;
1657
begin
1658
  if CBCompSimul3.ItemIndex = -1
1659
  then
1660
    CBCompSimul3.Hint := ''
1661
  else
1662
  begin
1663
    if RBCompSimul.Checked
1664
    then // Simulations
1665
    begin
1666
      PSimulP := ListSimulP[FindIdxSimulP (CBCompSimul3.Text)] ;
1667
      CBCompSimul3.Hint := PSimulP.Memo ;
1668
    end ;
1669
    if RBCompElem.Checked and RBCompProfil.Checked
1670
    then // Profils animal
1671
    begin
1672
      PProfilP := ListProfilP[FindIdxProfilP (CBCompSimul3.Text)] ;
1673
      CBCompSimul3.Hint := PProfilP.Memo ;
1674
    end ;
1675
    if RBCompElem.Checked and RBCompSeqAli.Checked
1676
    then // S?quences alimentaires
1677
    begin
1678
      PSeqAliP := ListSeqAliP[FindIdxSeqAliP (CBCompSimul3.Text)] ;
1679
      CBCompSimul3.Hint := PSeqAliP.Memo ;
1680
    end ;
1681
    if RBCompElem.Checked and RBCompRation.Checked
1682
    then // Plans de rationnement
1683
    begin
1684
      PRationP := ListRationP[FindIdxRationP (CBCompSimul3.Text)] ;
1685
      CBCompSimul3.Hint := PRationP.Memo ;
1686
    end ;
1687
  end ;
1688
  ValidBBCompSimul ;
1689
end ;
1690

    
1691
procedure TFSimulP.CBCompSimul4Change (Sender : TObject) ;
1692
begin
1693
  if CBCompSimul4.ItemIndex = -1
1694
  then
1695
    CBCompSimul4.Hint := ''
1696
  else
1697
  begin
1698
    if RBCompSimul.Checked
1699
    then // Simulations
1700
    begin
1701
      PSimulP := ListSimulP[FindIdxSimulP (CBCompSimul4.Text)] ;
1702
      CBCompSimul4.Hint := PSimulP.Memo ;
1703
    end ;
1704
    if RBCompElem.Checked and RBCompProfil.Checked
1705
    then // Profils animal
1706
    begin
1707
      PProfilP := ListProfilP[FindIdxProfilP (CBCompSimul4.Text)] ;
1708
      CBCompSimul4.Hint := PProfilP.Memo ;
1709
    end ;
1710
    if RBCompElem.Checked and RBCompSeqAli.Checked
1711
    then // S?quences alimentaires
1712
    begin
1713
      PSeqAliP := ListSeqAliP[FindIdxSeqAliP (CBCompSimul4.Text)] ;
1714
      CBCompSimul4.Hint := PSeqAliP.Memo ;
1715
    end ;
1716
    if RBCompElem.Checked and RBCompRation.Checked
1717
    then // Plans de rationnement
1718
    begin
1719
      PRationP := ListRationP[FindIdxRationP (CBCompSimul4.Text)] ;
1720
      CBCompSimul4.Hint := PRationP.Memo ;
1721
    end ;
1722
  end ;
1723
  ValidBBCompSimul ;
1724
end ;
1725

    
1726
procedure TFSimulP.CBCompSimul5Change (Sender : TObject) ;
1727
begin
1728
  if CBCompSimul5.ItemIndex = -1
1729
  then
1730
    CBCompSimul5.Hint := ''
1731
  else
1732
  begin
1733
    if RBCompSimul.Checked
1734
    then // Simulations
1735
    begin
1736
      PSimulP := ListSimulP[FindIdxSimulP (CBCompSimul5.Text)] ;
1737
      CBCompSimul5.Hint := PSimulP.Memo ;
1738
    end ;
1739
    if RBCompElem.Checked and RBCompProfil.Checked
1740
    then // Profils animal
1741
    begin
1742
      PProfilP := ListProfilP[FindIdxProfilP (CBCompSimul5.Text)] ;
1743
      CBCompSimul5.Hint := PProfilP.Memo ;
1744
    end ;
1745
    if RBCompElem.Checked and RBCompSeqAli.Checked
1746
    then // S?quences alimentaires
1747
    begin
1748
      PSeqAliP := ListSeqAliP[FindIdxSeqAliP (CBCompSimul5.Text)] ;
1749
      CBCompSimul5.Hint := PSeqAliP.Memo ;
1750
    end ;
1751
    if RBCompElem.Checked and RBCompRation.Checked
1752
    then // Plans de rationnement
1753
    begin
1754
      PRationP := ListRationP[FindIdxRationP (CBCompSimul5.Text)] ;
1755
      CBCompSimul5.Hint := PRationP.Memo ;
1756
    end ;
1757
  end ;
1758
  ValidBBCompSimul ;
1759
end ;
1760

    
1761
procedure TFSimulP.ChkCompSimulClick (Sender : TObject) ;
1762
begin
1763
  ValidBBCompSimul ;
1764
end ;
1765

    
1766
procedure TFSimulP.BBCompSimulClick(Sender: TObject);
1767
var
1768
  i: integer;
1769
begin
1770
  Modal := True;
1771
  // Simulation 1
1772
  with TabSimulP[1] do
1773
    if ChkCompSimul1.Checked and (CBCompSimul1.ItemIndex <> -1)
1774
    then
1775
    begin
1776
      Ok := TRUE ;
1777
      if RBCompSimul.Checked
1778
      then // Simulations simples
1779
        Simul := FindNumSimulP (CBCompSimul1.Text)
1780
      else // Un ?l?ment d'une simulation
1781
        Simul := FindNumSimulP (CBCompSimulRef.Text) ;
1782
      if RBCompElem.Checked and RBCompProfil.Checked
1783
      then // Profil animal
1784
        Profil := FindNumProfilP (CBCompSimul1.Text)
1785
      else
1786
        Profil := -1 ;
1787
      if RBCompElem.Checked and RBCompSeqAli.Checked
1788
      then // S?quence alimentaire
1789
        SeqAli := FindNumSeqAliP (CBCompSimul1.Text)
1790
      else
1791
        SeqAli := -1 ;
1792
      if RBCompElem.Checked and RBCompRation.Checked
1793
      then // Plan de rationnement
1794
        Ration := FindNumRationP (CBCompSimul1.Text)
1795
      else
1796
        Ration := -1 ;
1797
    end
1798
    else
1799
      Ok := FALSE ;
1800
  // Simulation 2
1801
  with TabSimulP[2] do
1802
    if ChkCompSimul2.Checked and (CBCompSimul2.ItemIndex <> -1)
1803
    then
1804
    begin
1805
      Ok := TRUE ;
1806
      if RBCompSimul.Checked
1807
      then // Simulations simples
1808
        Simul := FindNumSimulP (CBCompSimul2.Text)
1809
      else // Un ?l?ment d'une simulation
1810
        Simul := FindNumSimulP (CBCompSimulRef.Text) ;
1811
      if RBCompElem.Checked and RBCompProfil.Checked
1812
      then // Profil animal
1813
        Profil := FindNumProfilP (CBCompSimul2.Text)
1814
      else
1815
        Profil := -1 ;
1816
      if RBCompElem.Checked and RBCompSeqAli.Checked
1817
      then // S?quence alimentaire
1818
        SeqAli := FindNumSeqAliP (CBCompSimul2.Text)
1819
      else
1820
        SeqAli := -1 ;
1821
      if RBCompElem.Checked and RBCompRation.Checked
1822
      then // Plan de rationnement
1823
        Ration := FindNumRationP (CBCompSimul2.Text)
1824
      else
1825
        Ration := -1 ;
1826
    end
1827
    else
1828
      Ok := FALSE ;
1829
  // Simulation 3
1830
  with TabSimulP[3] do
1831
    if ChkCompSimul3.Checked and (CBCompSimul3.ItemIndex <> -1)
1832
    then
1833
    begin
1834
      Ok := TRUE ;
1835
      if RBCompSimul.Checked
1836
      then // Simulations simples
1837
        Simul := FindNumSimulP (CBCompSimul3.Text)
1838
      else // Un ?l?ment d'une simulation
1839
        Simul := FindNumSimulP (CBCompSimulRef.Text) ;
1840
      if RBCompElem.Checked and RBCompProfil.Checked
1841
      then // Profil animal
1842
        Profil := FindNumProfilP (CBCompSimul3.Text)
1843
      else
1844
        Profil := -1 ;
1845
      if RBCompElem.Checked and RBCompSeqAli.Checked
1846
      then // S?quence alimentaire
1847
        SeqAli := FindNumSeqAliP (CBCompSimul3.Text)
1848
      else
1849
        SeqAli := -1 ;
1850
      if RBCompElem.Checked and RBCompRation.Checked
1851
      then // Plan de rationnement
1852
        Ration := FindNumRationP (CBCompSimul3.Text)
1853
      else
1854
        Ration := -1 ;
1855
    end
1856
    else
1857
      Ok := FALSE ;
1858
  // Simulation 4
1859
  with TabSimulP[4] do
1860
    if ChkCompSimul4.Checked and (CBCompSimul4.ItemIndex <> -1)
1861
    then
1862
    begin
1863
      Ok := TRUE ;
1864
      if RBCompSimul.Checked
1865
      then // Simulations simples
1866
        Simul := FindNumSimulP (CBCompSimul4.Text)
1867
      else // Un ?l?ment d'une simulation
1868
        Simul := FindNumSimulP (CBCompSimulRef.Text) ;
1869
      if RBCompElem.Checked and RBCompProfil.Checked
1870
      then // Profil animal
1871
        Profil := FindNumProfilP (CBCompSimul4.Text)
1872
      else
1873
        Profil := -1 ;
1874
      if RBCompElem.Checked and RBCompSeqAli.Checked
1875
      then // S?quence alimentaire
1876
        SeqAli := FindNumSeqAliP (CBCompSimul4.Text)
1877
      else
1878
        SeqAli := -1 ;
1879
      if RBCompElem.Checked and RBCompRation.Checked
1880
      then // Plan de rationnement
1881
        Ration := FindNumRationP (CBCompSimul4.Text)
1882
      else
1883
        Ration := -1 ;
1884
    end
1885
    else
1886
      Ok := FALSE ;
1887
  // Simulation 5
1888
  with TabSimulP[5] do
1889
    if ChkCompSimul5.Checked and (CBCompSimul5.ItemIndex <> -1)
1890
    then
1891
    begin
1892
      Ok := TRUE ;
1893
      if RBCompSimul.Checked
1894
      then // Simulations simples
1895
        Simul := FindNumSimulP (CBCompSimul5.Text)
1896
      else // Un ?l?ment d'une simulation
1897
        Simul := FindNumSimulP (CBCompSimulRef.Text) ;
1898
      if RBCompElem.Checked and RBCompProfil.Checked
1899
      then // Profil animal
1900
        Profil := FindNumProfilP (CBCompSimul5.Text)
1901
      else
1902
        Profil := -1 ;
1903
      if RBCompElem.Checked and RBCompSeqAli.Checked
1904
      then // S?quence alimentaire
1905
        SeqAli := FindNumSeqAliP (CBCompSimul5.Text)
1906
      else
1907
        SeqAli := -1 ;
1908
      if RBCompElem.Checked and RBCompRation.Checked
1909
      then // Plan de rationnement
1910
        Ration := FindNumRationP (CBCompSimul5.Text)
1911
      else
1912
        Ration := -1 ;
1913
    end
1914
    else
1915
      Ok := FALSE ;
1916
  // Calcul des simulations
1917
  for i := 1 to 5 do
1918
    with TabSimulP[i] do
1919
      if Ok
1920
      then
1921
      begin
1922
        New(Result);
1923
        CalcSimulP(Simul, Profil, SeqAli, Ration, -1, 1, {1,} Result);
1924
      end ;
1925
  FCompSimulP := TFCompSimulP.Create(Self);
1926
  FCompSimulP.ShowModal;
1927
  FCompSimulP.Release;
1928
  for i := 1 to 5 do
1929
    with TabSimulP[i] do
1930
      if Ok then Dispose(Result);
1931
  Modal := False;
1932
end;
1933

    
1934
procedure TFSimulP.BBRapCompSimulClick(Sender: TObject);
1935
var
1936
  i: integer ;
1937
begin
1938
  Modal := True;
1939
  // Simulation 1
1940
  with TabSimulP[1] do
1941
    if ChkCompSimul1.Checked and (CBCompSimul1.ItemIndex <> -1)
1942
    then
1943
    begin
1944
      Ok := TRUE ;
1945
      if RBCompSimul.Checked
1946
      then // Simulations simples
1947
        Simul := FindNumSimulP (CBCompSimul1.Text)
1948
      else // Un ?l?ment d'une simulation
1949
        Simul := FindNumSimulP (CBCompSimulRef.Text) ;
1950
      if RBCompElem.Checked and RBCompProfil.Checked
1951
      then // Profil animal
1952
        Profil := FindNumProfilP (CBCompSimul1.Text)
1953
      else
1954
        Profil := -1 ;
1955
      if RBCompElem.Checked and RBCompSeqAli.Checked
1956
      then // S?quence alimentaire
1957
        SeqAli := FindNumSeqAliP (CBCompSimul1.Text)
1958
      else
1959
        SeqAli := -1 ;
1960
      if RBCompElem.Checked and RBCompRation.Checked
1961
      then // Plan de rationnement
1962
        Ration := FindNumRationP (CBCompSimul1.Text)
1963
      else
1964
        Ration := -1 ;
1965
    end
1966
    else
1967
      Ok := FALSE ;
1968
  // Simulation 2
1969
  with TabSimulP[2] do
1970
    if ChkCompSimul2.Checked and (CBCompSimul2.ItemIndex <> -1)
1971
    then
1972
    begin
1973
      Ok := TRUE ;
1974
      if RBCompSimul.Checked
1975
      then // Simulations simples
1976
        Simul := FindNumSimulP (CBCompSimul2.Text)
1977
      else // Un ?l?ment d'une simulation
1978
        Simul := FindNumSimulP (CBCompSimulRef.Text) ;
1979
      if RBCompElem.Checked and RBCompProfil.Checked
1980
      then // Profil animal
1981
        Profil := FindNumProfilP (CBCompSimul2.Text)
1982
      else
1983
        Profil := -1 ;
1984
      if RBCompElem.Checked and RBCompSeqAli.Checked
1985
      then // S?quence alimentaire
1986
        SeqAli := FindNumSeqAliP (CBCompSimul2.Text)
1987
      else
1988
        SeqAli := -1 ;
1989
      if RBCompElem.Checked and RBCompRation.Checked
1990
      then // Plan de rationnement
1991
        Ration := FindNumRationP (CBCompSimul2.Text)
1992
      else
1993
        Ration := -1 ;
1994
    end
1995
    else
1996
      Ok := FALSE ;
1997
  // Simulation 3
1998
  with TabSimulP[3] do
1999
    if ChkCompSimul3.Checked and (CBCompSimul3.ItemIndex <> -1)
2000
    then
2001
    begin
2002
      Ok := TRUE ;
2003
      if RBCompSimul.Checked
2004
      then // Simulations simples
2005
        Simul := FindNumSimulP (CBCompSimul3.Text)
2006
      else // Un ?l?ment d'une simulation
2007
        Simul := FindNumSimulP (CBCompSimulRef.Text) ;
2008
      if RBCompElem.Checked and RBCompProfil.Checked
2009
      then // Profil animal
2010
        Profil := FindNumProfilP (CBCompSimul3.Text)
2011
      else
2012
        Profil := -1 ;
2013
      if RBCompElem.Checked and RBCompSeqAli.Checked
2014
      then // S?quence alimentaire
2015
        SeqAli := FindNumSeqAliP (CBCompSimul3.Text)
2016
      else
2017
        SeqAli := -1 ;
2018
      if RBCompElem.Checked and RBCompRation.Checked
2019
      then // Plan de rationnement
2020
        Ration := FindNumRationP (CBCompSimul3.Text)
2021
      else
2022
        Ration := -1 ;
2023
    end
2024
    else
2025
      Ok := FALSE ;
2026
  // Simulation 4
2027
  with TabSimulP[4] do
2028
    if ChkCompSimul4.Checked and (CBCompSimul4.ItemIndex <> -1)
2029
    then
2030
    begin
2031
      Ok := TRUE ;
2032
      if RBCompSimul.Checked
2033
      then // Simulations simples
2034
        Simul := FindNumSimulP (CBCompSimul4.Text)
2035
      else // Un ?l?ment d'une simulation
2036
        Simul := FindNumSimulP (CBCompSimulRef.Text) ;
2037
      if RBCompElem.Checked and RBCompProfil.Checked
2038
      then // Profil animal
2039
        Profil := FindNumProfilP (CBCompSimul4.Text)
2040
      else
2041
        Profil := -1 ;
2042
      if RBCompElem.Checked and RBCompSeqAli.Checked
2043
      then // S?quence alimentaire
2044
        SeqAli := FindNumSeqAliP (CBCompSimul4.Text)
2045
      else
2046
        SeqAli := -1 ;
2047
      if RBCompElem.Checked and RBCompRation.Checked
2048
      then // Plan de rationnement
2049
        Ration := FindNumRationP (CBCompSimul4.Text)
2050
      else
2051
        Ration := -1 ;
2052
    end
2053
    else
2054
      Ok := FALSE ;
2055
  // Simulation 5
2056
  with TabSimulP[5] do
2057
    if ChkCompSimul5.Checked and (CBCompSimul5.ItemIndex <> -1)
2058
    then
2059
    begin
2060
      Ok := TRUE ;
2061
      if RBCompSimul.Checked
2062
      then // Simulations simples
2063
        Simul := FindNumSimulP (CBCompSimul5.Text)
2064
      else // Un ?l?ment d'une simulation
2065
        Simul := FindNumSimulP (CBCompSimulRef.Text) ;
2066
      if RBCompElem.Checked and RBCompProfil.Checked
2067
      then // Profil animal
2068
        Profil := FindNumProfilP (CBCompSimul5.Text)
2069
      else
2070
        Profil := -1 ;
2071
      if RBCompElem.Checked and RBCompSeqAli.Checked
2072
      then // S?quence alimentaire
2073
        SeqAli := FindNumSeqAliP (CBCompSimul5.Text)
2074
      else
2075
        SeqAli := -1 ;
2076
      if RBCompElem.Checked and RBCompRation.Checked
2077
      then // Plan de rationnement
2078
        Ration := FindNumRationP (CBCompSimul5.Text)
2079
      else
2080
        Ration := -1 ;
2081
    end
2082
    else
2083
      Ok := FALSE ;
2084
  // Calcul des simulations
2085
  for i := 1 to 5 do
2086
    with TabSimulP[i] do
2087
      if Ok
2088
      then
2089
      begin
2090
        New(Result);
2091
        CalcSimulP(Simul, Profil, SeqAli, Ration, -1, 1, {1,} Result);
2092
      end;
2093
  FRapCompSimulP := TFRapCompSimulP.Create(Self);
2094
  FRapCompSimulP.QRRapport.PreviewModal;
2095
  FRapCompSimulP.Release;
2096
  for i := 1 to 5 do
2097
    with TabSimulP[i] do
2098
      if Ok then Dispose(Result);
2099
  Modal := False;
2100
end;
2101

    
2102
procedure TFSimulP.BBTabCompSimulClick(Sender: TObject);
2103
var
2104
  vExcel, vWorkbook, vWorksheet, vCell: Variant;
2105
  aFileName, aSheetName, aValue: String;
2106
  aLig, aCol, i, j: Integer;
2107
  t: Double;
2108
begin
2109
  Modal := True;
2110
  // Simulation 1
2111
  with TabSimulP[1] do
2112
    if ChkCompSimul1.Checked and (CBCompSimul1.ItemIndex <> -1)
2113
    then
2114
    begin
2115
      Ok := True;
2116
      if RBCompSimul.Checked
2117
      then // Simulations simples
2118
        Simul := FindNumSimulP(CBCompSimul1.Text)
2119
      else // Un ?l?ment d'une simulation
2120
        Simul := FindNumSimulP(CBCompSimulRef.Text);
2121
      if RBCompElem.Checked and RBCompProfil.Checked
2122
      then // Profil animal
2123
        Profil := FindNumProfilP(CBCompSimul1.Text)
2124
      else
2125
        Profil := -1;
2126
      if RBCompElem.Checked and RBCompSeqAli.Checked
2127
      then // S?quence alimentaire
2128
        SeqAli := FindNumSeqAliP(CBCompSimul1.Text)
2129
      else
2130
        SeqAli := -1;
2131
      if RBCompElem.Checked and RBCompRation.Checked
2132
      then // Plan de rationnement
2133
        Ration := FindNumRationP(CBCompSimul1.Text)
2134
      else
2135
        Ration := -1;
2136
    end
2137
    else
2138
      Ok := False;
2139
  // Simulation 2
2140
  with TabSimulP[2] do
2141
    if ChkCompSimul2.Checked and (CBCompSimul2.ItemIndex <> -1)
2142
    then
2143
    begin
2144
      Ok := True ;
2145
      if RBCompSimul.Checked
2146
      then // Simulations simples
2147
        Simul := FindNumSimulP(CBCompSimul2.Text)
2148
      else // Un ?l?ment d'une simulation
2149
        Simul := FindNumSimulP(CBCompSimulRef.Text);
2150
      if RBCompElem.Checked and RBCompProfil.Checked
2151
      then // Profil animal
2152
        Profil := FindNumProfilP(CBCompSimul2.Text)
2153
      else
2154
        Profil := -1;
2155
      if RBCompElem.Checked and RBCompSeqAli.Checked
2156
      then // S?quence alimentaire
2157
        SeqAli := FindNumSeqAliP(CBCompSimul2.Text)
2158
      else
2159
        SeqAli := -1;
2160
      if RBCompElem.Checked and RBCompRation.Checked
2161
      then // Plan de rationnement
2162
        Ration := FindNumRationP(CBCompSimul2.Text)
2163
      else
2164
        Ration := -1;
2165
    end
2166
    else
2167
      Ok := False ;
2168
  // Simulation 3
2169
  with TabSimulP[3] do
2170
    if ChkCompSimul3.Checked and (CBCompSimul3.ItemIndex <> -1)
2171
    then
2172
    begin
2173
      Ok := True ;
2174
      if RBCompSimul.Checked
2175
      then // Simulations simples
2176
        Simul := FindNumSimulP(CBCompSimul3.Text)
2177
      else // Un ?l?ment d'une simulation
2178
        Simul := FindNumSimulP(CBCompSimulRef.Text);
2179
      if RBCompElem.Checked and RBCompProfil.Checked
2180
      then // Profil animal
2181
        Profil := FindNumProfilP(CBCompSimul3.Text)
2182
      else
2183
        Profil := -1;
2184
      if RBCompElem.Checked and RBCompSeqAli.Checked
2185
      then // S?quence alimentaire
2186
        SeqAli := FindNumSeqAliP(CBCompSimul3.Text)
2187
      else
2188
        SeqAli := -1;
2189
      if RBCompElem.Checked and RBCompRation.Checked
2190
      then // Plan de rationnement
2191
        Ration := FindNumRationP(CBCompSimul3.Text)
2192
      else
2193
        Ration := -1;
2194
    end
2195
    else
2196
      Ok := False ;
2197
  // Simulation 4
2198
  with TabSimulP[4] do
2199
    if ChkCompSimul4.Checked and (CBCompSimul4.ItemIndex <> -1)
2200
    then
2201
    begin
2202
      Ok := True ;
2203
      if RBCompSimul.Checked
2204
      then // Simulations simples
2205
        Simul := FindNumSimulP(CBCompSimul4.Text)
2206
      else // Un ?l?ment d'une simulation
2207
        Simul := FindNumSimulP(CBCompSimulRef.Text);
2208
      if RBCompElem.Checked and RBCompProfil.Checked
2209
      then // Profil animal
2210
        Profil := FindNumProfilP(CBCompSimul4.Text)
2211
      else
2212
        Profil := -1;
2213
      if RBCompElem.Checked and RBCompSeqAli.Checked
2214
      then // S?quence alimentaire
2215
        SeqAli := FindNumSeqAliP(CBCompSimul4.Text)
2216
      else
2217
        SeqAli := -1;
2218
      if RBCompElem.Checked and RBCompRation.Checked
2219
      then // Plan de rationnement
2220
        Ration := FindNumRationP(CBCompSimul4.Text)
2221
      else
2222
        Ration := -1;
2223
    end
2224
    else
2225
      Ok := False ;
2226
  // Simulation 5
2227
  with TabSimulP[5] do
2228
    if ChkCompSimul5.Checked and (CBCompSimul5.ItemIndex <> -1)
2229
    then
2230
    begin
2231
      Ok := True ;
2232
      if RBCompSimul.Checked
2233
      then // Simulations simples
2234
        Simul := FindNumSimulP(CBCompSimul5.Text)
2235
      else // Un ?l?ment d'une simulation
2236
        Simul := FindNumSimulP(CBCompSimulRef.Text);
2237
      if RBCompElem.Checked and RBCompProfil.Checked
2238
      then // Profil animal
2239
        Profil := FindNumProfilP(CBCompSimul5.Text)
2240
      else
2241
        Profil := -1;
2242
      if RBCompElem.Checked and RBCompSeqAli.Checked
2243
      then // S?quence alimentaire
2244
        SeqAli := FindNumSeqAliP(CBCompSimul5.Text)
2245
      else
2246
        SeqAli := -1;
2247
      if RBCompElem.Checked and RBCompRation.Checked
2248
      then // Plan de rationnement
2249
        Ration := FindNumRationP(CBCompSimul5.Text)
2250
      else
2251
        Ration := -1;
2252
    end
2253
    else
2254
      Ok := False;
2255
  // Calcul des simulations
2256
  for i := 1 to 5 do
2257
    with TabSimulP[i] do
2258
      if Ok
2259
      then
2260
      begin
2261
        New(Result);
2262
        CalcSimulP(Simul, Profil, SeqAli, Ration, -1, 1, {1,} Result);
2263
      end;
2264
  try // connexion ? une instance existante
2265
    vExcel := GetActiveOleObject('Excel.Application');
2266
  except
2267
    try // ouverture d'une nouvelle instance
2268
      vExcel := CreateOleObject('Excel.Application');
2269
    except
2270
      MessageDlg(MsgExcel, mtError, [mbOK], 0);
2271
      Exit;
2272
    end;
2273
  end;
2274
  vExcel.Visible:= True;
2275
  aFileName := ExcelFile;
2276
  try // utilisation d'un classeur ouvert
2277
    vWorkbook := vExcel.Workbooks[ExtractFileName(aFileName)];
2278
    vWorkbook.Activate;
2279
    vWorkbook.SaveAs(aFileName);
2280
  except
2281
    try // ouverture d'un fichier
2282
      vWorkbook := vExcel.Workbooks.Open(aFileName);
2283
    except // cr?ation d'un fichier
2284
      vWorkbook := vExcel.Workbooks.Add;
2285
      vWorkbook.SaveAs(aFileName);
2286
    end;
2287
  end;
2288
  aSheetName := Caption;
2289
  try // activation d'une feuille existante
2290
    vWorksheet := vWorkbook.Worksheets[aSheetName];
2291
    vWorksheet.Activate;
2292
  except // cr?ation d'une feuille
2293
    vWorksheet := vWorkbook.Worksheets.Add;
2294
    vWorksheet.Name := aSheetName;
2295
  end;
2296
  for aLig := 1 to 6 do
2297
    for aCol := 1 to 16 do
2298
    begin
2299
      vCell := vWorksheet.Cells[aLig, aCol];
2300
      case aLig of
2301
        1: // Ligne de titre
2302
        begin
2303
          case aCol of
2304
            1: // Simulation
2305
              aValue := GBSimul.Caption;
2306
            2: // Profil animal
2307
              aValue := LProfil.Caption;
2308
            3: // S?quence alimentaire
2309
              aValue := LSeqAli.Caption;
2310
            4: // Plan de rationnement
2311
              aValue := LRation.Caption;
2312
            5: // Mode de fin
2313
              aValue := StrModeFin;
2314
            6: // Age initial
2315
              aValue := LAgeInit.Hint;
2316
            7: // Age final
2317
              aValue := Format('%s (%s)', [_('Final age'), _('d')]);
2318
            8: // Poids vif initial
2319
              aValue := LPVInit.Hint;
2320
            9: // Poids vif final
2321
              aValue := RBPVFin.Hint;
2322
            10: // Poids de prot?ines initial
2323
              aValue := RBProtInit.Hint;
2324
            11: // Poids de prot?ines final
2325
              aValue := Format('%s (%s)', [_('Final protein mass'), _('kg')]);
2326
            12: // Poids de lipides initial
2327
              aValue := RBLipInit.Hint;
2328
            13: // Poids de lipides final
2329
              aValue := Format('%s (%s)', [_('Final lipid mass'), _('kg')]);
2330
            14: // Aliment distribu?
2331
              aValue := Format('%s (%s)', [_('Feed usage'), _('kg')]);
2332
            15: // Co?t alimentaire
2333
              aValue := Format('%s (%s)', [_('Feed cost'), CurrencySign]);
2334
            16: // Rendement carcasse
2335
              aValue := Format('%s (%%)', [_('Dressing')]);
2336
          end;
2337
          vCell.Value := aValue;
2338
        end;
2339
        else // Donn?es des simulations
2340
          with TabSimulP[aLig - 1] do
2341
            if Ok
2342
            then
2343
            begin
2344
              PSimulP := ListSimulP[FindIdxSimulP(FindNomSimulP(Simul))];
2345
              if Profil = -1
2346
              then // Profil de la simulation
2347
                PProfilP := ListProfilP[FindIdxProfilP(FindNomProfilP(PSimulP.Profil))]
2348
              else
2349
                PProfilP := ListProfilP[FindIdxProfilP(FindNomProfilP(Profil))];
2350
              case aCol of
2351
                1: // Simulation
2352
                  if RBCompSimul.Checked
2353
                  then // Simulations simples
2354
                    aValue := PSimulP.Nom
2355
                  else // Un ?l?ment d'une simulation
2356
                    aValue := '';
2357
                2: // Profil animal
2358
                  if RBCompElem.Checked and RBCompProfil.Checked
2359
                  then // Profil animal
2360
                    aValue := FindNomProfilP(Profil)
2361
                  else
2362
                    aValue := FindNomProfilP(PSimulP.Profil);
2363
                3: // S?quence alimentaire
2364
                  if RBCompElem.Checked and RBCompSeqAli.Checked
2365
                  then // S?quence alimentaire
2366
                    aValue := FindNomSeqAliP(SeqAli)
2367
                  else
2368
                    aValue := FindNomSeqAliP(PSimulP.SeqAli);
2369
                4: // Plan de rationnement
2370
                  if RBCompElem.Checked and RBCompRation.Checked
2371
                  then // Plan de rationnement
2372
                    aValue := FindNomRationP(Ration)
2373
                  else
2374
                    aValue := FindNomRationP(PSimulP.Ration);
2375
                5: // Mode de fin
2376
                  if PSimulP.FinProfil
2377
                  then // Profil
2378
                    if PProfilP.ModeFin = 0
2379
                    then // Dur?e
2380
                      aValue := RBDuree.Caption
2381
                    else // Poids vif
2382
                      aValue := RBPVFin.Caption
2383
                  else // Simulation
2384
                    if PSimulP.ModeFin = 0
2385
                    then // Dur?e
2386
                      aValue := RBDuree.Caption
2387
                    else // Poids vif
2388
                      aValue := RBPVFin.Caption;
2389
                6: // Age initial
2390
                  aValue := FloatToStrF(Result.TabResult[1, 1], ffFixed, 15, 15);
2391
                7: // Age final
2392
                  aValue := FloatToStrF(Result.TabResult[1, Result.NbJSim] + 1, ffFixed, 15, 15);
2393
                8: // Poids vif initial
2394
                  aValue := FloatToStrF(Result.TabResult[2, 1], ffFixed, 15, 15);
2395
                9: // Poids vif final
2396
                  aValue := FloatToStrF(Result.TabResult[2, Result.NbJSim] + Result.TabResult[84, Result.NbJSim], ffFixed, 15, 15);
2397
                10: // Poids de prot?ines initial
2398
                  aValue := FloatToStrF(Result.TabResult[49, 1], ffFixed, 15, 15);
2399
                11: // Poids de prot?ines final
2400
                  aValue := FloatToStrF(Result.TabResult[49, Result.NbJSim] + Result.TabResult[79, Result.NbJSim] / 1000, ffFixed, 15, 15);
2401
                12: // Poids de lipides initial
2402
                  aValue := FloatToStrF(Result.TabResult[50, 1], ffFixed, 15, 15);
2403
                13: // Poids de lipides final
2404
                  aValue := FloatToStrF(Result.TabResult[50, Result.NbJSim] + Result.TabResult[80, Result.NbJSim] / 1000, ffFixed, 15, 15);
2405
                14: // Aliment distribu?
2406
                begin
2407
                  t := 0;
2408
                  for j := 1 to Result.NbJSim do
2409
                    t := t + Result.TabResult[113, j];
2410
                  aValue := FloatToStrF(t, ffFixed, 15, 2);
2411
                end;
2412
                15: // Co?t alimentaire
2413
                begin
2414
                  t := 0;
2415
                  for j := 1 to Result.NbJSim do
2416
                  begin
2417
                    if Result.TabResult[7, j] <> -1
2418
                    then // Aliment 1
2419
                    begin
2420
                      PAliment := ListAliment[FindIdxAliment(FindNomAliment(Trunc(Result.TabResult[7, j])))];
2421
                      t := t + (Result.TabResult[11, j] * Result.TabResult[9, j] / 100) * PAliment.Prix / 1000;
2422
                    end;
2423
                    if Result.TabResult[8, j] <> -1
2424
                    then // Aliment 2
2425
                    begin
2426
                      PAliment := ListAliment[FindIdxAliment(FindNomAliment(Trunc(Result.TabResult[8, j])))];
2427
                      t := t + (Result.TabResult[11, j] * Result.TabResult[10, j] / 100) * PAliment.Prix / 1000;
2428
                    end;
2429
                  end;
2430
                  aValue := FloatToStrF(t, ffFixed, 15, 2);
2431
                end;
2432
                16: // Rendement carcasse
2433
                  aValue := FloatToStrF(CalcRC(PProfilP.PVFin, CalcRCStd(PProfilP.PVFin, PProfilP.Carcasse), Result.TabResult[2, Result.NbJSim] + Result.TabResult[84, Result.NbJSim]) * 100, ffFixed, 15, 15);
2434
              end;
2435
              vCell.Value := aValue;
2436
            end
2437
            else // Effacement
2438
              vCell.Value := '';
2439
      end;
2440
    end;
2441
  for i := 1 to 5 do
2442
    with TabSimulP[i] do
2443
      if Ok then Dispose(Result);
2444
  Modal := False;
2445
end;
2446

    
2447
procedure TFSimulP.ValidBBCompSimul;
2448
begin
2449
  CBCompSimul1.Enabled := (CBCompSimulRef.ItemIndex <> -1)
2450
    or RBCompSimul.Checked ;
2451
  CBCompSimul2.Enabled := CBCompSimul1.Enabled ;
2452
  CBCompSimul3.Enabled := CBCompSimul1.Enabled ;
2453
  CBCompSimul4.Enabled := CBCompSimul1.Enabled ;
2454
  CBCompSimul5.Enabled := CBCompSimul1.Enabled ;
2455
  BBCompSimul.Enabled := CBCompSimul1.Enabled
2456
    and (((CBCompSimul1.ItemIndex <> -1) and ChkCompSimul1.Checked)
2457
      or ((CBCompSimul2.ItemIndex <> -1) and ChkCompSimul2.Checked)
2458
      or ((CBCompSimul3.ItemIndex <> -1) and ChkCompSimul3.Checked)
2459
      or ((CBCompSimul4.ItemIndex <> -1) and ChkCompSimul4.Checked)
2460
      or ((CBCompSimul5.ItemIndex <> -1) and ChkCompSimul5.Checked)) ;
2461
  BBRapCompSimul.Enabled := BBCompSimul.Enabled ;
2462
  BBTabCompSimul.Enabled := BBCompSimul.Enabled ;
2463
end ;
2464

    
2465
// Sensibilit?
2466

    
2467
procedure TFSimulP.CBSensSimulChange (Sender : TObject) ;
2468
begin
2469
  if CBSensSimul.ItemIndex = -1
2470
  then
2471
    CBSensSimul.Hint := ''
2472
  else
2473
  begin
2474
    PSimulP := ListSimulP[FindIdxSimulP (CBSensSimul.Text)] ;
2475
    CBSensSimul.Hint := PSimulP.Memo ;
2476
  end ;
2477
  ValidBBSensSimul ;
2478
end ;
2479

    
2480
procedure TFSimulP.CBVariableChange(Sender: TObject);
2481
begin
2482
  ValidBBSensSimul ;
2483
end;
2484

    
2485
procedure TFSimulP.BBSensSimulClick(Sender: TObject);
2486
var
2487
  k: integer;
2488
begin
2489
  Modal := True;
2490
  for k := 1 to 5 do
2491
    with TabSimulP[k] do
2492
    begin
2493
      Ok := TRUE;
2494
      Simul := FindNumSimulP(CBSensSimul.Text);
2495
      Profil := -1;
2496
      SeqAli := -1;
2497
      Ration := -1;
2498
      if CBVariable.ItemIndex = 6
2499
      then // Gaspillage
2500
        case k of
2501
          1: Variation := PBVariation.AsFloat * 2 / 100;
2502
          2: Variation := PBVariation.AsFloat / 100;
2503
          4: Variation := -PBVariation.AsFloat / 100;
2504
          5: Variation := -PBVariation.AsFloat * 2 / 100;
2505
          else Variation := 0;
2506
        end
2507
      else
2508
        case k of
2509
          1: Variation := 1 + 2 * PBVariation.AsFloat / 100;
2510
          2: Variation := 1 + PBVariation.AsFloat / 100;
2511
          4: Variation := 1 - PBVariation.AsFloat / 100;
2512
          5: Variation := 1 - 2 * PBVariation.AsFloat / 100;
2513
          else Variation := 1;
2514
        end;
2515
      // Calcul des simulations
2516
      New(Result);
2517
      CalcSimulP(Simul, -1, -1, -1, CBVariable.ItemIndex, Variation, {1,} Result);
2518
    end;
2519
  FCompSimulP := TFCompSimulP.Create(Self);
2520
  FCompSimulP.ShowModal;
2521
  FCompSimulP.Release;
2522
  for k := 1 to 5 do
2523
    Dispose(TabSimulP[k].Result);
2524
  Modal := False;
2525
end;
2526

    
2527
procedure TFSimulP.BBRapSensSimulClick(Sender: TObject);
2528
var
2529
  k: integer;
2530
begin
2531
  Modal := True;
2532
  for k := 1 to 5 do
2533
    with TabSimulP[k] do
2534
    begin
2535
      Ok := TRUE;
2536
      Simul := FindNumSimulP(CBSensSimul.Text);
2537
      Profil := -1;
2538
      SeqAli := -1;
2539
      Ration := -1;
2540
      if CBVariable.ItemIndex = 6
2541
      then // Gaspillage
2542
        case k of
2543
          1: Variation := PBVariation.AsFloat * 2 / 100;
2544
          2: Variation := PBVariation.AsFloat / 100;
2545
          4: Variation := -PBVariation.AsFloat / 100;
2546
          5: Variation := -PBVariation.AsFloat * 2 / 100;
2547
          else Variation := 0;
2548
        end
2549
      else
2550
        case k of
2551
          1: Variation := 1 + 2 * PBVariation.AsFloat / 100;
2552
          2: Variation := 1 + PBVariation.AsFloat / 100;
2553
          4: Variation := 1 - PBVariation.AsFloat / 100;
2554
          5: Variation := 1 - 2 * PBVariation.AsFloat / 100;
2555
          else Variation := 1;
2556
        end;
2557
      // Calcul des simulations
2558
      New(Result);
2559
      CalcSimulP(Simul, -1, -1, -1, CBVariable.ItemIndex, Variation, {1,} Result);
2560
    end;
2561
  FRapSensSimulP := TFRapSensSimulP.Create(Self);
2562
  FRapSensSimulP.QRRapport.PreviewModal;
2563
  FRapSensSimulP.Release;
2564
  for k := 1 to 5 do
2565
    Dispose(TabSimulP[k].Result);
2566
  Modal := False;
2567
end;
2568

    
2569
procedure TFSimulP.BBTabSensSimulClick(Sender: TObject);
2570
var
2571
  vExcel, vWorkbook, vWorksheet, vCell: Variant;
2572
  aFileName, aSheetName, aValue: String;
2573
  aLig, aCol, i, j: Integer;
2574
  t: Double;
2575
begin
2576
  Modal := True;
2577
  for i := 1 to 5 do
2578
    with TabSimulP[i] do
2579
    begin
2580
      Ok := True;
2581
      Simul := FindNumSimulP(CBSensSimul.Text);
2582
      Profil := -1;
2583
      SeqAli := -1;
2584
      Ration := -1;
2585
      case i of
2586
        1: Variation := 1 + 2 * PBVariation.AsFloat / 100;
2587
        2: Variation := 1 + PBVariation.AsFloat / 100;
2588
        4: Variation := 1 - PBVariation.AsFloat / 100;
2589
        5: Variation := 1 - 2 * PBVariation.AsFloat / 100;
2590
        else Variation := 1;
2591
      end;
2592
      // Calcul des simulations
2593
      New(Result);
2594
      CalcSimulP(Simul, -1, -1, -1, CBVariable.ItemIndex, Variation, {1,} Result);
2595
    end;
2596
  try // connexion ? une instance existante
2597
    vExcel := GetActiveOleObject('Excel.Application');
2598
  except
2599
    try // ouverture d'une nouvelle instance
2600
      vExcel := CreateOleObject('Excel.Application');
2601
    except
2602
      MessageDlg(MsgExcel, mtError, [mbOK], 0);
2603
      Exit;
2604
    end;
2605
  end;
2606
  vExcel.Visible:= True;
2607
  aFileName := ExcelFile;
2608
  try // utilisation d'un classeur ouvert
2609
    vWorkbook := vExcel.Workbooks[ExtractFileName(aFileName)];
2610
    vWorkbook.Activate;
2611
    vWorkbook.SaveAs(aFileName);
2612
  except
2613
    try // ouverture d'un fichier
2614
      vWorkbook := vExcel.Workbooks.Open(aFileName);
2615
    except // cr?ation d'un fichier
2616
      vWorkbook := vExcel.Workbooks.Add;
2617
      vWorkbook.SaveAs(aFileName);
2618
    end;
2619
  end;
2620
  aSheetName := Caption;
2621
  try // activation d'une feuille existante
2622
    vWorksheet := vWorkbook.Worksheets[aSheetName];
2623
    vWorksheet.Activate;
2624
  except // cr?ation d'une feuille
2625
    vWorksheet := vWorkbook.Worksheets.Add;
2626
    vWorksheet.Name := aSheetName;
2627
  end;
2628
  for aLig := 1 to 6 do
2629
    for aCol := 1 to 16 do
2630
    begin
2631
      vCell := vWorksheet.Cells[aLig, aCol];
2632
      case aLig of
2633
        1: // Ligne de titre
2634
        begin
2635
          case aCol of
2636
            1: // Simulation
2637
              aValue := GBSimul.Caption;
2638
            2: // Profil animal
2639
              aValue := LProfil.Caption;
2640
            3: // S?quence alimentaire
2641
              aValue := LSeqAli.Caption;
2642
            4: // Plan de rationnement
2643
              aValue := LRation.Caption;
2644
            5: // Mode de fin
2645
              aValue := StrModeFin;
2646
            6: // Age initial
2647
              aValue := LAgeInit.Hint;
2648
            7: // Age final
2649
              aValue := Format('%s (%s)', [_('Final age'), _('d')]);
2650
            8: // Poids vif initial
2651
              aValue := LPVInit.Hint;
2652
            9: // Poids vif final
2653
              aValue := RBPVFin.Hint;
2654
            10: // Poids de prot?ines initial
2655
              aValue := RBProtInit.Hint;
2656
            11: // Poids de prot?ines final
2657
              aValue := Format('%s (%s)', [_('Final protein mass'), _('kg')]);
2658
            12: // Poids de lipides initial
2659
              aValue := RBLipInit.Hint;
2660
            13: // Poids de lipides final
2661
              aValue := Format('%s (%s)', [_('Final lipid mass'), _('kg')]);
2662
            14: // Aliment distribu?
2663
              aValue := Format('%s (%s)', [_('Feed usage'), _('kg')]);
2664
            15: // Co?t alimentaire
2665
              aValue := Format('%s (%s)', [_('Feed cost'), CurrencySign]);
2666
            16: // Rendement carcasse
2667
              aValue := Format('%s (%%)', [_('Dressing')]);
2668
          end;
2669
          vCell.Value := aValue;
2670
        end;
2671
        else // Donn?es des simulations
2672
          with TabSimulP[aLig - 1] do
2673
          begin
2674
            PSimulP := ListSimulP[FindIdxSimulP(FindNomSimulP(Simul))];
2675
            PProfilP := ListProfilP[FindIdxProfilP(FindNomProfilP(PSimulP.Profil))];
2676
            case aCol of
2677
              1: // Simulation
2678
                aValue := Format(StrSimulSens + ' (%1.0f%%)', [CBVariable.Items[CBVariable.ItemIndex], CBSensSimul.Text, Variation * 100]);
2679
              2: // Profil animal
2680
                aValue := FindNomProfilP(PSimulP.Profil);
2681
              3: // S?quence alimentaire
2682
                aValue := FindNomSeqAliP(PSimulP.SeqAli);
2683
              4: // Plan de rationnement
2684
                aValue := FindNomRationP(PSimulP.Ration);
2685
              5: // Mode de fin
2686
                if PSimulP.FinProfil
2687
                then // Profil
2688
                  if PProfilP.ModeFin = 0
2689
                  then // Dur?e
2690
                    aValue := RBDuree.Caption
2691
                  else // Poids vif
2692
                    aValue := RBPVFin.Caption
2693
                else // Simulation
2694
                  if PSimulP.ModeFin = 0
2695
                  then // Dur?e
2696
                    aValue := RBDuree.Caption
2697
                  else // Poids vif
2698
                    aValue := RBPVFin.Caption;
2699
              6: // Age initial
2700
                aValue := FloatToStrF(Result.TabResult[1, 1], ffFixed, 15, 15);
2701
              7: // Age final
2702
                aValue := FloatToStrF(Result.TabResult[1, Result.NbJSim] + 1, ffFixed, 15, 15);
2703
              8: // Poids vif initial
2704
                aValue := FloatToStrF(Result.TabResult[2, 1], ffFixed, 15, 15);
2705
              9: // Poids vif final
2706
                aValue := FloatToStrF(Result.TabResult[2, Result.NbJSim] + Result.TabResult[84, Result.NbJSim], ffFixed, 15, 15);
2707
              10: // Poids de prot?ines initial
2708
                aValue := FloatToStrF(Result.TabResult[49, 1], ffFixed, 15, 15);
2709
              11: // Poids de prot?ines final
2710
                aValue := FloatToStrF(Result.TabResult[49, Result.NbJSim] + Result.TabResult[79, Result.NbJSim] / 1000, ffFixed, 15, 15);
2711
              12: // Poids de lipides initial
2712
                aValue := FloatToStrF(Result.TabResult[50, 1], ffFixed, 15, 15);
2713
              13: // Poids de lipides final
2714
                aValue := FloatToStrF(Result.TabResult[50, Result.NbJSim] + Result.TabResult[80, Result.NbJSim] / 1000, ffFixed, 15, 15);
2715
              14: // Aliment distribu?
2716
              begin
2717
                t := 0;
2718
                for j := 1 to Result.NbJSim do
2719
                  t := t + Result.TabResult[113, j];
2720
                aValue := FloatToStrF(t, ffFixed, 15, 2);
2721
              end;
2722
              15: // Co?t alimentaire
2723
              begin
2724
                t := 0;
2725
                for j := 1 to Result.NbJSim do
2726
                begin
2727
                  if Result.TabResult[7, j] <> -1
2728
                  then // Aliment 1
2729
                  begin
2730
                    PAliment := ListAliment[FindIdxAliment(FindNomAliment(Trunc(Result.TabResult[7, j])))];
2731
                    t := t + (Result.TabResult[11, j] * Result.TabResult[9, j] / 100) * PAliment.Prix / 1000;
2732
                  end;
2733
                  if Result.TabResult[8, j] <> -1
2734
                  then // Aliment 2
2735
                  begin
2736
                    PAliment := ListAliment[FindIdxAliment(FindNomAliment(Trunc(Result.TabResult[8, j])))];
2737
                    t := t + (Result.TabResult[11, j] * Result.TabResult[10, j] / 100) * PAliment.Prix / 1000;
2738
                  end;
2739
                end;
2740
                aValue := FloatToStrF(t, ffFixed, 15, 2);
2741
              end;
2742
              16: // Rendement carcasse
2743
                aValue := FloatToStrF(CalcRC(PProfilP.PVFin, CalcRCStd(PProfilP.PVFin, PProfilP.Carcasse), Result.TabResult[2, Result.NbJSim] + Result.TabResult[84, Result.NbJSim]) * 100, ffFixed, 15, 15);
2744
            end;
2745
            vCell.Value := aValue;
2746
          end;
2747
      end;
2748
    end;
2749
  for i := 1 to 5 do
2750
    Dispose(TabSimulP[i].Result);
2751
  Modal := False;
2752
end;
2753

    
2754
procedure TFSimulP.ValidBBSensSimul;
2755
begin
2756
  BBSensSimul.Enabled :=  (CBSensSimul.ItemIndex <> -1) and (CBVariable.ItemIndex <> -1);
2757
  BBRapSensSimul.Enabled := BBSensSimul.Enabled;
2758
  BBTabSensSimul.Enabled := BBSensSimul.Enabled;
2759
end;
2760

    
2761
end.