Statistiques
| Révision:

root / UFProfilT.pas @ 3

Historique | Voir | Annoter | Télécharger (110,203 ko)

1 3 avalancogn
unit UFProfilT;
2
3
interface
4
5
uses
6
  Windows, Forms, Classes, Controls, StdCtrls, Buttons, ExtCtrls, ComCtrls,
7
  Gauges, Chart, Series, TeEngine, TeeProcs, PBNumEdit, PBSuperSpin,
8
  JvExControls, JvEnterTab, UVariables;
9
10
type
11
  TFProfilT = class(TForm)
12
    GBProfil: TGroupBox;
13
    SBAddProfil: TSpeedButton;
14
    SBDelProfil: TSpeedButton;
15
    CBProfil: TComboBox;
16
    PC: TPageControl;
17
    TSGraph: TTabSheet;
18
    TSAlim: TTabSheet;
19
    SBRename: TSpeedButton;
20
    SBComment: TSpeedButton;
21
    TSPortee: TTabSheet;
22
    TSTruie: TTabSheet;
23
    TSCalibr: TTabSheet;
24
    GBMiseBas: TGroupBox;
25
    LTruiePt1: TLabel;
26
    LTruiePt2: TLabel;
27
    LTruiePt3: TLabel;
28
    LTruiePt4: TLabel;
29
    LTruiePt5: TLabel;
30
    LTruiePt6: TLabel;
31
    LTruiePt7: TLabel;
32
    LTruiePt8: TLabel;
33
    LTruieTot: TLabel;
34
    PBPdsAvMBPt1: TPBNumEdit;
35
    PBPdsApMBPt1: TPBNumEdit;
36
    PBPdsAvMBPt2: TPBNumEdit;
37
    PBPdsAvMBPt3: TPBNumEdit;
38
    PBPdsAvMBPt4: TPBNumEdit;
39
    PBPdsAvMBPt5: TPBNumEdit;
40
    PBPdsAvMBPt6: TPBNumEdit;
41
    PBPdsAvMBPt7: TPBNumEdit;
42
    PBPdsAvMBPt8: TPBNumEdit;
43
    PBPdsAvMBTot: TPBNumEdit;
44
    PBPdsApMBPt2: TPBNumEdit;
45
    PBPdsApMBPt3: TPBNumEdit;
46
    PBPdsApMBPt4: TPBNumEdit;
47
    PBPdsApMBPt5: TPBNumEdit;
48
    PBPdsApMBPt6: TPBNumEdit;
49
    PBPdsApMBPt7: TPBNumEdit;
50
    PBPdsApMBPt8: TPBNumEdit;
51
    PBPdsApMBTot: TPBNumEdit;
52
    PTopTruie: TPanel;
53
    GBEffectif: TGroupBox;
54
    RBNbrEff: TRadioButton;
55
    RBPctEff: TRadioButton;
56
    PBNbrPt1: TPBNumEdit;
57
    PBPctPt1: TPBNumEdit;
58
    PBNbrPt2: TPBNumEdit;
59
    PBNbrPt3: TPBNumEdit;
60
    PBNbrPt4: TPBNumEdit;
61
    PBNbrPt5: TPBNumEdit;
62
    PBNbrPt6: TPBNumEdit;
63
    PBNbrPt7: TPBNumEdit;
64
    PBNbrPt8: TPBNumEdit;
65
    PBNbrTot: TPBNumEdit;
66
    PBPctPt2: TPBNumEdit;
67
    PBPctPt3: TPBNumEdit;
68
    PBPctPt4: TPBNumEdit;
69
    PBPctPt5: TPBNumEdit;
70
    PBPctPt6: TPBNumEdit;
71
    PBPctPt7: TPBNumEdit;
72
    PBPctPt8: TPBNumEdit;
73
    PBPctTot: TPBNumEdit;
74
    LPdsAvMB: TLabel;
75
    LP2MB: TLabel;
76
    PBP2MBPt1: TPBNumEdit;
77
    PBP2MBPt2: TPBNumEdit;
78
    PBP2MBPt3: TPBNumEdit;
79
    PBP2MBPt4: TPBNumEdit;
80
    PBP2MBPt5: TPBNumEdit;
81
    PBP2MBPt6: TPBNumEdit;
82
    PBP2MBPt7: TPBNumEdit;
83
    PBP2MBPt8: TPBNumEdit;
84
    PBP2MBTot: TPBNumEdit;
85
    GBSaillie: TGroupBox;
86
    LAgeSail: TLabel;
87
    LPdsSail: TLabel;
88
    LP2Sail: TLabel;
89
    PBAgeSailPt1: TPBNumEdit;
90
    PBPdsSailPt1: TPBNumEdit;
91
    PBAgeSailPt2: TPBNumEdit;
92
    PBAgeSailPt3: TPBNumEdit;
93
    PBAgeSailPt4: TPBNumEdit;
94
    PBAgeSailPt5: TPBNumEdit;
95
    PBAgeSailPt6: TPBNumEdit;
96
    PBAgeSailPt7: TPBNumEdit;
97
    PBAgeSailPt8: TPBNumEdit;
98
    PBAgeSailTot: TPBNumEdit;
99
    PBPdsSailPt2: TPBNumEdit;
100
    PBPdsSailPt3: TPBNumEdit;
101
    PBPdsSailPt4: TPBNumEdit;
102
    PBPdsSailPt5: TPBNumEdit;
103
    PBPdsSailPt6: TPBNumEdit;
104
    PBPdsSailPt7: TPBNumEdit;
105
    PBPdsSailPt8: TPBNumEdit;
106
    PBPdsSailTot: TPBNumEdit;
107
    PBP2SailPt1: TPBNumEdit;
108
    PBP2SailPt2: TPBNumEdit;
109
    PBP2SailPt3: TPBNumEdit;
110
    PBP2SailPt4: TPBNumEdit;
111
    PBP2SailPt5: TPBNumEdit;
112
    PBP2SailPt6: TPBNumEdit;
113
    PBP2SailPt7: TPBNumEdit;
114
    PBP2SailPt8: TPBNumEdit;
115
    PBP2SailTot: TPBNumEdit;
116
    ChkPdsApMB: TCheckBox;
117
    PTopPortee: TPanel;
118
    LPorteePt1: TLabel;
119
    LPorteePt2: TLabel;
120
    LPorteePt3: TLabel;
121
    LPorteePt4: TLabel;
122
    LPorteePt5: TLabel;
123
    LPorteePt6: TLabel;
124
    LPorteePt7: TLabel;
125
    LPorteePt8: TLabel;
126
    LPorteeTot: TLabel;
127
    GBNaissance: TGroupBox;
128
    LNbTot: TLabel;
129
    LNbVif: TLabel;
130
    LNbSev: TLabel;
131
    PBNbTotPt1: TPBNumEdit;
132
    PBNbVifPt1: TPBNumEdit;
133
    PBNbTotPt2: TPBNumEdit;
134
    PBNbTotPt3: TPBNumEdit;
135
    PBNbTotPt4: TPBNumEdit;
136
    PBNbTotPt5: TPBNumEdit;
137
    PBNbTotPt6: TPBNumEdit;
138
    PBNbTotPt7: TPBNumEdit;
139
    PBNbTotPt8: TPBNumEdit;
140
    PBNbTotTot: TPBNumEdit;
141
    PBNbVifPt2: TPBNumEdit;
142
    PBNbVifPt3: TPBNumEdit;
143
    PBNbVifPt4: TPBNumEdit;
144
    PBNbVifPt5: TPBNumEdit;
145
    PBNbVifPt6: TPBNumEdit;
146
    PBNbVifPt7: TPBNumEdit;
147
    PBNbVifPt8: TPBNumEdit;
148
    PBNbVifTot: TPBNumEdit;
149
    LPVNais: TLabel;
150
    PBPVNaisPt1: TPBNumEdit;
151
    PBPVNaisPt2: TPBNumEdit;
152
    PBPVNaisPt3: TPBNumEdit;
153
    PBPVNaisPt4: TPBNumEdit;
154
    PBPVNaisPt5: TPBNumEdit;
155
    PBPVNaisPt6: TPBNumEdit;
156
    PBPVNaisPt7: TPBNumEdit;
157
    PBPVNaisPt8: TPBNumEdit;
158
    PBPVNaisTot: TPBNumEdit;
159
    GBSevrage: TGroupBox;
160
    PBNbSevPt1: TPBNumEdit;
161
    PBNbSevPt2: TPBNumEdit;
162
    PBNbSevPt3: TPBNumEdit;
163
    PBNbSevPt4: TPBNumEdit;
164
    PBNbSevPt5: TPBNumEdit;
165
    PBNbSevPt6: TPBNumEdit;
166
    PBNbSevPt7: TPBNumEdit;
167
    PBNbSevPt8: TPBNumEdit;
168
    PBNbSevTot: TPBNumEdit;
169
    PBAgeSevPt1: TPBNumEdit;
170
    PBAgeSevPt2: TPBNumEdit;
171
    PBAgeSevPt3: TPBNumEdit;
172
    PBAgeSevPt4: TPBNumEdit;
173
    PBAgeSevPt5: TPBNumEdit;
174
    PBAgeSevPt6: TPBNumEdit;
175
    PBAgeSevPt7: TPBNumEdit;
176
    PBAgeSevPt8: TPBNumEdit;
177
    LPVSev: TLabel;
178
    PBPVSevPt1: TPBNumEdit;
179
    PBPVSevPt2: TPBNumEdit;
180
    PBPVSevPt3: TPBNumEdit;
181
    PBPVSevPt4: TPBNumEdit;
182
    PBPVSevPt5: TPBNumEdit;
183
    PBPVSevPt6: TPBNumEdit;
184
    PBPVSevPt7: TPBNumEdit;
185
    PBPVSevPt8: TPBNumEdit;
186
    PBPVSevTot: TPBNumEdit;
187
    GBGMQ: TGroupBox;
188
    LNaisSev: TLabel;
189
    PBGMQPt1: TPBNumEdit;
190
    PBGMQPt2: TPBNumEdit;
191
    PBGMQPt3: TPBNumEdit;
192
    PBGMQPt4: TPBNumEdit;
193
    PBGMQPt5: TPBNumEdit;
194
    PBGMQPt6: TPBNumEdit;
195
    PBGMQPt7: TPBNumEdit;
196
    PBGMQPt8: TPBNumEdit;
197
    PBGMQTot: TPBNumEdit;
198
    GBSeqAli: TGroupBox;
199
    CBSeqAli: TComboBox;
200
    GraphAli: TChart;
201
    GBAliRef: TGroupBox;
202
    LUnite: TLabel;
203
    CBUnite: TComboBox;
204
    LAliGest: TLabel;
205
    LAliLact: TLabel;
206
    LAliPt1: TLabel;
207
    LAliPt2: TLabel;
208
    LAliPt3: TLabel;
209
    LAliPt4: TLabel;
210
    LAliPt5: TLabel;
211
    LAliPt6: TLabel;
212
    LAliPt7: TLabel;
213
    LAliPt8: TLabel;
214
    LAliTot: TLabel;
215
    PBAliGestPt1: TPBNumEdit;
216
    PBAliGestPt2: TPBNumEdit;
217
    PBAliGestPt3: TPBNumEdit;
218
    PBAliGestPt4: TPBNumEdit;
219
    PBAliGestPt5: TPBNumEdit;
220
    PBAliGestPt6: TPBNumEdit;
221
    PBAliGestPt7: TPBNumEdit;
222
    PBAliGestPt8: TPBNumEdit;
223
    PBAliGestTot: TPBNumEdit;
224
    PBAliLactPt1: TPBNumEdit;
225
    PBAliLactPt2: TPBNumEdit;
226
    PBAliLactPt3: TPBNumEdit;
227
    PBAliLactPt4: TPBNumEdit;
228
    PBAliLactPt5: TPBNumEdit;
229
    PBAliLactPt6: TPBNumEdit;
230
    PBAliLactPt7: TPBNumEdit;
231
    PBAliLactPt8: TPBNumEdit;
232
    PBAliLactTot: TPBNumEdit;
233
    GBConfig: TGroupBox;
234
    CBOnglet: TComboBox;
235
    CBTruie: TComboBox;
236
    Graph: TChart;
237
    CBPortee: TComboBox;
238
    GBLoge: TGroupBox;
239
    CBLoge: TComboBox;
240
    LAgeSev: TLabel;
241
    PBDureeLact: TPBSuperSpin;
242
    TSGTTT: TTabSheet;
243
    PLeft: TPanel;
244
    GraphCalibr: TChart;
245
    SBCalibr: TSpeedButton;
246
    LignePds: TLineSeries;
247
    LigneP2: TLineSeries;
248
    PointPds: TLineSeries;
249
    PointP2: TLineSeries;
250
    LCoefEntGest: TLabel;
251
    LCoefEntLact: TLabel;
252
    SBReset: TSpeedButton;
253
    GBTruies: TGroupBox;
254
    GBPorcelets: TGroupBox;
255
    LNbrPorcelets: TLabel;
256
    LNbrVifs: TLabel;
257
    LNbrMorts: TLabel;
258
    LNbrSevres: TLabel;
259
    LAgePorcelets: TLabel;
260
    LNaissance: TLabel;
261
    LSevrage: TLabel;
262
    PBNbrVifs: TPBNumEdit;
263
    PBNbrMorts: TPBNumEdit;
264
    PBNbrSevres: TPBNumEdit;
265
    PBPdsNais: TPBNumEdit;
266
    PBPdsSev: TPBNumEdit;
267
    LNbrTruies: TLabel;
268
    PBNbrTruies: TPBNumEdit;
269
    LAge1ereMB: TLabel;
270
    PBAge1ereMB: TPBNumEdit;
271
    LISO2: TLabel;
272
    PBISO: TPBNumEdit;
273
    LPdsTruies: TLabel;
274
    L1ereSaillie: TLabel;
275
    LAdulte: TLabel;
276
    LPrimipares: TLabel;
277
    LMultipares: TLabel;
278
    LPerteLactation: TLabel;
279
    LP2Truies: TLabel;
280
    PBPds1ereSaillie: TPBNumEdit;
281
    PBPdsAdulte: TPBNumEdit;
282
    PBPertePdsPrim: TPBNumEdit;
283
    PBPertePdsMult: TPBNumEdit;
284
    LPdsPorcelets: TLabel;
285
    PBP21ereSaillie: TPBNumEdit;
286
    PBP2Objectif: TPBNumEdit;
287
    PBPerteP2Prim: TPBNumEdit;
288
    PBPerteP2Mult: TPBNumEdit;
289
    LObjectif: TLabel;
290
    BBCalcul: TBitBtn;
291
    GBAlimentation: TGroupBox;
292
    LConsoLact: TLabel;
293
    LConsoGest: TLabel;
294
    PBConsoLact: TPBNumEdit;
295
    PBConsoGest: TPBNumEdit;
296
    PBConsoAn: TPBNumEdit;
297
    LConsoAn: TLabel;
298
    PBAgeSev: TPBSuperSpin;
299
    SBSave: TSpeedButton;
300
    SBPrint: TSpeedButton;
301
    PAlimTop: TPanel;
302
    LISO: TLabel;
303
    PBISOPt2: TPBNumEdit;
304
    PBISOPt3: TPBNumEdit;
305
    PBISOPt4: TPBNumEdit;
306
    PBISOPt5: TPBNumEdit;
307
    PBISOPt6: TPBNumEdit;
308
    PBISOPt7: TPBNumEdit;
309
    PBISOPt8: TPBNumEdit;
310
    PBISOTot: TPBNumEdit;
311
    LPdsApMB: TLabel;
312
    GBCalGest: TGroupBox;
313
    GBCalLact: TGroupBox;
314
    LRatioLipProt: TLabel;
315
    JvEnterAsTab: TJvEnterAsTab;
316
    CBMethod: TComboBox;
317
    PBCoefEntGest: TPBSuperSpin;
318
    PBCoefEntLact: TPBSuperSpin;
319
    PBRatioLipProt: TPBSuperSpin;
320
    GaugeCalibr: TGauge;
321
    procedure FormShow(Sender: TObject);
322
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
323
    procedure FormActivate(Sender: TObject);
324
    procedure FormDeactivate(Sender: TObject);
325
    procedure CBProfilChange(Sender: TObject);
326
    procedure SBAddProfilClick(Sender: TObject);
327
    procedure SBDelProfilClick(Sender: TObject);
328
    procedure SBRenameClick(Sender: TObject);
329
    procedure SBCommentClick(Sender: TObject);
330
    procedure PCChange(Sender: TObject);
331
    procedure RBEffectifClick(Sender: TObject);
332
    procedure ChkPdsApMBClick(Sender: TObject);
333
    procedure PBNbrPt1Change(Sender: TObject);
334
    procedure PBNbrPt2Change(Sender: TObject);
335
    procedure PBNbrPt3Change(Sender: TObject);
336
    procedure PBNbrPt4Change(Sender: TObject);
337
    procedure PBNbrPt5Change(Sender: TObject);
338
    procedure PBNbrPt6Change(Sender: TObject);
339
    procedure PBNbrPt7Change(Sender: TObject);
340
    procedure PBNbrPt8Change(Sender: TObject);
341
    procedure PBPctChange(Sender: TObject);
342
    procedure PBISOPt2Change(Sender: TObject);
343
    procedure PBISOPt3Change(Sender: TObject);
344
    procedure PBISOPt4Change(Sender: TObject);
345
    procedure PBISOPt5Change(Sender: TObject);
346
    procedure PBISOPt6Change(Sender: TObject);
347
    procedure PBISOPt7Change(Sender: TObject);
348
    procedure PBISOPt8Change(Sender: TObject);
349
    procedure PBAgeSailPt1Change(Sender: TObject);
350
    procedure PBPdsSailPt1Change(Sender: TObject);
351
    procedure PBPdsSailPt2Change(Sender: TObject);
352
    procedure PBPdsSailPt3Change(Sender: TObject);
353
    procedure PBPdsSailPt4Change(Sender: TObject);
354
    procedure PBPdsSailPt5Change(Sender: TObject);
355
    procedure PBPdsSailPt6Change(Sender: TObject);
356
    procedure PBPdsSailPt7Change(Sender: TObject);
357
    procedure PBPdsSailPt8Change(Sender: TObject);
358
    procedure PBP2SailPt1Change(Sender: TObject);
359
    procedure PBP2SailPt2Change(Sender: TObject);
360
    procedure PBP2SailPt3Change(Sender: TObject);
361
    procedure PBP2SailPt4Change(Sender: TObject);
362
    procedure PBP2SailPt5Change(Sender: TObject);
363
    procedure PBP2SailPt6Change(Sender: TObject);
364
    procedure PBP2SailPt7Change(Sender: TObject);
365
    procedure PBP2SailPt8Change(Sender: TObject);
366
    procedure PBPdsAvMBPt1Change(Sender: TObject);
367
    procedure PBPdsAvMBPt2Change(Sender: TObject);
368
    procedure PBPdsAvMBPt3Change(Sender: TObject);
369
    procedure PBPdsAvMBPt4Change(Sender: TObject);
370
    procedure PBPdsAvMBPt5Change(Sender: TObject);
371
    procedure PBPdsAvMBPt6Change(Sender: TObject);
372
    procedure PBPdsAvMBPt7Change(Sender: TObject);
373
    procedure PBPdsAvMBPt8Change(Sender: TObject);
374
    procedure PBPdsApMBPt1Change(Sender: TObject);
375
    procedure PBPdsApMBPt2Change(Sender: TObject);
376
    procedure PBPdsApMBPt3Change(Sender: TObject);
377
    procedure PBPdsApMBPt4Change(Sender: TObject);
378
    procedure PBPdsApMBPt5Change(Sender: TObject);
379
    procedure PBPdsApMBPt6Change(Sender: TObject);
380
    procedure PBPdsApMBPt7Change(Sender: TObject);
381
    procedure PBPdsApMBPt8Change(Sender: TObject);
382
    procedure PBP2MBPt1Change(Sender: TObject);
383
    procedure PBP2MBPt2Change(Sender: TObject);
384
    procedure PBP2MBPt3Change(Sender: TObject);
385
    procedure PBP2MBPt4Change(Sender: TObject);
386
    procedure PBP2MBPt5Change(Sender: TObject);
387
    procedure PBP2MBPt6Change(Sender: TObject);
388
    procedure PBP2MBPt7Change(Sender: TObject);
389
    procedure PBP2MBPt8Change(Sender: TObject);
390
    procedure PBNbTotPt1Change(Sender: TObject);
391
    procedure PBNbTotPt2Change(Sender: TObject);
392
    procedure PBNbTotPt3Change(Sender: TObject);
393
    procedure PBNbTotPt4Change(Sender: TObject);
394
    procedure PBNbTotPt5Change(Sender: TObject);
395
    procedure PBNbTotPt6Change(Sender: TObject);
396
    procedure PBNbTotPt7Change(Sender: TObject);
397
    procedure PBNbTotPt8Change(Sender: TObject);
398
    procedure PBNbVifPt1Change(Sender: TObject);
399
    procedure PBNbVifPt2Change(Sender: TObject);
400
    procedure PBNbVifPt3Change(Sender: TObject);
401
    procedure PBNbVifPt4Change(Sender: TObject);
402
    procedure PBNbVifPt5Change(Sender: TObject);
403
    procedure PBNbVifPt6Change(Sender: TObject);
404
    procedure PBNbVifPt7Change(Sender: TObject);
405
    procedure PBNbVifPt8Change(Sender: TObject);
406
    procedure PBNbSevPt1Change(Sender: TObject);
407
    procedure PBNbSevPt2Change(Sender: TObject);
408
    procedure PBNbSevPt3Change(Sender: TObject);
409
    procedure PBNbSevPt4Change(Sender: TObject);
410
    procedure PBNbSevPt5Change(Sender: TObject);
411
    procedure PBNbSevPt6Change(Sender: TObject);
412
    procedure PBNbSevPt7Change(Sender: TObject);
413
    procedure PBNbSevPt8Change(Sender: TObject);
414
    procedure PBPVNaisPt1Change(Sender: TObject);
415
    procedure PBPVNaisPt2Change(Sender: TObject);
416
    procedure PBPVNaisPt3Change(Sender: TObject);
417
    procedure PBPVNaisPt4Change(Sender: TObject);
418
    procedure PBPVNaisPt5Change(Sender: TObject);
419
    procedure PBPVNaisPt6Change(Sender: TObject);
420
    procedure PBPVNaisPt7Change(Sender: TObject);
421
    procedure PBPVNaisPt8Change(Sender: TObject);
422
    procedure PBPVSevPt1Change(Sender: TObject);
423
    procedure PBPVSevPt2Change(Sender: TObject);
424
    procedure PBPVSevPt3Change(Sender: TObject);
425
    procedure PBPVSevPt4Change(Sender: TObject);
426
    procedure PBPVSevPt5Change(Sender: TObject);
427
    procedure PBPVSevPt6Change(Sender: TObject);
428
    procedure PBPVSevPt7Change(Sender: TObject);
429
    procedure PBPVSevPt8Change(Sender: TObject);
430
    procedure PBNbrTotChange(Sender: TObject);
431
    procedure CBSeqAliChange(Sender: TObject);
432
    procedure CBUniteChange(Sender: TObject);
433
    procedure PBAliGestPt1Change(Sender: TObject);
434
    procedure PBAliGestPt2Change(Sender: TObject);
435
    procedure PBAliGestPt3Change(Sender: TObject);
436
    procedure PBAliGestPt4Change(Sender: TObject);
437
    procedure PBAliGestPt5Change(Sender: TObject);
438
    procedure PBAliGestPt6Change(Sender: TObject);
439
    procedure PBAliGestPt7Change(Sender: TObject);
440
    procedure PBAliGestPt8Change(Sender: TObject);
441
    procedure PBAliLactPt1Change(Sender: TObject);
442
    procedure PBAliLactPt2Change(Sender: TObject);
443
    procedure PBAliLactPt3Change(Sender: TObject);
444
    procedure PBAliLactPt4Change(Sender: TObject);
445
    procedure PBAliLactPt5Change(Sender: TObject);
446
    procedure PBAliLactPt6Change(Sender: TObject);
447
    procedure PBAliLactPt7Change(Sender: TObject);
448
    procedure PBAliLactPt8Change(Sender: TObject);
449
    procedure CBOngletChange(Sender: TObject);
450
    procedure CBGraphChange(Sender: TObject);
451
    procedure CBLogeChange(Sender: TObject);
452
    procedure PBDureeLactChange(Sender: TObject);
453
    procedure SBCalibrClick(Sender: TObject);
454
    procedure SBResetClick(Sender: TObject);
455
    procedure BBCalculClick(Sender: TObject);
456
    procedure PBNbrTruiesChange(Sender: TObject);
457
    procedure PBAge1ereMBChange(Sender: TObject);
458
    procedure PBISOChange(Sender: TObject);
459
    procedure PBPds1ereSaillieChange(Sender: TObject);
460
    procedure PBPdsAdulteChange(Sender: TObject);
461
    procedure PBPertePdsPrimChange(Sender: TObject);
462
    procedure PBPertePdsMultChange(Sender: TObject);
463
    procedure PBP21ereSaillieChange(Sender: TObject);
464
    procedure PBP2ObjectifChange(Sender: TObject);
465
    procedure PBPerteP2PrimChange(Sender: TObject);
466
    procedure PBPerteP2MultChange(Sender: TObject);
467
    procedure PBNbrVifsChange(Sender: TObject);
468
    procedure PBNbrMortsChange(Sender: TObject);
469
    procedure PBNbrSevresChange(Sender: TObject);
470
    procedure PBAgeSevChange(Sender: TObject);
471
    procedure PBPdsNaisChange(Sender: TObject);
472
    procedure PBPdsSevChange(Sender: TObject);
473
    procedure PBConsoLactChange(Sender: TObject);
474
    procedure PBConsoGestChange(Sender: TObject);
475
    procedure SBSaveClick(Sender: TObject);
476
    procedure SBPrintClick(Sender: TObject);
477
    procedure FormCreate(Sender: TObject);
478
    procedure LPdsApMBClick(Sender: TObject);
479
    procedure PBCoefEntGestChange(Sender: TObject);
480
    procedure PBCoefEntLactChange(Sender: TObject);
481
    procedure PBRatioLipProtChange(Sender: TObject);
482
  private
483
    { D?clarations priv?es }
484
    Update, Modified, Modal: boolean;
485
    IdxProfilT: integer;
486
    NombreTot, ISOTot, AgeSailTot: integer;
487
    PdsSailTot, P2SailTot, PdsAvMBTot, PdsApMBTot, P2MBTot: double;
488
    NesTotauxTot, NesVivantsTot, PdsNaisTot, SevresTot, PdsSevTot: double;
489
    TabISO: array[2..NB_CYCLES] of integer;
490
    TabGMQ: array[1..NB_CYCLES] of double;
491
    GMQTot: double;
492
    BarGest, BarLact: TBarSeries;
493
    LinePds, LineP2, LineAjust: TLineSeries;
494
    PointAjust: TPointSeries;
495
    LineNesTotaux, LineNesVivants, LineSevres: TLineSeries;
496
    LinePdsNais, LinePdsSev: TLineSeries;
497
    LineGMQ: TLineSeries;
498
    procedure Save;
499
    procedure CalcNbr;
500
    procedure CalcNbrTot;
501
    procedure CalcPct;
502
    procedure CalcPctTot;
503
    procedure CalcISOTot;
504
    procedure CalcAgeSail;
505
    procedure CalcAgeSailTot;
506
    procedure CalcPdsSailTot;
507
    procedure CalcP2SailTot;
508
    procedure CalcPdsAvMBTot;
509
    procedure CalcPdsApMB;
510
    procedure CalcPdsApMBTot;
511
    procedure CalcP2MBTot;
512
    procedure CalcNbTotTot;
513
    procedure CalcNbVifTot;
514
    procedure CalcPVNaisTot;
515
    procedure CalcNbSevTot;
516
    procedure CalcPVSevTot;
517
    procedure CalcGMQ;
518
    procedure CalcAliGestTot;
519
    procedure CalcAliLactTot;
520
    procedure InitGraphAli;
521
    procedure AffGraphAli;
522
    procedure InitGraph;
523
    procedure AffGraph;
524
    procedure AjustPdsApMB;
525
    procedure ValidBBCalibre;
526
    procedure ValidBBCalcul;
527
    procedure CalcConsoAn;
528
  public
529
    { D?clarations publiques }
530
    procedure AffGraphCal;
531
  end;
532
533
var
534
  FProfilT: TFProfilT;
535
536
implementation
537
538
uses
539
  Dialogs, Graphics, Math, SysUtils, gnugettext, UStrings, UInit, UUtil,
540
  UFindRec, UEchelle, UFComment, UCalcSimulT, UFRapProfilT, UFCalibrage;
541
542
{$R *.dfm}
543
544
{ TFProfilT }
545
546
procedure TFProfilT.FormCreate(Sender: TObject);
547
begin
548
  if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1
549
  then
550
    Font.Name := 'Arial Unicode MS';
551
  TranslateComponent(Self);
552
  Constraints.MinWidth := 648 + (Width - ClientWidth);
553
  Width := Constraints.MinWidth;
554
  Constraints.MinHeight := 412 + (Height - ClientHeight);
555
  Height := Constraints.MinHeight;
556
  CBUnite.ItemIndex := 0;
557
  CBOnglet.ItemIndex := 0;
558
  CBTruie.ItemIndex := 0;
559
  CBMethod.ItemIndex := 1; // Marquardt
560
end;
561
562
procedure TFProfilT.FormShow(Sender: TObject);
563
begin
564
  Modified := False;
565
  Modal := False;
566
  InitGraphAli;
567
  InitGraph;
568
  StringsProfilT(CBProfil.Items, True);
569
  SBAddProfil.Enabled := IsComplete or (ListProfilT.Count < 5);
570
  SBSave.Enabled := IsComplete or IsEducation;
571
  IdxProfilT := -1;
572
  PC.ActivePage := TSTruie;
573
//  CBProfilChange(nil);
574
end ;
575
576
procedure TFProfilT.FormClose(Sender: TObject; var Action: TCloseAction);
577
begin
578
  if Modified then Save;
579
  Action := caFree;
580
  NumWinProfilT := -1;
581
  BarGest.Free;
582
  BarLact.Free;
583
  LinePds.Free;
584
  LineP2.Free;
585
  LineAjust.Free;
586
  PointAjust.Free;
587
  LineNesTotaux.Free;
588
  LineNesVivants.Free;
589
  LineSevres.Free;
590
  LinePdsNais.Free;
591
  LinePdsSev.Free;
592
  LineGMQ.Free;
593
end;
594
595
procedure TFProfilT.FormActivate(Sender: TObject);
596
var
597
  i: integer;
598
begin
599
  if not Modal
600
  then
601
  begin
602
    StringsSeqAliT(CBSeqAli.Items, False);
603
    StringsLogeT(CBLoge.Items, False);
604
//    if IdxProfilT <> -1
605
//    then
606
//      PProfilT := ListProfilT[IdxProfilT];
607
    CBProfilChange(nil);
608
    for i := 0 to PC.PageCount - 1 do
609
      PC.Pages[i].Enabled := IsComplete or IsEducation or IsEvaluation;
610
  end;
611
end;
612
613
procedure TFProfilT.FormDeactivate(Sender: TObject);
614
begin
615
  if Modified and not Modal then Save;
616
end;
617
618
procedure TFProfilT.Save;
619
var
620
  s : string ;
621
begin
622
  Modified := FALSE ;
623
  if IsComplete or IsEducation
624
  then
625
    if MessageDlg (Caption + sLineBreak + MsgSave, mtConfirmation, [mbYes, mbNo], 0) = mrYes
626
    then
627
    begin
628
      if ProfilTValid (PProfilT)
629
      then
630
        AjustPdsApMB ;
631
      SaveProfilT ;
632
      if not ProfilTValid (PProfilT)
633
      then
634
        MessageDlg(Format (MsgInvalidData, [Caption, PProfilT.Nom]), mtWarning, [mbOK], 0) ;
635
    end
636
    else
637
    begin
638
      LoadProfilT ;
639
      s := CBProfil.Text ;
640
      StringsProfilT (CBProfil.Items, TRUE) ;
641
      if FindIdxProfilT (s) = -1
642
      then
643
      begin
644
        IdxProfilT := -1 ;
645
        CBProfilChange (nil) ;
646
      end
647
      else
648
        CBProfil.ItemIndex := CBProfil.Items.IndexOf (s) ;
649
    end ;
650
end;
651
652
procedure TFProfilT.CBProfilChange(Sender: TObject);
653
var
654
  i: integer;
655
begin
656
  if (IdxProfilT <> -1) and (CBProfil.Text <> PProfilT.Nom)
657
  then
658
    if Modified then Save ;
659
  IdxProfilT := FindIdxProfilT (CBProfil.Text) ;
660
  if IdxProfilT = -1
661
  then // Pas d'enregistrement
662
  begin
663
    CBProfil.Repaint ;
664
    SBDelProfil.Enabled := FALSE ;
665
    SBRename.Enabled := FALSE ;
666
    SBComment.Enabled := FALSE ;
667
    SBSave.Enabled := FALSE ;
668
    SBPrint.Enabled := FALSE ;
669
    PC.Visible := FALSE ;
670
  end
671
  else // Affichage de l'enregistrement
672
  begin
673
    SBDelProfil.Enabled := TRUE ;
674
    SBRename.Enabled := TRUE ;
675
    SBComment.Enabled := TRUE ;
676
    SBSave.Enabled := TRUE ;
677
    SBPrint.Enabled := TRUE ;
678
    PC.Visible := TRUE ;
679
    PProfilT := ListProfilT[IdxProfilT] ;
680
    with PProfilT^ do
681
    begin
682
      Update := TRUE ;
683
      CBProfil.Hint := Memo ;
684
      // Truie
685
      PBNbrPt1.AsInteger := Truies[1].Nombre ;
686
      PBNbrPt2.AsInteger := Truies[2].Nombre ;
687
      PBNbrPt3.AsInteger := Truies[3].Nombre ;
688
      PBNbrPt4.AsInteger := Truies[4].Nombre ;
689
      PBNbrPt5.AsInteger := Truies[5].Nombre ;
690
      PBNbrPt6.AsInteger := Truies[6].Nombre ;
691
      PBNbrPt7.AsInteger := Truies[7].Nombre ;
692
      PBNbrPt8.AsInteger := Truies[8].Nombre ;
693
      CalcNbrTot ;
694
      CalcPct ;
695
      for i := 2 to NB_CYCLES do
696
        if (PProfilT.Truies[i].AgeSail = 0) or (PProfilT.Truies[i - 1].AgeSail = 0)
697
        then // Information absente
698
          TabISO[i] := 0
699
        else
700
          TabISO[i] := Truies[i].AgeSail - Truies[i - 1].AgeSail - DureeGest - DureeLact ;
701
      PBISOPt2.AsInteger := TabISO[2] ;
702
      PBISOPt3.AsInteger := TabISO[3] ;
703
      PBISOPt4.AsInteger := TabISO[4] ;
704
      PBISOPt5.AsInteger := TabISO[5] ;
705
      PBISOPt6.AsInteger := TabISO[6] ;
706
      PBISOPt7.AsInteger := TabISO[7] ;
707
      PBISOPt8.AsInteger := TabISO[8] ;
708
      CalcISOTot ;
709
      PBAgeSailPt1.AsInteger := Truies[1].AgeSail ;
710
      PBAgeSailPt2.AsInteger := Truies[2].AgeSail ;
711
      PBAgeSailPt3.AsInteger := Truies[3].AgeSail ;
712
      PBAgeSailPt4.AsInteger := Truies[4].AgeSail ;
713
      PBAgeSailPt5.AsInteger := Truies[5].AgeSail ;
714
      PBAgeSailPt6.AsInteger := Truies[6].AgeSail ;
715
      PBAgeSailPt7.AsInteger := Truies[7].AgeSail ;
716
      PBAgeSailPt8.AsInteger := Truies[8].AgeSail ;
717
      CalcAgeSailTot ;
718
      PBPdsSailPt1.AsFloat := Truies[1].PdsSail ;
719
      PBPdsSailPt2.AsFloat := Truies[2].PdsSail ;
720
      PBPdsSailPt3.AsFloat := Truies[3].PdsSail ;
721
      PBPdsSailPt4.AsFloat := Truies[4].PdsSail ;
722
      PBPdsSailPt5.AsFloat := Truies[5].PdsSail ;
723
      PBPdsSailPt6.AsFloat := Truies[6].PdsSail ;
724
      PBPdsSailPt7.AsFloat := Truies[7].PdsSail ;
725
      PBPdsSailPt8.AsFloat := Truies[8].PdsSail ;
726
      CalcPdsSailTot ;
727
      PBP2SailPt1.AsFloat := Truies[1].P2Sail ;
728
      PBP2SailPt2.AsFloat := Truies[2].P2Sail ;
729
      PBP2SailPt3.AsFloat := Truies[3].P2Sail ;
730
      PBP2SailPt4.AsFloat := Truies[4].P2Sail ;
731
      PBP2SailPt5.AsFloat := Truies[5].P2Sail ;
732
      PBP2SailPt6.AsFloat := Truies[6].P2Sail ;
733
      PBP2SailPt7.AsFloat := Truies[7].P2Sail ;
734
      PBP2SailPt8.AsFloat := Truies[8].P2Sail ;
735
      CalcP2SailTot ;
736
      PBPdsAvMBPt1.AsFloat := Truies[1].PdsAvMB ;
737
      PBPdsAvMBPt2.AsFloat := Truies[2].PdsAvMB ;
738
      PBPdsAvMBPt3.AsFloat := Truies[3].PdsAvMB ;
739
      PBPdsAvMBPt4.AsFloat := Truies[4].PdsAvMB ;
740
      PBPdsAvMBPt5.AsFloat := Truies[5].PdsAvMB ;
741
      PBPdsAvMBPt6.AsFloat := Truies[6].PdsAvMB ;
742
      PBPdsAvMBPt7.AsFloat := Truies[7].PdsAvMB ;
743
      PBPdsAvMBPt8.AsFloat := Truies[8].PdsAvMB ;
744
      CalcPdsAvMBTot ;
745
      PBPdsApMBPt1.AsFloat := Truies[1].PdsApMB ;
746
      PBPdsApMBPt2.AsFloat := Truies[2].PdsApMB ;
747
      PBPdsApMBPt3.AsFloat := Truies[3].PdsApMB ;
748
      PBPdsApMBPt4.AsFloat := Truies[4].PdsApMB ;
749
      PBPdsApMBPt5.AsFloat := Truies[5].PdsApMB ;
750
      PBPdsApMBPt6.AsFloat := Truies[6].PdsApMB ;
751
      PBPdsApMBPt7.AsFloat := Truies[7].PdsApMB ;
752
      PBPdsApMBPt8.AsFloat := Truies[8].PdsApMB ;
753
      CalcPdsApMBTot ;
754
      PBP2MBPt1.AsFloat := Truies[1].P2MB ;
755
      PBP2MBPt2.AsFloat := Truies[2].P2MB ;
756
      PBP2MBPt3.AsFloat := Truies[3].P2MB ;
757
      PBP2MBPt4.AsFloat := Truies[4].P2MB ;
758
      PBP2MBPt5.AsFloat := Truies[5].P2MB ;
759
      PBP2MBPt6.AsFloat := Truies[6].P2MB ;
760
      PBP2MBPt7.AsFloat := Truies[7].P2MB ;
761
      PBP2MBPt8.AsFloat := Truies[8].P2MB ;
762
      CalcP2MBTot ;
763
      // Porcelets
764
      PBNbTotPt1.AsFloat := Porcelets[1].NesTotaux ;
765
      PBNbTotPt2.AsFloat := Porcelets[2].NesTotaux ;
766
      PBNbTotPt3.AsFloat := Porcelets[3].NesTotaux ;
767
      PBNbTotPt4.AsFloat := Porcelets[4].NesTotaux ;
768
      PBNbTotPt5.AsFloat := Porcelets[5].NesTotaux ;
769
      PBNbTotPt6.AsFloat := Porcelets[6].NesTotaux ;
770
      PBNbTotPt7.AsFloat := Porcelets[7].NesTotaux ;
771
      PBNbTotPt8.AsFloat := Porcelets[8].NesTotaux ;
772
      CalcNbTotTot ;
773
      PBNbVifPt1.AsFloat := Porcelets[1].NesVivants ;
774
      PBNbVifPt2.AsFloat := Porcelets[2].NesVivants ;
775
      PBNbVifPt3.AsFloat := Porcelets[3].NesVivants ;
776
      PBNbVifPt4.AsFloat := Porcelets[4].NesVivants ;
777
      PBNbVifPt5.AsFloat := Porcelets[5].NesVivants ;
778
      PBNbVifPt6.AsFloat := Porcelets[6].NesVivants ;
779
      PBNbVifPt7.AsFloat := Porcelets[7].NesVivants ;
780
      PBNbVifPt8.AsFloat := Porcelets[8].NesVivants ;
781
      CalcNbVifTot ;
782
      PBPVNaisPt1.AsFloat := Porcelets[1].PdsNais ;
783
      PBPVNaisPt2.AsFloat := Porcelets[2].PdsNais ;
784
      PBPVNaisPt3.AsFloat := Porcelets[3].PdsNais ;
785
      PBPVNaisPt4.AsFloat := Porcelets[4].PdsNais ;
786
      PBPVNaisPt5.AsFloat := Porcelets[5].PdsNais ;
787
      PBPVNaisPt6.AsFloat := Porcelets[6].PdsNais ;
788
      PBPVNaisPt7.AsFloat := Porcelets[7].PdsNais ;
789
      PBPVNaisPt8.AsFloat := Porcelets[8].PdsNais ;
790
      CalcPVNaisTot ;
791
      PBNbSevPt1.AsFloat := Porcelets[1].Sevres ;
792
      PBNbSevPt2.AsFloat := Porcelets[2].Sevres ;
793
      PBNbSevPt3.AsFloat := Porcelets[3].Sevres ;
794
      PBNbSevPt4.AsFloat := Porcelets[4].Sevres ;
795
      PBNbSevPt5.AsFloat := Porcelets[5].Sevres ;
796
      PBNbSevPt6.AsFloat := Porcelets[6].Sevres ;
797
      PBNbSevPt7.AsFloat := Porcelets[7].Sevres ;
798
      PBNbSevPt8.AsFloat := Porcelets[8].Sevres ;
799
      CalcNbSevTot ;
800
      PBDureeLact.AsInteger := DureeLact ;
801
      PBPVSevPt1.AsFloat := Porcelets[1].PdsSev ;
802
      PBPVSevPt2.AsFloat := Porcelets[2].PdsSev ;
803
      PBPVSevPt3.AsFloat := Porcelets[3].PdsSev ;
804
      PBPVSevPt4.AsFloat := Porcelets[4].PdsSev ;
805
      PBPVSevPt5.AsFloat := Porcelets[5].PdsSev ;
806
      PBPVSevPt6.AsFloat := Porcelets[6].PdsSev ;
807
      PBPVSevPt7.AsFloat := Porcelets[7].PdsSev ;
808
      PBPVSevPt8.AsFloat := Porcelets[8].PdsSev ;
809
      CalcPVSevTot ;
810
      CalcGMQ ;
811
      // Alimentation
812
      if SeqAli = -1
813
      then
814
        CBSeqAli.ItemIndex := -1
815
      else
816
        CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (FindNomSeqAliT (SeqAli)) ;
817
      if CBSeqAli.ItemIndex = -1
818
      then
819
        CBSeqAli.Hint := ''
820
      else
821
      begin
822
        PSeqAliT := ListSeqAliT[FindIdxSeqAliT (CBSeqAli.Text)] ;
823
        CBSeqAli.Hint := PSeqAliT.Memo ;
824
      end ;
825
      if Loge = -1
826
      then
827
        CBLoge.ItemIndex := -1
828
      else
829
        CBLoge.ItemIndex := CBLoge.Items.IndexOf (FindNomLogeT (Loge)) ;
830
      if CBLoge.ItemIndex = -1
831
      then
832
        CBLoge.Hint := ''
833
      else
834
      begin
835
        PLogeT := ListLogeT[FindIdxLogeT (CBLoge.Text)] ;
836
        CBLoge.Hint := PLogeT.Memo ;
837
      end ;
838
      CBUnite.ItemIndex := Unite ;
839
      PBAliGestPt1.AsFloat := Gest[1] ;
840
      PBAliGestPt2.AsFloat := Gest[2] ;
841
      PBAliGestPt3.AsFloat := Gest[3] ;
842
      PBAliGestPt4.AsFloat := Gest[4] ;
843
      PBAliGestPt5.AsFloat := Gest[5] ;
844
      PBAliGestPt6.AsFloat := Gest[6] ;
845
      PBAliGestPt7.AsFloat := Gest[7] ;
846
      PBAliGestPt8.AsFloat := Gest[8] ;
847
      CalcAliGestTot ;
848
      PBAliLactPt1.AsFloat := Lact[1] ;
849
      PBAliLactPt2.AsFloat := Lact[2] ;
850
      PBAliLactPt3.AsFloat := Lact[3] ;
851
      PBAliLactPt4.AsFloat := Lact[4] ;
852
      PBAliLactPt5.AsFloat := Lact[5] ;
853
      PBAliLactPt6.AsFloat := Lact[6] ;
854
      PBAliLactPt7.AsFloat := Lact[7] ;
855
      PBAliLactPt8.AsFloat := Lact[8] ;
856
      CalcAliLactTot ;
857
      // Calibrage
858
      PBCoefEntGest.AsFloat := CoefEntretienGest ;
859
      PBCoefEntLact.AsFloat := CoefEntretienLact ;
860
      PBRatioLipProt.AsFloat := 1 - RatioLipProt ;
861
      // GTTT
862
      PBNbrTruies.AsInteger := NbTruies ;
863
      PBAge1ereMB.AsInteger := AgeMB1 ;
864
      PBISO.AsFloat := ISO ;
865
      PBPds1ereSaillie.AsFloat := PVSail1 ;
866
      PBPdsAdulte.AsFloat := PVAdulte ;
867
      PBPertePdsPrim.AsFloat := PertePVPrim ;
868
      PBPertePdsMult.AsFloat := PertePVMult ;
869
      PBP21ereSaillie.AsFloat := P2Sail1 ;
870
      PBP2Objectif.AsFloat := P2Objectif ;
871
      PBPerteP2Prim.AsFloat := PerteP2Prim ;
872
      PBPerteP2Mult.AsFloat :=  PerteP2Mult;
873
      PBNbrVifs.AsFloat := NbVifs ;
874
      PBNbrMorts.AsFloat := NbMorts ;
875
      PBNbrSevres.AsFloat := NbSevres ;
876
      PBAgeSev.AsInteger := AgeSevr ;
877
      PBPdsNais.AsFloat := PVNais ;
878
      PBPdsSev.AsFloat := PVSevr ;
879
      PBConsoLact.AsFloat := ConsoLact ;
880
      PBConsoGest.AsFloat := ConsoGest ;
881
      CalcConsoAn ;
882
      Update := FALSE ;
883
    end ;
884
    ValidBBCalcul ;
885
  end ;
886
  PCChange (nil) ;
887
  RBEffectifClick (nil) ;
888
end ;
889
890
procedure TFProfilT.SBAddProfilClick (Sender : TObject) ;
891
var
892
  i, n, q : integer ;
893
  s : string ;
894
  ok : boolean ;
895
  PBackup : PRecProfilT ;
896
begin
897
  if Modified then Save ;
898
  if IdxProfilT = -1
899
  then
900
    q := mrNo
901
  else
902
    q := MessageDlg (MsgCopy, mtConfirmation, [mbYes, mbNo], 0) ;
903
  // saisie du nouveau nom
904
  s := '' ;
905
  repeat
906
    if InputQuery (FProfilT.Caption, MsgName, s)
907
    then // V?rification du nom
908
    begin
909
      s := Trim (s) ; // Suppression des espaces au d?but et ? la fin
910
      if s = ''
911
      then // Pas de nom
912
      begin
913
        ok := FALSE ;
914
        MessageDlg (MsgNameEmpty, mtWarning, [mbOk], 0) ;
915
      end
916
      else
917
        if Length (s) > 25
918
        then // Nom trop long
919
        begin
920
          ok := FALSE ;
921
          MessageDlg (Format (MsgNameTooLarge, [25]), mtWarning, [mbOk], 0) ;
922
          s := Copy (s, 1, 25) ;
923
        end
924
        else
925
        begin
926
          ok := TRUE ;
927
          i := 0 ;
928
          while ok and (i < ListProfilT.Count) do
929
          begin
930
            PProfilT := ListProfilT[i] ;
931
            if PProfilT.Nom = s
932
            then // Nom d?j? utilis?
933
            begin
934
              ok := FALSE ;
935
              MessageDlg (MsgNameExists, mtWarning, [mbOk], 0) ;
936
            end
937
            else
938
              Inc (i) ;
939
          end ;
940
        end ;
941
    end
942
    else // Annulation
943
    begin
944
      s := '' ;
945
      if (IdxProfilT <> -1)
946
      then
947
        PProfilT := ListProfilT[IdxProfilT] ;
948
      ok := TRUE ;
949
    end ;
950
  until ok ;
951
  if s <> ''
952
  then // Cr?ation du nouvel enregistrement
953
  begin
954
    // recherche du premier num?ro libre
955
    n := 0 ;
956
    repeat
957
      Inc (n) ;
958
      ok := TRUE ;
959
      i := 0 ;
960
      while ok and (i < ListProfilT.Count) do
961
      begin
962
        PProfilT := ListProfilT[i] ;
963
        if PProfilT.Num = n
964
        then
965
          ok := FALSE
966
        else
967
          Inc (i) ;
968
      end ;
969
    until ok ;
970
    New (PProfilT) ;
971
    with PProfilT^ do
972
    begin
973
      Nom := s ;
974
      Num := n ;
975
      if q = mrYes
976
      then
977
      begin
978
        PBackup := ListProfilT[IdxProfilT] ;
979
        Memo := PBackup.Memo ;
980
        // Truie
981
        Truies := PBackup.Truies ;
982
        // Porcelets
983
        Porcelets := PBackup.Porcelets ;
984
        DureeLact := PBackup.DureeLact ;
985
        // Alimentation
986
        SeqAli := PBackup.SeqAli ;
987
        Loge := PBackup.Loge ;
988
        Unite := PBackup.Unite ;
989
        Gest := PBackup.Gest ;
990
        Lact := PBackup.Lact ;
991
        // Calibrage
992
        CoefEntretienGest := PBackup.CoefEntretienGest ;
993
        CoefEntretienLact := PBackup.CoefEntretienLact ;
994
        RatioLipProt := PBackup.RatioLipProt ;
995
        CoefNR := PBackup.CoefNR ;
996
        // GTTT
997
        NbTruies := PBackup.NbTruies ;
998
        AgeMB1 := PBackup.AgeMB1 ;
999
        ISO := PBackup.ISO ;
1000
        PVSail1 := PBackup.PVSail1 ;
1001
        PVAdulte := PBackup.PVAdulte ;
1002
        PertePVPrim := PBackup.PertePVPrim ;
1003
        PertePVMult := PBackup.PertePVMult ;
1004
        P2Sail1 := PBackup.P2Sail1 ;
1005
        P2Objectif := PBackup.P2Objectif ;
1006
        PerteP2Prim := PBackup.PerteP2Prim ;
1007
        PerteP2Mult := PBackup.PerteP2Mult ;
1008
        NbVifs := PBackup.NbVifs ;
1009
        NbMorts := PBackup.NbMorts ;
1010
        NbSevres := PBackup.NbSevres ;
1011
        AgeSevr := PBackup.AgeSevr ;
1012
        PVNais := PBackup.PVNais ;
1013
        PVSevr := PBackup.PVSevr ;
1014
        ConsoLact := PBackup.ConsoLact ;
1015
        ConsoGest := PBackup.ConsoGest ;
1016
        // Ajustement du poids apr?s mise-bas
1017
        pmax := PBackup.pmax ;
1018
        a := PBackup.a ;
1019
        b := PBackup.b ;
1020
        PC.ActivePage := TSTruie ;
1021
      end
1022
      else
1023
      begin
1024
        Memo := '' ;
1025
        // Truie
1026
        for i := 1 to NB_CYCLES do
1027
          with Truies[i] do
1028
          begin
1029
            Nombre := 0 ;
1030
            AgeSail := 0 ;
1031
            PdsSail := 0 ;
1032
            P2Sail := 0 ;
1033
            PdsAvMB := 0 ;
1034
            PdsApMB := 0 ;
1035
            P2MB := 0 ;
1036
          end ;
1037
        // Porcelets
1038
        for i := 1 to NB_CYCLES do
1039
          with Porcelets[i] do
1040
          begin
1041
            NesTotaux := 0 ;
1042
            NesVivants := 0 ;
1043
            Sevres := 0 ;
1044
            PdsNais := 0 ;
1045
            PdsSev := 0 ;
1046
          end ;
1047
        DureeLact := 28 ;
1048
        // Alimentation
1049
        SeqAli := -1 ;
1050
        Loge := -1 ;
1051
        Unite := 0 ;
1052
        for i := 1 to NB_CYCLES do
1053
          Gest[i] := 0 ;
1054
        for i := 1 to NB_CYCLES do
1055
          Lact[i] := 0 ;
1056
        // Calibrage
1057
        CoefEntretienGest := 1 ;
1058
        CoefEntretienLact := 1 ;
1059
        RatioLipProt := 0.9 ;
1060
        for i := 1 to NB_CYCLES do
1061
          CoefNR[i] := DefaultCoefNR[i] ;
1062
        // GTTT
1063
        NbTruies := 0 ;
1064
        AgeMB1 := 0 ;
1065
        ISO := 0 ;
1066
        PVSail1 := 0 ;
1067
        PVAdulte := 0 ;
1068
        PertePVPrim := 0 ;
1069
        PertePVMult := 0 ;
1070
        P2Sail1 := 0 ;
1071
        P2Objectif := 0 ;
1072
        PerteP2Prim := 0 ;
1073
        PerteP2Mult := 0 ;
1074
        NbVifs := 0 ;
1075
        NbMorts := 0 ;
1076
        NbSevres := 0 ;
1077
        AgeSevr := 28 ;
1078
        PVNais := 0 ;
1079
        PVSevr := 0 ;
1080
        ConsoLact := 0 ;
1081
        ConsoGest := 0 ;
1082
        // Ajustement du poids apr?s mise-bas
1083
        pmax := 0 ;
1084
        a := 0 ;
1085
        b := 0 ;
1086
        PC.ActivePage := TSGTTT ;
1087
      end ;
1088
    end ;
1089
    ListProfilT.Add (PProfilT) ;
1090
    CBProfil.Items.Add (PProfilT.Nom) ;
1091
    CBProfil.ItemIndex := CBProfil.Items.IndexOf (PProfilT.Nom) ;
1092
    CBProfilChange (nil) ;
1093
    Modified := TRUE ;
1094
    SBAddProfil.Enabled := IsComplete or (ListProfilT.Count < 5) ;
1095
    SBCommentClick (nil) ;
1096
  end ;
1097
end ;
1098
1099
procedure TFProfilT.SBDelProfilClick (Sender : TObject) ;
1100
begin
1101
  if ProfilTUsed (PProfilT.Num)
1102
  then // Enregistrement utilis?
1103
    MessageDlg (MsgDelErr, mtWarning, [mbOk], 0)
1104
  else // Suppression de l'enregistrement
1105
    if MessageDlg (MsgDel, mtConfirmation, [mbYes, mbNo], 0) = mrYes
1106
    then
1107
    begin
1108
      Dispose (PProfilT) ;
1109
      ListProfilT.Delete (IdxProfilT) ;
1110
      SaveProfilT ; // Sauvegarde !
1111
      Modified := FALSE ;
1112
      CBProfil.DeleteSelected ;
1113
      IdxProfilT := -1 ;
1114
      CBProfil.ItemIndex := -1 ;
1115
      CBProfilChange (nil) ;
1116
      SBAddProfil.Enabled := IsComplete or (ListProfilT.Count < 5) ;
1117
    end ;
1118
end ;
1119
1120
procedure TFProfilT.SBRenameClick (Sender : TObject) ;
1121
var
1122
  i : integer ;
1123
  s : string ;
1124
  ok : boolean ;
1125
begin
1126
  // Saisie du nouveau nom
1127
  s := CBProfil.Text ;
1128
  repeat
1129
    if InputQuery (FProfilT.Caption, MsgRename, s) and (s <> CBProfil.Text)
1130
    then // V?rification du nom
1131
    begin
1132
      s := Trim (s) ; // Suppression des espaces au d?but et ? la fin
1133
      if s = ''
1134
      then // Pas de nom
1135
      begin
1136
        ok := FALSE ;
1137
        MessageDlg (MsgNameEmpty, mtWarning, [mbOk], 0) ;
1138
      end
1139
      else
1140
        if Length (s) > 25
1141
        then // Nom trop long
1142
        begin
1143
          ok := FALSE ;
1144
          MessageDlg (Format (MsgNameTooLarge, [25]), mtWarning, [mbOk], 0) ;
1145
          s := Copy (s, 1, 25) ;
1146
        end
1147
        else
1148
        begin
1149
          ok := TRUE ;
1150
          i := 0 ;
1151
          while ok and (i < ListProfilT.Count) do
1152
          begin
1153
            PProfilT := ListProfilT[i] ;
1154
            if PProfilT.Nom = s
1155
            then // Nom d?j? utilis?
1156
            begin
1157
              ok := FALSE ;
1158
              MessageDlg (MsgNameExists, mtWarning, [mbOk], 0) ;
1159
            end
1160
            else
1161
              Inc (i) ;
1162
          end ;
1163
        end ;
1164
    end
1165
    else // Annulation
1166
    begin
1167
      s := '' ;
1168
      ok := TRUE ;
1169
    end ;
1170
  until ok ;
1171
  PProfilT := ListProfilT[IdxProfilT] ;
1172
  if s <> ''
1173
  then // Renommer l'enregistrement
1174
  begin
1175
    PProfilT.Nom := s ;
1176
    Modified := TRUE ;
1177
    StringsProfilT (CBProfil.Items, TRUE) ;
1178
    CBProfil.ItemIndex := CBProfil.Items.IndexOf (s) ;
1179
  end ;
1180
end ;
1181
1182
procedure TFProfilT.SBCommentClick (Sender : TObject) ;
1183
begin
1184
  // Saisie du commentaire
1185
  FComment := TFComment.Create (Self) ;
1186
  with FComment do
1187
  begin
1188
    Memo.Text := PProfilT.Memo ;
1189
    if ShowModal = mrOk
1190
    then // Commenter l'enregistrement
1191
    begin
1192
      PProfilT.Memo := Memo.Text ;
1193
      Modified := TRUE ;
1194
      CBProfil.Hint := PProfilT.Memo ;
1195
    end ;
1196
    Release ;
1197
  end ;
1198
end ;
1199
1200
procedure TFProfilT.SBSaveClick(Sender: TObject);
1201
begin
1202
  if ProfilTValid (PProfilT)
1203
  then
1204
    AjustPdsApMB ;
1205
  SaveProfilT ;
1206
  if not ProfilTValid (PProfilT)
1207
  then
1208
    MessageDlg(Format (MsgInvalidData, [Caption, PProfilT.Nom]), mtWarning, [mbOK], 0) ;
1209
  Modified := FALSE ;
1210
end;
1211
1212
procedure TFProfilT.SBPrintClick(Sender: TObject);
1213
begin
1214
  FRapProfilT := TFRapProfilT.Create (Self) ;
1215
  FRapProfilT.QRRapport.PreviewModal ;
1216
  FRapProfilT.Release ;
1217
end;
1218
1219
procedure TFProfilT.PCChange (Sender : TObject) ;
1220
begin
1221
  case PC.ActivePageIndex of
1222
//    0 : // Truie
1223
//    1 : // Porcelets
1224
    2 : // Alimentation
1225
      AffGraphAli ;
1226
    3 : // Graphiques
1227
      AffGraph ;
1228
    4 : // Calibrage
1229
      ValidBBCalibre ;
1230
  end ;
1231
end ;
1232
1233
// Truie
1234
1235
procedure TFProfilT.RBEffectifClick (Sender : TObject) ;
1236
begin
1237
  PBNbrPt1.Enabled := RBNbrEff.Checked ;
1238
  PBNbrPt2.Enabled := RBNbrEff.Checked ;
1239
  PBNbrPt3.Enabled := RBNbrEff.Checked ;
1240
  PBNbrPt4.Enabled := RBNbrEff.Checked ;
1241
  PBNbrPt5.Enabled := RBNbrEff.Checked ;
1242
  PBNbrPt6.Enabled := RBNbrEff.Checked ;
1243
  PBNbrPt7.Enabled := RBNbrEff.Checked ;
1244
  PBNbrPt8.Enabled := RBNbrEff.Checked ;
1245
  PBNbrTot.Enabled := RBPctEff.Checked ;
1246
  PBPctPt1.Enabled := RBPctEff.Checked ;
1247
  PBPctPt2.Enabled := RBPctEff.Checked ;
1248
  PBPctPt3.Enabled := RBPctEff.Checked ;
1249
  PBPctPt4.Enabled := RBPctEff.Checked ;
1250
  PBPctPt5.Enabled := RBPctEff.Checked ;
1251
  PBPctPt6.Enabled := RBPctEff.Checked ;
1252
  PBPctPt7.Enabled := RBPctEff.Checked ;
1253
  PBPctPt8.Enabled := RBPctEff.Checked ;
1254
  if PBNbrTot.AsInteger = 0
1255
  then
1256
    if RBNbrEff.Checked
1257
    then // Nombre
1258
    begin
1259
      Update := TRUE ;
1260
      PBNbrPt1.AsInteger := 0 ;
1261
      PBNbrPt2.AsInteger := 0 ;
1262
      PBNbrPt3.AsInteger := 0 ;
1263
      PBNbrPt4.AsInteger := 0 ;
1264
      PBNbrPt5.AsInteger := 0 ;
1265
      PBNbrPt6.AsInteger := 0 ;
1266
      PBNbrPt7.AsInteger := 0 ;
1267
      PBNbrPt8.AsInteger := 0 ;
1268
      CalcPct ;
1269
      Update := FALSE ;
1270
    end
1271
    else // R?partition
1272
    begin
1273
      Update := TRUE ;
1274
      PBPctPt1.AsFloat := 0 ;
1275
      PBPctPt2.AsFloat := 0 ;
1276
      PBPctPt3.AsFloat := 0 ;
1277
      PBPctPt4.AsFloat := 0 ;
1278
      PBPctPt5.AsFloat := 0 ;
1279
      PBPctPt6.AsFloat := 0 ;
1280
      PBPctPt7.AsFloat := 0 ;
1281
      PBPctPt8.AsFloat := 0 ;
1282
      CalcPctTot ;
1283
      CalcNbr ;
1284
      Update := FALSE ;
1285
    end ;
1286
end ;
1287
1288
procedure TFProfilT.PBNbrPt1Change (Sender : TObject) ;
1289
begin
1290
  if not Update
1291
  then
1292
  begin
1293
    Modified := TRUE ;
1294
    PProfilT.Truies[1].Nombre := PBNbrPt1.AsInteger ;
1295
    Update := TRUE ;
1296
    CalcNbrTot ;
1297
    CalcPct ;
1298
    Update := FALSE ;
1299
    CalcISOTot ;
1300
    CalcAgeSailTot ;
1301
    CalcPdsSailTot ;
1302
    CalcP2SailTot ;
1303
    CalcPdsAvMBTot ;
1304
    CalcPdsApMBTot ;
1305
    CalcP2MBTot ;
1306
    CalcNbTotTot ;
1307
    CalcNbVifTot ;
1308
    CalcPVNaisTot ;
1309
    CalcNbSevTot ;
1310
    CalcPVSevTot ;
1311
    CalcGMQ ;
1312
  end ;
1313
end ;
1314
1315
procedure TFProfilT.PBNbrPt2Change (Sender : TObject) ;
1316
begin
1317
  if not Update
1318
  then
1319
  begin
1320
    Modified := TRUE ;
1321
    PProfilT.Truies[2].Nombre := PBNbrPt2.AsInteger ;
1322
    Update := TRUE ;
1323
    CalcNbrTot ;
1324
    CalcPct ;
1325
    Update := FALSE ;
1326
    CalcISOTot ;
1327
    CalcAgeSailTot ;
1328
    CalcPdsSailTot ;
1329
    CalcP2SailTot ;
1330
    CalcPdsAvMBTot ;
1331
    CalcPdsApMBTot ;
1332
    CalcP2MBTot ;
1333
    CalcNbTotTot ;
1334
    CalcNbVifTot ;
1335
    CalcPVNaisTot ;
1336
    CalcNbSevTot ;
1337
    CalcPVSevTot ;
1338
    CalcGMQ ;
1339
  end ;
1340
end ;
1341
1342
procedure TFProfilT.PBNbrPt3Change (Sender : TObject) ;
1343
begin
1344
  if not Update
1345
  then
1346
  begin
1347
    Modified := TRUE ;
1348
    PProfilT.Truies[3].Nombre := PBNbrPt3.AsInteger ;
1349
    Update := TRUE ;
1350
    CalcNbrTot ;
1351
    CalcPct ;
1352
    Update := FALSE ;
1353
    CalcISOTot ;
1354
    CalcAgeSailTot ;
1355
    CalcPdsSailTot ;
1356
    CalcP2SailTot ;
1357
    CalcPdsAvMBTot ;
1358
    CalcPdsApMBTot ;
1359
    CalcP2MBTot ;
1360
    CalcNbTotTot ;
1361
    CalcNbVifTot ;
1362
    CalcPVNaisTot ;
1363
    CalcNbSevTot ;
1364
    CalcPVSevTot ;
1365
    CalcGMQ ;
1366
  end ;
1367
end ;
1368
1369
procedure TFProfilT.PBNbrPt4Change (Sender : TObject) ;
1370
begin
1371
  if not Update
1372
  then
1373
  begin
1374
    Modified := TRUE ;
1375
    PProfilT.Truies[4].Nombre := PBNbrPt4.AsInteger ;
1376
    Update := TRUE ;
1377
    CalcNbrTot ;
1378
    CalcPct ;
1379
    Update := FALSE ;
1380
    CalcISOTot ;
1381
    CalcAgeSailTot ;
1382
    CalcPdsSailTot ;
1383
    CalcP2SailTot ;
1384
    CalcPdsAvMBTot ;
1385
    CalcPdsApMBTot ;
1386
    CalcP2MBTot ;
1387
    CalcNbTotTot ;
1388
    CalcNbVifTot ;
1389
    CalcPVNaisTot ;
1390
    CalcNbSevTot ;
1391
    CalcPVSevTot ;
1392
    CalcGMQ ;
1393
  end ;
1394
end ;
1395
1396
procedure TFProfilT.PBNbrPt5Change (Sender : TObject) ;
1397
begin
1398
  if not Update
1399
  then
1400
  begin
1401
    Modified := TRUE ;
1402
    PProfilT.Truies[5].Nombre := PBNbrPt5.AsInteger ;
1403
    Update := TRUE ;
1404
    CalcNbrTot ;
1405
    CalcPct ;
1406
    Update := FALSE ;
1407
    CalcISOTot ;
1408
    CalcAgeSailTot ;
1409
    CalcPdsSailTot ;
1410
    CalcP2SailTot ;
1411
    CalcPdsAvMBTot ;
1412
    CalcPdsApMBTot ;
1413
    CalcP2MBTot ;
1414
    CalcNbTotTot ;
1415
    CalcNbVifTot ;
1416
    CalcPVNaisTot ;
1417
    CalcNbSevTot ;
1418
    CalcPVSevTot ;
1419
    CalcGMQ ;
1420
  end ;
1421
end ;
1422
1423
procedure TFProfilT.PBNbrPt6Change (Sender : TObject) ;
1424
begin
1425
  if not Update
1426
  then
1427
  begin
1428
    Modified := TRUE ;
1429
    PProfilT.Truies[6].Nombre := PBNbrPt6.AsInteger ;
1430
    Update := TRUE ;
1431
    CalcNbrTot ;
1432
    CalcPct ;
1433
    Update := FALSE ;
1434
    CalcISOTot ;
1435
    CalcAgeSailTot ;
1436
    CalcPdsSailTot ;
1437
    CalcP2SailTot ;
1438
    CalcPdsAvMBTot ;
1439
    CalcPdsApMBTot ;
1440
    CalcP2MBTot ;
1441
    CalcNbTotTot ;
1442
    CalcNbVifTot ;
1443
    CalcPVNaisTot ;
1444
    CalcNbSevTot ;
1445
    CalcPVSevTot ;
1446
    CalcGMQ ;
1447
  end ;
1448
end ;
1449
1450
procedure TFProfilT.PBNbrPt7Change (Sender : TObject) ;
1451
begin
1452
  if not Update
1453
  then
1454
  begin
1455
    Modified := TRUE ;
1456
    PProfilT.Truies[7].Nombre := PBNbrPt7.AsInteger ;
1457
    Update := TRUE ;
1458
    CalcNbrTot ;
1459
    CalcPct ;
1460
    Update := FALSE ;
1461
    CalcISOTot ;
1462
    CalcAgeSailTot ;
1463
    CalcPdsSailTot ;
1464
    CalcP2SailTot ;
1465
    CalcPdsAvMBTot ;
1466
    CalcPdsApMBTot ;
1467
    CalcP2MBTot ;
1468
    CalcNbTotTot ;
1469
    CalcNbVifTot ;
1470
    CalcPVNaisTot ;
1471
    CalcNbSevTot ;
1472
    CalcPVSevTot ;
1473
    CalcGMQ ;
1474
  end ;
1475
end ;
1476
1477
procedure TFProfilT.PBNbrPt8Change (Sender : TObject) ;
1478
begin
1479
  if not Update
1480
  then
1481
  begin
1482
    Modified := TRUE ;
1483
    PProfilT.Truies[8].Nombre := PBNbrPt8.AsInteger ;
1484
    Update := TRUE ;
1485
    CalcNbrTot ;
1486
    CalcPct ;
1487
    Update := FALSE ;
1488
    CalcISOTot ;
1489
    CalcAgeSailTot ;
1490
    CalcPdsSailTot ;
1491
    CalcP2SailTot ;
1492
    CalcPdsAvMBTot ;
1493
    CalcPdsApMBTot ;
1494
    CalcP2MBTot ;
1495
    CalcNbTotTot ;
1496
    CalcNbVifTot ;
1497
    CalcPVNaisTot ;
1498
    CalcNbSevTot ;
1499
    CalcPVSevTot ;
1500
    CalcGMQ ;
1501
  end ;
1502
end ;
1503
1504
procedure TFProfilT.PBNbrTotChange (Sender : TObject) ;
1505
begin
1506
  if not Update
1507
  then
1508
    CalcNbr ;
1509
end ;
1510
1511
procedure TFProfilT.CalcNbr ;
1512
var
1513
  etat : boolean ;
1514
begin
1515
  NombreTot :=  PBNbrTot.AsInteger;
1516
  etat := Update ;
1517
  Update := TRUE ;
1518
  if NombreTot = 0
1519
  then
1520
  begin
1521
    PBNbrPt1.Text := '' ;
1522
    PBNbrPt2.Text := '' ;
1523
    PBNbrPt3.Text := '' ;
1524
    PBNbrPt4.Text := '' ;
1525
    PBNbrPt5.Text := '' ;
1526
    PBNbrPt6.Text := '' ;
1527
    PBNbrPt7.Text := '' ;
1528
    PBNbrPt8.Text := '' ;
1529
  end
1530
  else
1531
  begin
1532
    PBNbrPt1.AsInteger := Round (NombreTot * PBPctPt1.AsFloat / 100) ;
1533
    PBNbrPt2.AsInteger := Round (NombreTot * PBPctPt2.AsFloat / 100) ;
1534
    PBNbrPt3.AsInteger := Round (NombreTot * PBPctPt3.AsFloat / 100) ;
1535
    PBNbrPt4.AsInteger := Round (NombreTot * PBPctPt4.AsFloat / 100) ;
1536
    PBNbrPt5.AsInteger := Round (NombreTot * PBPctPt5.AsFloat / 100) ;
1537
    PBNbrPt6.AsInteger := Round (NombreTot * PBPctPt6.AsFloat / 100) ;
1538
    PBNbrPt7.AsInteger := Round (NombreTot * PBPctPt7.AsFloat / 100) ;
1539
    PBNbrPt8.AsInteger := Round (NombreTot * PBPctPt8.AsFloat / 100) ;
1540
  end ;
1541
  Update := etat ;
1542
  if not Update
1543
  then
1544
  begin
1545
    Modified := TRUE ;
1546
    PProfilT.Truies[1].Nombre := PBNbrPt1.AsInteger ;
1547
    PProfilT.Truies[2].Nombre := PBNbrPt2.AsInteger ;
1548
    PProfilT.Truies[3].Nombre := PBNbrPt3.AsInteger ;
1549
    PProfilT.Truies[4].Nombre := PBNbrPt4.AsInteger ;
1550
    PProfilT.Truies[5].Nombre := PBNbrPt5.AsInteger ;
1551
    PProfilT.Truies[6].Nombre := PBNbrPt6.AsInteger ;
1552
    PProfilT.Truies[7].Nombre := PBNbrPt7.AsInteger ;
1553
    PProfilT.Truies[8].Nombre := PBNbrPt8.AsInteger ;
1554
    CalcISOTot ;
1555
    CalcAgeSailTot ;
1556
    CalcPdsSailTot ;
1557
    CalcP2SailTot ;
1558
    CalcPdsAvMBTot ;
1559
    CalcPdsApMBTot ;
1560
    CalcP2MBTot ;
1561
    CalcNbTotTot ;
1562
    CalcNbVifTot ;
1563
    CalcPVNaisTot ;
1564
    CalcNbSevTot ;
1565
    CalcPVSevTot ;
1566
    CalcGMQ ;
1567
  end ;
1568
end ;
1569
1570
procedure TFProfilT.CalcNbrTot ;
1571
var
1572
  i : integer ;
1573
begin
1574
  NombreTot := 0 ;
1575
  for i := 1 to NB_CYCLES do
1576
    NombreTot := NombreTot + PProfilT.Truies[i].Nombre ;
1577
  PBNbrTot.AsInteger := NombreTot ;
1578
end ;
1579
1580
procedure TFProfilT.PBPctChange (Sender : TObject) ;
1581
begin
1582
  if not Update
1583
  then
1584
  begin
1585
    CalcNbr ;
1586
    CalcPctTot ;
1587
  end ;
1588
end ;
1589
1590
procedure TFProfilT.CalcPct ;
1591
begin
1592
  if PBNbrTot.AsInteger = 0
1593
  then
1594
  begin
1595
    PBPctPt1.Text := '' ;
1596
    PBPctPt2.Text := '' ;
1597
    PBPctPt3.Text := '' ;
1598
    PBPctPt4.Text := '' ;
1599
    PBPctPt5.Text := '' ;
1600
    PBPctPt6.Text := '' ;
1601
    PBPctPt7.Text := '' ;
1602
    PBPctPt8.Text := '' ;
1603
    PBPctTot.Text := '' ;
1604
  end
1605
  else
1606
  begin
1607
    PBPctPt1.AsFloat := PBNbrPt1.AsInteger / PBNbrTot.AsInteger * 100 ;
1608
    PBPctPt2.AsFloat := PBNbrPt2.AsInteger / PBNbrTot.AsInteger * 100 ;
1609
    PBPctPt3.AsFloat := PBNbrPt3.AsInteger / PBNbrTot.AsInteger * 100 ;
1610
    PBPctPt4.AsFloat := PBNbrPt4.AsInteger / PBNbrTot.AsInteger * 100 ;
1611
    PBPctPt5.AsFloat := PBNbrPt5.AsInteger / PBNbrTot.AsInteger * 100 ;
1612
    PBPctPt6.AsFloat := PBNbrPt6.AsInteger / PBNbrTot.AsInteger * 100 ;
1613
    PBPctPt7.AsFloat := PBNbrPt7.AsInteger / PBNbrTot.AsInteger * 100 ;
1614
    PBPctPt8.AsFloat := PBNbrPt8.AsInteger / PBNbrTot.AsInteger * 100 ;
1615
    PBPctTot.AsFloat := 100 ;
1616
  end ;
1617
end ;
1618
1619
procedure TFProfilT.CalcPctTot ;
1620
begin
1621
  PBPctTot.AsFloat := PBPctPt1.AsFloat + PBPctPt2.AsFloat + PBPctPt3.AsFloat
1622
    + PBPctPt4.AsFloat + PBPctPt5.AsFloat + PBPctPt6.AsFloat + PBPctPt7.AsFloat
1623
    + PBPctPt8.AsFloat ;
1624
end ;
1625
1626
procedure TFProfilT.PBISOPt2Change(Sender: TObject);
1627
begin
1628
  if not Update
1629
  then
1630
  begin
1631
    Modified := TRUE ;
1632
    TabISO[2] := PBISOPt2.AsInteger ;
1633
    CalcISOTot ;
1634
    CalcAgeSail ;
1635
  end ;
1636
end;
1637
1638
procedure TFProfilT.PBISOPt3Change(Sender: TObject);
1639
begin
1640
  if not Update
1641
  then
1642
  begin
1643
    Modified := TRUE ;
1644
    TabISO[3] := PBISOPt3.AsInteger ;
1645
    CalcISOTot ;
1646
    CalcAgeSail ;
1647
  end ;
1648
end;
1649
1650
procedure TFProfilT.PBISOPt4Change(Sender: TObject);
1651
begin
1652
  if not Update
1653
  then
1654
  begin
1655
    Modified := TRUE ;
1656
    TabISO[4] := PBISOPt4.AsInteger ;
1657
    CalcISOTot ;
1658
    CalcAgeSail ;
1659
  end ;
1660
end;
1661
1662
procedure TFProfilT.PBISOPt5Change(Sender: TObject);
1663
begin
1664
  if not Update
1665
  then
1666
  begin
1667
    Modified := TRUE ;
1668
    TabISO[5] := PBISOPt5.AsInteger ;
1669
    CalcISOTot ;
1670
    CalcAgeSail ;
1671
  end ;
1672
end;
1673
1674
procedure TFProfilT.PBISOPt6Change(Sender: TObject);
1675
begin
1676
  if not Update
1677
  then
1678
  begin
1679
    Modified := TRUE ;
1680
    TabISO[6] := PBISOPt6.AsInteger ;
1681
    CalcISOTot ;
1682
    CalcAgeSail ;
1683
  end ;
1684
end;
1685
1686
procedure TFProfilT.PBISOPt7Change(Sender: TObject);
1687
begin
1688
  if not Update
1689
  then
1690
  begin
1691
    Modified := TRUE ;
1692
    TabISO[7] := PBISOPt7.AsInteger ;
1693
    CalcISOTot ;
1694
    CalcAgeSail ;
1695
  end ;
1696
end;
1697
1698
procedure TFProfilT.PBISOPt8Change(Sender: TObject);
1699
begin
1700
  if not Update
1701
  then
1702
  begin
1703
    Modified := TRUE ;
1704
    TabISO[8] := PBISOPt8.AsInteger ;
1705
    CalcISOTot ;
1706
    CalcAgeSail ;
1707
  end ;
1708
end;
1709
1710
procedure TFProfilT.CalcISOTot ;
1711
var
1712
  i : integer ;
1713
begin
1714
  if NombreTot - PProfilT.Truies[1].Nombre = 0
1715
  then
1716
    PBISOTot.Text := ''
1717
  else
1718
  begin
1719
    ISOTot := 0 ;
1720
    for i := 2 to NB_CYCLES do
1721
      ISOTot := ISOTot + (TabISO[i] * PProfilT.Truies[i].Nombre) ;
1722
    PBISOTot.AsInteger := Round (ISOTot / (NombreTot - PProfilT.Truies[1].Nombre)) ;
1723
  end ;
1724
end ;
1725
1726
procedure TFProfilT.CalcAgeSail ;
1727
var
1728
  i : integer ;
1729
begin
1730
  for i := 2 to NB_CYCLES do
1731
    if (PProfilT.Truies[i - 1].AgeSail = 0) or (TabISO[i] = 0)
1732
    then // Information absente
1733
      PProfilT.Truies[i].AgeSail := 0
1734
    else
1735
      PProfilT.Truies[i].AgeSail := PProfilT.Truies[i - 1].AgeSail + TabISO[i] + DureeGest + PProfilT.DureeLact ;
1736
  PBAgeSailPt2.AsInteger := PProfilT.Truies[2].AgeSail ;
1737
  PBAgeSailPt3.AsInteger := PProfilT.Truies[3].AgeSail ;
1738
  PBAgeSailPt4.AsInteger := PProfilT.Truies[4].AgeSail ;
1739
  PBAgeSailPt5.AsInteger := PProfilT.Truies[5].AgeSail ;
1740
  PBAgeSailPt6.AsInteger := PProfilT.Truies[6].AgeSail ;
1741
  PBAgeSailPt7.AsInteger := PProfilT.Truies[7].AgeSail ;
1742
  PBAgeSailPt8.AsInteger := PProfilT.Truies[8].AgeSail ;
1743
  CalcAgeSailTot ;
1744
end ;
1745
1746
procedure TFProfilT.PBAgeSailPt1Change (Sender : TObject) ;
1747
begin
1748
  if not Update
1749
  then
1750
  begin
1751
    Modified := TRUE ;
1752
    PProfilT.Truies[1].AgeSail := PBAgeSailPt1.AsInteger ;
1753
    CalcAgeSailTot ;
1754
  end ;
1755
end ;
1756
1757
{
1758
procedure TFProfilT.PBAgeSailPt2Change (Sender : TObject) ;
1759
begin
1760
  if not Update
1761
  then
1762
  begin
1763
    Modified := TRUE ;
1764
    PProfilT.Truies[2].AgeSail := PBAgeSailPt2.AsInteger ;
1765
    CalcAgeSailTot ;
1766
  end ;
1767
end ;
1768

1769
procedure TFProfilT.PBAgeSailPt3Change (Sender : TObject) ;
1770
begin
1771
  if not Update
1772
  then
1773
  begin
1774
    Modified := TRUE ;
1775
    PProfilT.Truies[3].AgeSail := PBAgeSailPt3.AsInteger ;
1776
    CalcAgeSailTot ;
1777
  end ;
1778
end ;
1779

1780
procedure TFProfilT.PBAgeSailPt4Change (Sender : TObject) ;
1781
begin
1782
  if not Update
1783
  then
1784
  begin
1785
    Modified := TRUE ;
1786
    PProfilT.Truies[4].AgeSail := PBAgeSailPt4.AsInteger ;
1787
    CalcAgeSailTot ;
1788
  end ;
1789
end ;
1790

1791
procedure TFProfilT.PBAgeSailPt5Change (Sender : TObject) ;
1792
begin
1793
  if not Update
1794
  then
1795
  begin
1796
    Modified := TRUE ;
1797
    PProfilT.Truies[5].AgeSail := PBAgeSailPt5.AsInteger ;
1798
    CalcAgeSailTot ;
1799
  end ;
1800
end ;
1801

1802
procedure TFProfilT.PBAgeSailPt6Change (Sender : TObject) ;
1803
begin
1804
  if not Update
1805
  then
1806
  begin
1807
    Modified := TRUE ;
1808
    PProfilT.Truies[6].AgeSail := PBAgeSailPt6.AsInteger ;
1809
    CalcAgeSailTot ;
1810
  end ;
1811
end ;
1812

1813
procedure TFProfilT.PBAgeSailPt7Change (Sender : TObject) ;
1814
begin
1815
  if not Update
1816
  then
1817
  begin
1818
    Modified := TRUE ;
1819
    PProfilT.Truies[7].AgeSail := PBAgeSailPt7.AsInteger ;
1820
    CalcAgeSailTot ;
1821
  end ;
1822
end ;
1823

1824
procedure TFProfilT.PBAgeSailPt8Change (Sender : TObject) ;
1825
begin
1826
  if not Update
1827
  then
1828
  begin
1829
    Modified := TRUE ;
1830
    PProfilT.Truies[8].AgeSail := PBAgeSailPt8.AsInteger ;
1831
    CalcAgeSailTot ;
1832
  end ;
1833
end ;
1834
}
1835
1836
procedure TFProfilT.CalcAgeSailTot ;
1837
var
1838
  i : integer ;
1839
begin
1840
  if NombreTot = 0
1841
  then
1842
    PBAgeSailTot.Text := ''
1843
  else
1844
  begin
1845
    AgeSailTot := 0 ;
1846
    for i := 1 to NB_CYCLES do
1847
      with PProfilT.Truies[i] do
1848
        AgeSailTot := AgeSailTot + (AgeSail * Nombre) ;
1849
    PBAgeSailTot.AsInteger := Round (AgeSailTot / NombreTot) ;
1850
  end ;
1851
end ;
1852
1853
procedure TFProfilT.PBPdsSailPt1Change (Sender : TObject) ;
1854
begin
1855
  if not Update
1856
  then
1857
  begin
1858
    Modified := TRUE ;
1859
    PProfilT.Truies[1].PdsSail := PBPdsSailPt1.AsFloat ;
1860
    CalcPdsSailTot ;
1861
  end ;
1862
end ;
1863
1864
procedure TFProfilT.PBPdsSailPt2Change (Sender : TObject) ;
1865
begin
1866
  if not Update
1867
  then
1868
  begin
1869
    Modified := TRUE ;
1870
    PProfilT.Truies[2].PdsSail := PBPdsSailPt2.AsFloat ;
1871
    CalcPdsSailTot ;
1872
  end ;
1873
end ;
1874
1875
procedure TFProfilT.PBPdsSailPt3Change (Sender : TObject) ;
1876
begin
1877
  if not Update
1878
  then
1879
  begin
1880
    Modified := TRUE ;
1881
    PProfilT.Truies[3].PdsSail := PBPdsSailPt3.AsFloat ;
1882
    CalcPdsSailTot ;
1883
  end ;
1884
end ;
1885
1886
procedure TFProfilT.PBPdsSailPt4Change (Sender : TObject) ;
1887
begin
1888
  if not Update
1889
  then
1890
  begin
1891
    Modified := TRUE ;
1892
    PProfilT.Truies[4].PdsSail := PBPdsSailPt4.AsFloat ;
1893
    CalcPdsSailTot ;
1894
  end ;
1895
end ;
1896
1897
procedure TFProfilT.PBPdsSailPt5Change (Sender : TObject) ;
1898
begin
1899
  if not Update
1900
  then
1901
  begin
1902
    Modified := TRUE ;
1903
    PProfilT.Truies[5].PdsSail := PBPdsSailPt5.AsFloat ;
1904
    CalcPdsSailTot ;
1905
  end ;
1906
end ;
1907
1908
procedure TFProfilT.PBPdsSailPt6Change (Sender : TObject) ;
1909
begin
1910
  if not Update
1911
  then
1912
  begin
1913
    Modified := TRUE ;
1914
    PProfilT.Truies[6].PdsSail := PBPdsSailPt6.AsFloat ;
1915
    CalcPdsSailTot ;
1916
  end ;
1917
end ;
1918
1919
procedure TFProfilT.PBPdsSailPt7Change (Sender : TObject) ;
1920
begin
1921
  if not Update
1922
  then
1923
  begin
1924
    Modified := TRUE ;
1925
    PProfilT.Truies[7].PdsSail := PBPdsSailPt7.AsFloat ;
1926
    CalcPdsSailTot ;
1927
  end ;
1928
end ;
1929
1930
procedure TFProfilT.PBPdsSailPt8Change (Sender : TObject) ;
1931
begin
1932
  if not Update
1933
  then
1934
  begin
1935
    Modified := TRUE ;
1936
    PProfilT.Truies[8].PdsSail := PBPdsSailPt8.AsFloat ;
1937
    CalcPdsSailTot ;
1938
  end ;
1939
end ;
1940
1941
procedure TFProfilT.CalcPdsSailTot ;
1942
var
1943
  i : integer ;
1944
begin
1945
  if NombreTot = 0
1946
  then
1947
    PBPdsSailTot.Text := ''
1948
  else
1949
  begin
1950
    PdsSailTot := 0 ;
1951
    for i := 1 to NB_CYCLES do
1952
      with PProfilT.Truies[i] do
1953
        PdsSailTot := PdsSailTot + (PdsSail * Nombre) ;
1954
    PBPdsSailTot.AsFloat := PdsSailTot / NombreTot ;
1955
  end ;
1956
end ;
1957
1958
procedure TFProfilT.PBP2SailPt1Change (Sender : TObject) ;
1959
begin
1960
  if not Update
1961
  then
1962
  begin
1963
    Modified := TRUE ;
1964
    PProfilT.Truies[1].P2Sail := PBP2SailPt1.AsFloat ;
1965
    CalcP2SailTot ;
1966
  end ;
1967
end ;
1968
1969
procedure TFProfilT.PBP2SailPt2Change (Sender : TObject) ;
1970
begin
1971
  if not Update
1972
  then
1973
  begin
1974
    Modified := TRUE ;
1975
    PProfilT.Truies[2].P2Sail := PBP2SailPt2.AsFloat ;
1976
    CalcP2SailTot ;
1977
  end ;
1978
end ;
1979
1980
procedure TFProfilT.PBP2SailPt3Change (Sender : TObject) ;
1981
begin
1982
  if not Update
1983
  then
1984
  begin
1985
    Modified := TRUE ;
1986
    PProfilT.Truies[3].P2Sail := PBP2SailPt3.AsFloat ;
1987
    CalcP2SailTot ;
1988
  end ;
1989
end ;
1990
1991
procedure TFProfilT.PBP2SailPt4Change (Sender : TObject) ;
1992
begin
1993
  if not Update
1994
  then
1995
  begin
1996
    Modified := TRUE ;
1997
    PProfilT.Truies[4].P2Sail := PBP2SailPt4.AsFloat ;
1998
    CalcP2SailTot ;
1999
  end ;
2000
end ;
2001
2002
procedure TFProfilT.PBP2SailPt5Change (Sender : TObject) ;
2003
begin
2004
  if not Update
2005
  then
2006
  begin
2007
    Modified := TRUE ;
2008
    PProfilT.Truies[5].P2Sail := PBP2SailPt5.AsFloat ;
2009
    CalcP2SailTot ;
2010
  end ;
2011
end ;
2012
2013
procedure TFProfilT.PBP2SailPt6Change (Sender : TObject) ;
2014
begin
2015
  if not Update
2016
  then
2017
  begin
2018
    Modified := TRUE ;
2019
    PProfilT.Truies[6].P2Sail := PBP2SailPt6.AsFloat ;
2020
    CalcP2SailTot ;
2021
  end ;
2022
end ;
2023
2024
procedure TFProfilT.PBP2SailPt7Change (Sender : TObject) ;
2025
begin
2026
  if not Update
2027
  then
2028
  begin
2029
    Modified := TRUE ;
2030
    PProfilT.Truies[7].P2Sail := PBP2SailPt7.AsFloat ;
2031
    CalcP2SailTot ;
2032
  end ;
2033
end ;
2034
2035
procedure TFProfilT.PBP2SailPt8Change (Sender : TObject) ;
2036
begin
2037
  if not Update
2038
  then
2039
  begin
2040
    Modified := TRUE ;
2041
    PProfilT.Truies[8].P2Sail := PBP2SailPt8.AsFloat ;
2042
    CalcP2SailTot ;
2043
  end ;
2044
end ;
2045
2046
procedure TFProfilT.CalcP2SailTot ;
2047
var
2048
  i : integer ;
2049
begin
2050
  if NombreTot = 0
2051
  then
2052
    PBP2SailTot.Text := ''
2053
  else
2054
  begin
2055
    P2SailTot := 0 ;
2056
    for i := 1 to NB_CYCLES do
2057
      with PProfilT.Truies[i] do
2058
        P2SailTot := P2SailTot + (P2Sail * Nombre) ;
2059
    PBP2SailTot.AsFloat := P2SailTot / NombreTot ;
2060
  end ;
2061
end ;
2062
2063
procedure TFProfilT.PBPdsAvMBPt1Change (Sender : TObject) ;
2064
begin
2065
  if not Update
2066
  then
2067
  begin
2068
    Modified := TRUE ;
2069
    PProfilT.Truies[1].PdsAvMB := PBPdsAvMBPt1.AsFloat ;
2070
    CalcPdsAvMBTot ;
2071
    if ChkPdsApMB.Checked
2072
    then
2073
      CalcPdsApMB ;
2074
  end ;
2075
end ;
2076
2077
procedure TFProfilT.PBPdsAvMBPt2Change (Sender : TObject) ;
2078
begin
2079
  if not Update
2080
  then
2081
  begin
2082
    Modified := TRUE ;
2083
    PProfilT.Truies[2].PdsAvMB := PBPdsAvMBPt2.AsFloat ;
2084
    CalcPdsAvMBTot ;
2085
    if ChkPdsApMB.Checked
2086
    then
2087
      CalcPdsApMB ;
2088
  end ;
2089
end ;
2090
2091
procedure TFProfilT.PBPdsAvMBPt3Change (Sender : TObject) ;
2092
begin
2093
  if not Update
2094
  then
2095
  begin
2096
    Modified := TRUE ;
2097
    PProfilT.Truies[3].PdsAvMB := PBPdsAvMBPt3.AsFloat ;
2098
    CalcPdsAvMBTot ;
2099
    if ChkPdsApMB.Checked
2100
    then
2101
      CalcPdsApMB ;
2102
  end ;
2103
end ;
2104
2105
procedure TFProfilT.PBPdsAvMBPt4Change (Sender : TObject) ;
2106
begin
2107
  if not Update
2108
  then
2109
  begin
2110
    Modified := TRUE ;
2111
    PProfilT.Truies[4].PdsAvMB := PBPdsAvMBPt4.AsFloat ;
2112
    CalcPdsAvMBTot ;
2113
    if ChkPdsApMB.Checked
2114
    then
2115
      CalcPdsApMB ;
2116
  end ;
2117
end ;
2118
2119
procedure TFProfilT.PBPdsAvMBPt5Change (Sender : TObject) ;
2120
begin
2121
  if not Update
2122
  then
2123
  begin
2124
    Modified := TRUE ;
2125
    PProfilT.Truies[5].PdsAvMB := PBPdsAvMBPt5.AsFloat ;
2126
    CalcPdsAvMBTot ;
2127
    if ChkPdsApMB.Checked
2128
    then
2129
      CalcPdsApMB ;
2130
  end ;
2131
end ;
2132
2133
procedure TFProfilT.PBPdsAvMBPt6Change (Sender : TObject) ;
2134
begin
2135
  if not Update
2136
  then
2137
  begin
2138
    Modified := TRUE ;
2139
    PProfilT.Truies[6].PdsAvMB := PBPdsAvMBPt6.AsFloat ;
2140
    CalcPdsAvMBTot ;
2141
    if ChkPdsApMB.Checked
2142
    then
2143
      CalcPdsApMB ;
2144
  end ;
2145
end ;
2146
2147
procedure TFProfilT.PBPdsAvMBPt7Change (Sender : TObject) ;
2148
begin
2149
  if not Update
2150
  then
2151
  begin
2152
    Modified := TRUE ;
2153
    PProfilT.Truies[7].PdsAvMB := PBPdsAvMBPt7.AsFloat ;
2154
    CalcPdsAvMBTot ;
2155
    if ChkPdsApMB.Checked
2156
    then
2157
      CalcPdsApMB ;
2158
  end ;
2159
end ;
2160
2161
procedure TFProfilT.PBPdsAvMBPt8Change (Sender : TObject) ;
2162
begin
2163
  if not Update
2164
  then
2165
  begin
2166
    Modified := TRUE ;
2167
    PProfilT.Truies[8].PdsAvMB := PBPdsAvMBPt8.AsFloat ;
2168
    CalcPdsAvMBTot ;
2169
    if ChkPdsApMB.Checked
2170
    then
2171
      CalcPdsApMB ;
2172
  end ;
2173
end ;
2174
2175
procedure TFProfilT.CalcPdsAvMBTot ;
2176
var
2177
  i : integer ;
2178
begin
2179
  if NombreTot = 0
2180
  then
2181
    PBPdsAvMBTot.Text := ''
2182
  else
2183
  begin
2184
    PdsAvMBTot := 0 ;
2185
    for i := 1 to NB_CYCLES do
2186
      with PProfilT.Truies[i] do
2187
        PdsAvMBTot := PdsAvMBTot + (PdsAvMB * Nombre) ;
2188
    PBPdsAvMBTot.AsFloat := PdsAvMBTot / NombreTot ;
2189
  end ;
2190
end ;
2191
2192
procedure TFProfilT.ChkPdsApMBClick (Sender : TObject) ;
2193
begin
2194
  PBPdsApMBPt1.Enabled := not ChkPdsApMB.Checked ;
2195
  PBPdsApMBPt2.Enabled := not ChkPdsApMB.Checked ;
2196
  PBPdsApMBPt3.Enabled := not ChkPdsApMB.Checked ;
2197
  PBPdsApMBPt4.Enabled := not ChkPdsApMB.Checked ;
2198
  PBPdsApMBPt5.Enabled := not ChkPdsApMB.Checked ;
2199
  PBPdsApMBPt6.Enabled := not ChkPdsApMB.Checked ;
2200
  PBPdsApMBPt7.Enabled := not ChkPdsApMB.Checked ;
2201
  PBPdsApMBPt8.Enabled := not ChkPdsApMB.Checked ;
2202
  CalcPdsApMB ;
2203
end ;
2204
2205
procedure TFProfilT.LPdsApMBClick(Sender: TObject);
2206
begin
2207
  ChkPdsApMB.Checked := not ChkPdsApMB.Checked ;
2208
end;
2209
2210
procedure TFProfilT.PBPdsApMBPt1Change (Sender : TObject) ;
2211
begin
2212
  if not Update
2213
  then
2214
  begin
2215
    Modified := TRUE ;
2216
    PProfilT.Truies[1].PdsApMB := PBPdsApMBPt1.AsFloat ;
2217
    CalcPdsApMBTot ;
2218
  end ;
2219
end ;
2220
2221
procedure TFProfilT.PBPdsApMBPt2Change (Sender : TObject) ;
2222
begin
2223
  if not Update
2224
  then
2225
  begin
2226
    Modified := TRUE ;
2227
    PProfilT.Truies[2].PdsApMB := PBPdsApMBPt2.AsFloat ;
2228
    CalcPdsApMBTot ;
2229
  end ;
2230
end ;
2231
2232
procedure TFProfilT.PBPdsApMBPt3Change (Sender : TObject) ;
2233
begin
2234
  if not Update
2235
  then
2236
  begin
2237
    Modified := TRUE ;
2238
    PProfilT.Truies[3].PdsApMB := PBPdsApMBPt3.AsFloat ;
2239
    CalcPdsApMBTot ;
2240
  end ;
2241
end ;
2242
2243
procedure TFProfilT.PBPdsApMBPt4Change (Sender : TObject) ;
2244
begin
2245
  if not Update
2246
  then
2247
  begin
2248
    Modified := TRUE ;
2249
    PProfilT.Truies[4].PdsApMB := PBPdsApMBPt4.AsFloat ;
2250
    CalcPdsApMBTot ;
2251
  end ;
2252
end ;
2253
2254
procedure TFProfilT.PBPdsApMBPt5Change (Sender : TObject) ;
2255
begin
2256
  if not Update
2257
  then
2258
  begin
2259
    Modified := TRUE ;
2260
    PProfilT.Truies[5].PdsApMB := PBPdsApMBPt5.AsFloat ;
2261
    CalcPdsApMBTot ;
2262
  end ;
2263
end ;
2264
2265
procedure TFProfilT.PBPdsApMBPt6Change (Sender : TObject) ;
2266
begin
2267
  if not Update
2268
  then
2269
  begin
2270
    Modified := TRUE ;
2271
    PProfilT.Truies[6].PdsApMB := PBPdsApMBPt6.AsFloat ;
2272
    CalcPdsApMBTot ;
2273
  end ;
2274
end ;
2275
2276
procedure TFProfilT.PBPdsApMBPt7Change (Sender : TObject) ;
2277
begin
2278
  if not Update
2279
  then
2280
  begin
2281
    Modified := TRUE ;
2282
    PProfilT.Truies[7].PdsApMB := PBPdsApMBPt7.AsFloat ;
2283
    CalcPdsApMBTot ;
2284
  end ;
2285
end ;
2286
2287
procedure TFProfilT.PBPdsApMBPt8Change (Sender : TObject) ;
2288
begin
2289
  if not Update
2290
  then
2291
  begin
2292
    Modified := TRUE ;
2293
    PProfilT.Truies[8].PdsApMB := PBPdsApMBPt8.AsFloat ;
2294
    CalcPdsApMBTot ;
2295
  end ;
2296
end ;
2297
2298
procedure TFProfilT.CalcPdsApMB ;
2299
var
2300
  i : integer ;
2301
begin
2302
  Modified := TRUE ;
2303
  for i := 1 to NB_CYCLES do
2304
    with PProfilT.Truies[i], PProfilT.Porcelets[i] do
2305
      PdsApMB := PdsAvMB - (0.3 + 1.329 * (NesTotaux * PdsNais)) ;
2306
  Update := TRUE ;
2307
  PBPdsApMBPt1.AsFloat := PProfilT.Truies[1].PdsApMB ;
2308
  PBPdsApMBPt2.AsFloat := PProfilT.Truies[2].PdsApMB ;
2309
  PBPdsApMBPt3.AsFloat := PProfilT.Truies[3].PdsApMB ;
2310
  PBPdsApMBPt4.AsFloat := PProfilT.Truies[4].PdsApMB ;
2311
  PBPdsApMBPt5.AsFloat := PProfilT.Truies[5].PdsApMB ;
2312
  PBPdsApMBPt6.AsFloat := PProfilT.Truies[6].PdsApMB ;
2313
  PBPdsApMBPt7.AsFloat := PProfilT.Truies[7].PdsApMB ;
2314
  PBPdsApMBPt8.AsFloat := PProfilT.Truies[8].PdsApMB ;
2315
  Update := FALSE ;
2316
  CalcPdsApMBTot ;
2317
end ;
2318
2319
procedure TFProfilT.CalcPdsApMBTot ;
2320
var
2321
  i : integer ;
2322
begin
2323
  if NombreTot = 0
2324
  then
2325
    PBPdsApMBTot.Text := ''
2326
  else
2327
  begin
2328
    PdsApMBTot := 0 ;
2329
    for i := 1 to NB_CYCLES do
2330
      with PProfilT.Truies[i] do
2331
        PdsApMBTot := PdsApMBTot + (PdsApMB * Nombre) ;
2332
    PBPdsApMBTot.AsFloat := PdsApMBTot / NombreTot ;
2333
  end ;
2334
end ;
2335
2336
procedure TFProfilT.PBP2MBPt1Change (Sender : TObject) ;
2337
begin
2338
  if not Update
2339
  then
2340
  begin
2341
    Modified := TRUE ;
2342
    PProfilT.Truies[1].P2MB := PBP2MBPt1.AsFloat ;
2343
    CalcP2MBTot ;
2344
  end ;
2345
end ;
2346
2347
procedure TFProfilT.PBP2MBPt2Change (Sender : TObject) ;
2348
begin
2349
  if not Update
2350
  then
2351
  begin
2352
    Modified := TRUE ;
2353
    PProfilT.Truies[2].P2MB := PBP2MBPt2.AsFloat ;
2354
    CalcP2MBTot ;
2355
  end ;
2356
end ;
2357
2358
procedure TFProfilT.PBP2MBPt3Change (Sender : TObject) ;
2359
begin
2360
  if not Update
2361
  then
2362
  begin
2363
    Modified := TRUE ;
2364
    PProfilT.Truies[3].P2MB := PBP2MBPt3.AsFloat ;
2365
    CalcP2MBTot ;
2366
  end ;
2367
end ;
2368
2369
procedure TFProfilT.PBP2MBPt4Change (Sender : TObject) ;
2370
begin
2371
  if not Update
2372
  then
2373
  begin
2374
    Modified := TRUE ;
2375
    PProfilT.Truies[4].P2MB := PBP2MBPt4.AsFloat ;
2376
    CalcP2MBTot ;
2377
  end ;
2378
end ;
2379
2380
procedure TFProfilT.PBP2MBPt5Change (Sender : TObject) ;
2381
begin
2382
  if not Update
2383
  then
2384
  begin
2385
    Modified := TRUE ;
2386
    PProfilT.Truies[5].P2MB := PBP2MBPt5.AsFloat ;
2387
    CalcP2MBTot ;
2388
  end ;
2389
end ;
2390
2391
procedure TFProfilT.PBP2MBPt6Change (Sender : TObject) ;
2392
begin
2393
  if not Update
2394
  then
2395
  begin
2396
    Modified := TRUE ;
2397
    PProfilT.Truies[6].P2MB := PBP2MBPt6.AsFloat ;
2398
    CalcP2MBTot ;
2399
  end ;
2400
end ;
2401
2402
procedure TFProfilT.PBP2MBPt7Change (Sender : TObject) ;
2403
begin
2404
  if not Update
2405
  then
2406
  begin
2407
    Modified := TRUE ;
2408
    PProfilT.Truies[7].P2MB := PBP2MBPt7.AsFloat ;
2409
    CalcP2MBTot ;
2410
  end ;
2411
end ;
2412
2413
procedure TFProfilT.PBP2MBPt8Change (Sender : TObject) ;
2414
begin
2415
  if not Update
2416
  then
2417
  begin
2418
    Modified := TRUE ;
2419
    PProfilT.Truies[8].P2MB := PBP2MBPt8.AsFloat ;
2420
    CalcP2MBTot ;
2421
  end ;
2422
end ;
2423
2424
procedure TFProfilT.CalcP2MBTot ;
2425
var
2426
  i : integer ;
2427
begin
2428
  if NombreTot = 0
2429
  then
2430
    PBP2MBTot.Text := ''
2431
  else
2432
  begin
2433
    P2MBTot := 0 ;
2434
    for i := 1 to NB_CYCLES do
2435
      with PProfilT.Truies[i] do
2436
        P2MBTot := P2MBTot + (P2MB * Nombre) ;
2437
    PBP2MBTot.AsFloat := P2MBTot / NombreTot ;
2438
  end ;
2439
end ;
2440
2441
// Porcelets
2442
2443
procedure TFProfilT.PBNbTotPt1Change (Sender : TObject) ;
2444
begin
2445
  if not Update
2446
  then
2447
  begin
2448
    Modified := TRUE ;
2449
    PProfilT.Porcelets[1].NesTotaux := PBNbTotPt1.AsFloat ;
2450
    CalcNbTotTot ;
2451
    if ChkPdsApMB.Checked
2452
    then
2453
      CalcPdsApMB ;
2454
  end ;
2455
end ;
2456
2457
procedure TFProfilT.PBNbTotPt2Change (Sender : TObject) ;
2458
begin
2459
  if not Update
2460
  then
2461
  begin
2462
    Modified := TRUE ;
2463
    PProfilT.Porcelets[2].NesTotaux := PBNbTotPt2.AsFloat ;
2464
    CalcNbTotTot ;
2465
    if ChkPdsApMB.Checked
2466
    then
2467
      CalcPdsApMB ;
2468
  end ;
2469
end ;
2470
2471
procedure TFProfilT.PBNbTotPt3Change (Sender : TObject) ;
2472
begin
2473
  if not Update
2474
  then
2475
  begin
2476
    Modified := TRUE ;
2477
    PProfilT.Porcelets[3].NesTotaux := PBNbTotPt3.AsFloat ;
2478
    CalcNbTotTot ;
2479
    if ChkPdsApMB.Checked
2480
    then
2481
      CalcPdsApMB ;
2482
  end ;
2483
end ;
2484
2485
procedure TFProfilT.PBNbTotPt4Change (Sender : TObject) ;
2486
begin
2487
  if not Update
2488
  then
2489
  begin
2490
    Modified := TRUE ;
2491
    PProfilT.Porcelets[4].NesTotaux := PBNbTotPt4.AsFloat ;
2492
    CalcNbTotTot ;
2493
    if ChkPdsApMB.Checked
2494
    then
2495
      CalcPdsApMB ;
2496
  end ;
2497
end ;
2498
2499
procedure TFProfilT.PBNbTotPt5Change (Sender : TObject) ;
2500
begin
2501
  if not Update
2502
  then
2503
  begin
2504
    Modified := TRUE ;
2505
    PProfilT.Porcelets[5].NesTotaux := PBNbTotPt5.AsFloat ;
2506
    CalcNbTotTot ;
2507
    if ChkPdsApMB.Checked
2508
    then
2509
      CalcPdsApMB ;
2510
  end ;
2511
end ;
2512
2513
procedure TFProfilT.PBNbTotPt6Change (Sender : TObject) ;
2514
begin
2515
  if not Update
2516
  then
2517
  begin
2518
    Modified := TRUE ;
2519
    PProfilT.Porcelets[6].NesTotaux := PBNbTotPt6.AsFloat ;
2520
    CalcNbTotTot ;
2521
    if ChkPdsApMB.Checked
2522
    then
2523
      CalcPdsApMB ;
2524
  end ;
2525
end ;
2526
2527
procedure TFProfilT.PBNbTotPt7Change (Sender : TObject) ;
2528
begin
2529
  if not Update
2530
  then
2531
  begin
2532
    Modified := TRUE ;
2533
    PProfilT.Porcelets[7].NesTotaux := PBNbTotPt7.AsFloat ;
2534
    CalcNbTotTot ;
2535
    if ChkPdsApMB.Checked
2536
    then
2537
      CalcPdsApMB ;
2538
  end ;
2539
end ;
2540
2541
procedure TFProfilT.PBNbTotPt8Change (Sender : TObject) ;
2542
begin
2543
  if not Update
2544
  then
2545
  begin
2546
    Modified := TRUE ;
2547
    PProfilT.Porcelets[8].NesTotaux := PBNbTotPt8.AsFloat ;
2548
    CalcNbTotTot ;
2549
    if ChkPdsApMB.Checked
2550
    then
2551
      CalcPdsApMB ;
2552
  end ;
2553
end ;
2554
2555
procedure TFProfilT.CalcNbTotTot ;
2556
var
2557
  i : integer ;
2558
begin
2559
  if NombreTot = 0
2560
  then
2561
    PBNbTotTot.Text := ''
2562
  else
2563
  begin
2564
    NesTotauxTot := 0 ;
2565
    for i := 1 to NB_CYCLES do
2566
      with PProfilT.Truies[i], PProfilT.Porcelets[i] do
2567
        NesTotauxTot := NesTotauxTot + (NesTotaux * Nombre) ;
2568
    PBNbTotTot.AsFloat := NesTotauxTot / NombreTot ;
2569
  end ;
2570
end ;
2571
2572
procedure TFProfilT.PBNbVifPt1Change (Sender : TObject) ;
2573
begin
2574
  if not Update
2575
  then
2576
  begin
2577
    Modified := TRUE ;
2578
    PProfilT.Porcelets[1].NesVivants := PBNbVifPt1.AsFloat ;
2579
    CalcNbVifTot ;
2580
  end ;
2581
end ;
2582
2583
procedure TFProfilT.PBNbVifPt2Change (Sender : TObject) ;
2584
begin
2585
  if not Update
2586
  then
2587
  begin
2588
    Modified := TRUE ;
2589
    PProfilT.Porcelets[2].NesVivants := PBNbVifPt2.AsFloat ;
2590
    CalcNbVifTot ;
2591
  end ;
2592
end ;
2593
2594
procedure TFProfilT.PBNbVifPt3Change (Sender : TObject) ;
2595
begin
2596
  if not Update
2597
  then
2598
  begin
2599
    Modified := TRUE ;
2600
    PProfilT.Porcelets[3].NesVivants := PBNbVifPt3.AsFloat ;
2601
    CalcNbVifTot ;
2602
  end ;
2603
end ;
2604
2605
procedure TFProfilT.PBNbVifPt4Change (Sender : TObject) ;
2606
begin
2607
  if not Update
2608
  then
2609
  begin
2610
    Modified := TRUE ;
2611
    PProfilT.Porcelets[4].NesVivants := PBNbVifPt4.AsFloat ;
2612
    CalcNbVifTot ;
2613
  end ;
2614
end ;
2615
2616
procedure TFProfilT.PBNbVifPt5Change (Sender : TObject) ;
2617
begin
2618
  if not Update
2619
  then
2620
  begin
2621
    Modified := TRUE ;
2622
    PProfilT.Porcelets[5].NesVivants := PBNbVifPt5.AsFloat ;
2623
    CalcNbVifTot ;
2624
  end ;
2625
end ;
2626
2627
procedure TFProfilT.PBNbVifPt6Change (Sender : TObject) ;
2628
begin
2629
  if not Update
2630
  then
2631
  begin
2632
    Modified := TRUE ;
2633
    PProfilT.Porcelets[6].NesVivants := PBNbVifPt6.AsFloat ;
2634
    CalcNbVifTot ;
2635
  end ;
2636
end ;
2637
2638
procedure TFProfilT.PBNbVifPt7Change (Sender : TObject) ;
2639
begin
2640
  if not Update
2641
  then
2642
  begin
2643
    Modified := TRUE ;
2644
    PProfilT.Porcelets[7].NesVivants := PBNbVifPt7.AsFloat ;
2645
    CalcNbVifTot ;
2646
  end ;
2647
end ;
2648
2649
procedure TFProfilT.PBNbVifPt8Change (Sender : TObject) ;
2650
begin
2651
  if not Update
2652
  then
2653
  begin
2654
    Modified := TRUE ;
2655
    PProfilT.Porcelets[8].NesVivants := PBNbVifPt8.AsFloat ;
2656
    CalcNbVifTot ;
2657
  end ;
2658
end ;
2659
2660
procedure TFProfilT.CalcNbVifTot ;
2661
var
2662
  i : integer ;
2663
begin
2664
  if NombreTot = 0
2665
  then
2666
    PBNbVifTot.Text := ''
2667
  else
2668
  begin
2669
    NesVivantsTot := 0 ;
2670
    for i := 1 to NB_CYCLES do
2671
      with PProfilT.Truies[i], PProfilT.Porcelets[i] do
2672
        NesVivantsTot := NesVivantsTot + (NesVivants * Nombre) ;
2673
    PBNbVifTot.AsFloat := NesVivantsTot / NombreTot ;
2674
  end ;
2675
end ;
2676
2677
procedure TFProfilT.PBPVNaisPt1Change (Sender : TObject) ;
2678
begin
2679
  if not Update
2680
  then
2681
  begin
2682
    Modified := TRUE ;
2683
    PProfilT.Porcelets[1].PdsNais := PBPVNaisPt1.AsFloat ;
2684
    CalcPVNaisTot ;
2685
    CalcGMQ ;
2686
    if ChkPdsApMB.Checked
2687
    then
2688
      CalcPdsApMB ;
2689
  end ;
2690
end ;
2691
2692
procedure TFProfilT.PBPVNaisPt2Change (Sender : TObject) ;
2693
begin
2694
  if not Update
2695
  then
2696
  begin
2697
    Modified := TRUE ;
2698
    PProfilT.Porcelets[2].PdsNais := PBPVNaisPt2.AsFloat ;
2699
    CalcPVNaisTot ;
2700
    CalcGMQ ;
2701
    if ChkPdsApMB.Checked
2702
    then
2703
      CalcPdsApMB ;
2704
  end ;
2705
end ;
2706
2707
procedure TFProfilT.PBPVNaisPt3Change (Sender : TObject) ;
2708
begin
2709
  if not Update
2710
  then
2711
  begin
2712
    Modified := TRUE ;
2713
    PProfilT.Porcelets[3].PdsNais := PBPVNaisPt3.AsFloat ;
2714
    CalcPVNaisTot ;
2715
    CalcGMQ ;
2716
    if ChkPdsApMB.Checked
2717
    then
2718
      CalcPdsApMB ;
2719
  end ;
2720
end ;
2721
2722
procedure TFProfilT.PBPVNaisPt4Change (Sender : TObject) ;
2723
begin
2724
  if not Update
2725
  then
2726
  begin
2727
    Modified := TRUE ;
2728
    PProfilT.Porcelets[4].PdsNais := PBPVNaisPt4.AsFloat ;
2729
    CalcPVNaisTot ;
2730
    CalcGMQ ;
2731
    if ChkPdsApMB.Checked
2732
    then
2733
      CalcPdsApMB ;
2734
  end ;
2735
end ;
2736
2737
procedure TFProfilT.PBPVNaisPt5Change (Sender : TObject) ;
2738
begin
2739
  if not Update
2740
  then
2741
  begin
2742
    Modified := TRUE ;
2743
    PProfilT.Porcelets[5].PdsNais := PBPVNaisPt5.AsFloat ;
2744
    CalcPVNaisTot ;
2745
    CalcGMQ ;
2746
    if ChkPdsApMB.Checked
2747
    then
2748
      CalcPdsApMB ;
2749
  end ;
2750
end ;
2751
2752
procedure TFProfilT.PBPVNaisPt6Change (Sender : TObject) ;
2753
begin
2754
  if not Update
2755
  then
2756
  begin
2757
    Modified := TRUE ;
2758
    PProfilT.Porcelets[6].PdsNais := PBPVNaisPt6.AsFloat ;
2759
    CalcPVNaisTot ;
2760
    CalcGMQ ;
2761
    if ChkPdsApMB.Checked
2762
    then
2763
      CalcPdsApMB ;
2764
  end ;
2765
end ;
2766
2767
procedure TFProfilT.PBPVNaisPt7Change (Sender : TObject) ;
2768
begin
2769
  if not Update
2770
  then
2771
  begin
2772
    Modified := TRUE ;
2773
    PProfilT.Porcelets[7].PdsNais := PBPVNaisPt7.AsFloat ;
2774
    CalcPVNaisTot ;
2775
    CalcGMQ ;
2776
    if ChkPdsApMB.Checked
2777
    then
2778
      CalcPdsApMB ;
2779
  end ;
2780
end ;
2781
2782
procedure TFProfilT.PBPVNaisPt8Change (Sender : TObject) ;
2783
begin
2784
  if not Update
2785
  then
2786
  begin
2787
    Modified := TRUE ;
2788
    PProfilT.Porcelets[8].PdsNais := PBPVNaisPt8.AsFloat ;
2789
    CalcPVNaisTot ;
2790
    CalcGMQ ;
2791
    if ChkPdsApMB.Checked
2792
    then
2793
      CalcPdsApMB ;
2794
  end ;
2795
end ;
2796
2797
procedure TFProfilT.CalcPVNaisTot ;
2798
var
2799
  i : integer ;
2800
begin
2801
  if NesVivantsTot = 0
2802
  then
2803
    PBPVNaisTot.Text := ''
2804
  else
2805
  begin
2806
    PdsNaisTot := 0 ;
2807
    for i := 1 to NB_CYCLES do
2808
      with PProfilT.Truies[i], PProfilT.Porcelets[i] do
2809
        PdsNaisTot := PdsNaisTot + (PdsNais * NesVivants * Nombre) ;
2810
    PBPVNaisTot.AsFloat := PdsNaisTot / NesVivantsTot ;
2811
  end ;
2812
end ;
2813
2814
procedure TFProfilT.PBNbSevPt1Change (Sender : TObject) ;
2815
begin
2816
  if not Update
2817
  then
2818
  begin
2819
    Modified := TRUE ;
2820
    PProfilT.Porcelets[1].Sevres := PBNbSevPt1.AsFloat ;
2821
    CalcNbSevTot ;
2822
  end ;
2823
end ;
2824
2825
procedure TFProfilT.PBNbSevPt2Change (Sender : TObject) ;
2826
begin
2827
  if not Update
2828
  then
2829
  begin
2830
    Modified := TRUE ;
2831
    PProfilT.Porcelets[2].Sevres := PBNbSevPt2.AsFloat ;
2832
    CalcNbSevTot ;
2833
  end ;
2834
end ;
2835
2836
procedure TFProfilT.PBNbSevPt3Change (Sender : TObject) ;
2837
begin
2838
  if not Update
2839
  then
2840
  begin
2841
    Modified := TRUE ;
2842
    PProfilT.Porcelets[3].Sevres := PBNbSevPt3.AsFloat ;
2843
    CalcNbSevTot ;
2844
  end ;
2845
end ;
2846
2847
procedure TFProfilT.PBNbSevPt4Change (Sender : TObject) ;
2848
begin
2849
  if not Update
2850
  then
2851
  begin
2852
    Modified := TRUE ;
2853
    PProfilT.Porcelets[4].Sevres := PBNbSevPt4.AsFloat ;
2854
    CalcNbSevTot ;
2855
  end ;
2856
end ;
2857
2858
procedure TFProfilT.PBNbSevPt5Change (Sender : TObject) ;
2859
begin
2860
  if not Update
2861
  then
2862
  begin
2863
    Modified := TRUE ;
2864
    PProfilT.Porcelets[5].Sevres := PBNbSevPt5.AsFloat ;
2865
    CalcNbSevTot ;
2866
  end ;
2867
end ;
2868
2869
procedure TFProfilT.PBNbSevPt6Change (Sender : TObject) ;
2870
begin
2871
  if not Update
2872
  then
2873
  begin
2874
    Modified := TRUE ;
2875
    PProfilT.Porcelets[6].Sevres := PBNbSevPt6.AsFloat ;
2876
    CalcNbSevTot ;
2877
  end ;
2878
end ;
2879
2880
procedure TFProfilT.PBNbSevPt7Change (Sender : TObject) ;
2881
begin
2882
  if not Update
2883
  then
2884
  begin
2885
    Modified := TRUE ;
2886
    PProfilT.Porcelets[7].Sevres := PBNbSevPt7.AsFloat ;
2887
    CalcNbSevTot ;
2888
  end ;
2889
end ;
2890
2891
procedure TFProfilT.PBNbSevPt8Change (Sender : TObject) ;
2892
begin
2893
  if not Update
2894
  then
2895
  begin
2896
    Modified := TRUE ;
2897
    PProfilT.Porcelets[8].Sevres := PBNbSevPt8.AsFloat ;
2898
    CalcNbSevTot ;
2899
  end ;
2900
end ;
2901
2902
procedure TFProfilT.CalcNbSevTot ;
2903
var
2904
  i : integer ;
2905
begin
2906
  if NombreTot = 0
2907
  then
2908
    PBNbSevTot.Text := ''
2909
  else
2910
  begin
2911
    SevresTot := 0 ;
2912
    for i := 1 to NB_CYCLES do
2913
      with PProfilT.Truies[i], PProfilT.Porcelets[i] do
2914
        SevresTot := SevresTot + (Sevres * Nombre) ;
2915
    PBNbSevTot.AsFloat := SevresTot / NombreTot ;
2916
  end ;
2917
end ;
2918
2919
procedure TFProfilT.PBDureeLactChange (Sender : TObject) ;
2920
begin
2921
  if not Update
2922
  then
2923
  begin
2924
    Modified := TRUE ;
2925
    PProfilT.DureeLact := PBDureeLact.AsInteger ;
2926
    CalcAgeSail ;
2927
    CalcGMQ ;
2928
  end ;
2929
  PBAgeSevPt1.AsInteger := PProfilT.DureeLact ;
2930
  PBAgeSevPt2.AsInteger := PProfilT.DureeLact ;
2931
  PBAgeSevPt3.AsInteger := PProfilT.DureeLact ;
2932
  PBAgeSevPt4.AsInteger := PProfilT.DureeLact ;
2933
  PBAgeSevPt5.AsInteger := PProfilT.DureeLact ;
2934
  PBAgeSevPt6.AsInteger := PProfilT.DureeLact ;
2935
  PBAgeSevPt7.AsInteger := PProfilT.DureeLact ;
2936
  PBAgeSevPt8.AsInteger := PProfilT.DureeLact ;
2937
end ;
2938
2939
procedure TFProfilT.PBPVSevPt1Change (Sender : TObject) ;
2940
begin
2941
  if not Update
2942
  then
2943
  begin
2944
    Modified := TRUE ;
2945
    PProfilT.Porcelets[1].PdsSev := PBPVSevPt1.AsFloat ;
2946
    CalcPVSevTot ;
2947
    CalcGMQ ;
2948
  end ;
2949
end ;
2950
2951
procedure TFProfilT.PBPVSevPt2Change (Sender : TObject) ;
2952
begin
2953
  if not Update
2954
  then
2955
  begin
2956
    Modified := TRUE ;
2957
    PProfilT.Porcelets[2].PdsSev := PBPVSevPt2.AsFloat ;
2958
    CalcPVSevTot ;
2959
    CalcGMQ ;
2960
  end ;
2961
end ;
2962
2963
procedure TFProfilT.PBPVSevPt3Change (Sender : TObject) ;
2964
begin
2965
  if not Update
2966
  then
2967
  begin
2968
    Modified := TRUE ;
2969
    PProfilT.Porcelets[3].PdsSev := PBPVSevPt3.AsFloat ;
2970
    CalcPVSevTot ;
2971
    CalcGMQ ;
2972
  end ;
2973
end ;
2974
2975
procedure TFProfilT.PBPVSevPt4Change (Sender : TObject) ;
2976
begin
2977
  if not Update
2978
  then
2979
  begin
2980
    Modified := TRUE ;
2981
    PProfilT.Porcelets[4].PdsSev := PBPVSevPt4.AsFloat ;
2982
    CalcPVSevTot ;
2983
    CalcGMQ ;
2984
  end ;
2985
end ;
2986
2987
procedure TFProfilT.PBPVSevPt5Change (Sender : TObject) ;
2988
begin
2989
  if not Update
2990
  then
2991
  begin
2992
    Modified := TRUE ;
2993
    PProfilT.Porcelets[5].PdsSev := PBPVSevPt5.AsFloat ;
2994
    CalcPVSevTot ;
2995
    CalcGMQ ;
2996
  end ;
2997
end ;
2998
2999
procedure TFProfilT.PBPVSevPt6Change (Sender : TObject) ;
3000
begin
3001
  if not Update
3002
  then
3003
  begin
3004
    Modified := TRUE ;
3005
    PProfilT.Porcelets[6].PdsSev := PBPVSevPt6.AsFloat ;
3006
    CalcPVSevTot ;
3007
    CalcGMQ ;
3008
  end ;
3009
end ;
3010
3011
procedure TFProfilT.PBPVSevPt7Change (Sender : TObject) ;
3012
begin
3013
  if not Update
3014
  then
3015
  begin
3016
    Modified := TRUE ;
3017
    PProfilT.Porcelets[7].PdsSev := PBPVSevPt7.AsFloat ;
3018
    CalcPVSevTot ;
3019
    CalcGMQ ;
3020
  end ;
3021
end ;
3022
3023
procedure TFProfilT.PBPVSevPt8Change (Sender : TObject) ;
3024
begin
3025
  if not Update
3026
  then
3027
  begin
3028
    Modified := TRUE ;
3029
    PProfilT.Porcelets[8].PdsSev := PBPVSevPt8.AsFloat ;
3030
    CalcPVSevTot ;
3031
    CalcGMQ ;
3032
  end ;
3033
end ;
3034
3035
procedure TFProfilT.CalcPVSevTot ;
3036
var
3037
  i : integer ;
3038
begin
3039
  if SevresTot = 0
3040
  then
3041
    PBPVSevTot.Text := ''
3042
  else
3043
  begin
3044
    PdsSevTot := 0 ;
3045
    for i := 1 to NB_CYCLES do
3046
      with PProfilT.Truies[i], PProfilT.Porcelets[i] do
3047
        PdsSevTot := PdsSevTot + (PdsSev * Sevres * Nombre) ;
3048
    PBPVSevTot.AsFloat := PdsSevTot / SevresTot ;
3049
  end ;
3050
end ;
3051
3052
procedure TFProfilT.CalcGMQ ;
3053
var
3054
  i : integer ;
3055
begin
3056
  for i := 1 to NB_CYCLES do
3057
    with PProfilT.Porcelets[i] do
3058
      TabGMQ[i] := (PdsSev - PdsNais) * Sevres / PProfilT.DureeLact ;
3059
  PBGMQPt1.AsFloat := TabGMQ[1] ;
3060
  PBGMQPt2.AsFloat := TabGMQ[2] ;
3061
  PBGMQPt3.AsFloat := TabGMQ[3] ;
3062
  PBGMQPt4.AsFloat := TabGMQ[4] ;
3063
  PBGMQPt5.AsFloat := TabGMQ[5] ;
3064
  PBGMQPt6.AsFloat := TabGMQ[6] ;
3065
  PBGMQPt7.AsFloat := TabGMQ[7] ;
3066
  PBGMQPt8.AsFloat := TabGMQ[8] ;
3067
  if NombreTot = 0
3068
  then
3069
    PBGMQTot.Text := ''
3070
  else
3071
  begin
3072
    GMQTot := 0 ;
3073
    for i := 1 to NB_CYCLES do
3074
      with PProfilT.Truies[i], PProfilT.Porcelets[i] do
3075
        GMQTot := GMQTot + (TabGMQ[i] * Nombre) ;
3076
    PBGMQTot.AsFloat := GMQTot / NombreTot ;
3077
  end ;
3078
end ;
3079
3080
// Alimentation
3081
3082
procedure TFProfilT.CBSeqAliChange (Sender : TObject) ;
3083
begin
3084
  PSeqAliT := ListSeqAliT[FindIdxSeqAliT (CBSeqAli.Text)] ;
3085
  CBSeqAli.Hint := PSeqAliT.Memo ;
3086
  if not Update
3087
  then
3088
  begin
3089
    Modified := TRUE ;
3090
    PProfilT.SeqAli := FindNumSeqAliT (CBSeqAli.Text) ;
3091
  end ;
3092
end ;
3093
3094
procedure TFProfilT.CBLogeChange (Sender : TObject) ;
3095
begin
3096
  PLogeT := ListLogeT[FindIdxLogeT (CBLoge.Text)] ;
3097
  CBLoge.Hint := PLogeT.Memo ;
3098
  if not Update
3099
  then
3100
  begin
3101
    Modified := TRUE ;
3102
    PProfilT.Loge := FindNumLogeT (CBLoge.Text) ;
3103
  end ;
3104
end ;
3105
3106
procedure TFProfilT.CBUniteChange (Sender : TObject) ;
3107
begin
3108
  if not Update
3109
  then
3110
  begin
3111
    Modified := TRUE ;
3112
    PProfilT.Unite := CBUnite.ItemIndex ;
3113
    AffGraphAli ;
3114
  end ;
3115
end ;
3116
3117
procedure TFProfilT.PBAliGestPt1Change (Sender : TObject) ;
3118
begin
3119
  if not Update
3120
  then
3121
  begin
3122
    Modified := TRUE ;
3123
    PProfilT.Gest[1] := PBAliGestPt1.AsFloat ;
3124
    CalcAliGestTot ;
3125
    AffGraphAli ;
3126
  end ;
3127
end ;
3128
3129
procedure TFProfilT.PBAliGestPt2Change (Sender : TObject) ;
3130
begin
3131
  if not Update
3132
  then
3133
  begin
3134
    Modified := TRUE ;
3135
    PProfilT.Gest[2] := PBAliGestPt2.AsFloat ;
3136
    CalcAliGestTot ;
3137
    AffGraphAli ;
3138
  end ;
3139
end ;
3140
3141
procedure TFProfilT.PBAliGestPt3Change (Sender : TObject) ;
3142
begin
3143
  if not Update
3144
  then
3145
  begin
3146
    Modified := TRUE ;
3147
    PProfilT.Gest[3] := PBAliGestPt3.AsFloat ;
3148
    CalcAliGestTot ;
3149
    AffGraphAli ;
3150
  end ;
3151
end ;
3152
3153
procedure TFProfilT.PBAliGestPt4Change (Sender : TObject) ;
3154
begin
3155
  if not Update
3156
  then
3157
  begin
3158
    Modified := TRUE ;
3159
    PProfilT.Gest[4] := PBAliGestPt4.AsFloat ;
3160
    CalcAliGestTot ;
3161
    AffGraphAli ;
3162
  end ;
3163
end ;
3164
3165
procedure TFProfilT.PBAliGestPt5Change (Sender : TObject) ;
3166
begin
3167
  if not Update
3168
  then
3169
  begin
3170
    Modified := TRUE ;
3171
    PProfilT.Gest[5] := PBAliGestPt5.AsFloat ;
3172
    CalcAliGestTot ;
3173
    AffGraphAli ;
3174
  end ;
3175
end ;
3176
3177
procedure TFProfilT.PBAliGestPt6Change (Sender : TObject) ;
3178
begin
3179
  if not Update
3180
  then
3181
  begin
3182
    Modified := TRUE ;
3183
    PProfilT.Gest[6] := PBAliGestPt6.AsFloat ;
3184
    CalcAliGestTot ;
3185
    AffGraphAli ;
3186
  end ;
3187
end ;
3188
3189
procedure TFProfilT.PBAliGestPt7Change (Sender : TObject) ;
3190
begin
3191
  if not Update
3192
  then
3193
  begin
3194
    Modified := TRUE ;
3195
    PProfilT.Gest[7] := PBAliGestPt7.AsFloat ;
3196
    CalcAliGestTot ;
3197
    AffGraphAli ;
3198
  end ;
3199
end ;
3200
3201
procedure TFProfilT.PBAliGestPt8Change (Sender : TObject) ;
3202
begin
3203
  if not Update
3204
  then
3205
  begin
3206
    Modified := TRUE ;
3207
    PProfilT.Gest[8] := PBAliGestPt8.AsFloat ;
3208
    CalcAliGestTot ;
3209
    AffGraphAli ;
3210
  end ;
3211
end ;
3212
3213
procedure TFProfilT.CalcAliGestTot ;
3214
begin
3215
  if PBNbrTot.AsInteger = 0
3216
  then
3217
    PBAliGestTot.Text := ''
3218
  else
3219
    PBAliGestTot.AsFloat := (PBAliGestPt1.AsFloat * PBNbrPt1.AsInteger
3220
      + PBAliGestPt2.AsFloat * PBNbrPt2.AsInteger
3221
      + PBAliGestPt3.AsFloat * PBNbrPt3.AsInteger
3222
      + PBAliGestPt4.AsFloat * PBNbrPt4.AsInteger
3223
      + PBAliGestPt5.AsFloat * PBNbrPt5.AsInteger
3224
      + PBAliGestPt6.AsFloat * PBNbrPt6.AsInteger
3225
      + PBAliGestPt7.AsFloat * PBNbrPt7.AsInteger
3226
      + PBAliGestPt8.AsFloat * PBNbrPt8.AsInteger) / PBNbrTot.AsInteger ;
3227
end ;
3228
3229
procedure TFProfilT.PBAliLactPt1Change (Sender : TObject) ;
3230
begin
3231
  if not Update
3232
  then
3233
  begin
3234
    Modified := TRUE ;
3235
    PProfilT.Lact[1] := PBAliLactPt1.AsFloat ;
3236
    CalcAliLactTot ;
3237
    AffGraphAli ;
3238
  end ;
3239
end ;
3240
3241
procedure TFProfilT.PBAliLactPt2Change (Sender : TObject) ;
3242
begin
3243
  if not Update
3244
  then
3245
  begin
3246
    Modified := TRUE ;
3247
    PProfilT.Lact[2] := PBAliLactPt2.AsFloat ;
3248
    CalcAliLactTot ;
3249
    AffGraphAli ;
3250
  end ;
3251
end ;
3252
3253
procedure TFProfilT.PBAliLactPt3Change (Sender : TObject) ;
3254
begin
3255
  if not Update
3256
  then
3257
  begin
3258
    Modified := TRUE ;
3259
    PProfilT.Lact[3] := PBAliLactPt3.AsFloat ;
3260
    CalcAliLactTot ;
3261
    AffGraphAli ;
3262
  end ;
3263
end ;
3264
3265
procedure TFProfilT.PBAliLactPt4Change (Sender : TObject) ;
3266
begin
3267
  if not Update
3268
  then
3269
  begin
3270
    Modified := TRUE ;
3271
    PProfilT.Lact[4] := PBAliLactPt4.AsFloat ;
3272
    CalcAliLactTot ;
3273
    AffGraphAli ;
3274
  end ;
3275
end ;
3276
3277
procedure TFProfilT.PBAliLactPt5Change (Sender : TObject) ;
3278
begin
3279
  if not Update
3280
  then
3281
  begin
3282
    Modified := TRUE ;
3283
    PProfilT.Lact[5] := PBAliLactPt5.AsFloat ;
3284
    CalcAliLactTot ;
3285
    AffGraphAli ;
3286
  end ;
3287
end ;
3288
3289
procedure TFProfilT.PBAliLactPt6Change (Sender : TObject) ;
3290
begin
3291
  if not Update
3292
  then
3293
  begin
3294
    Modified := TRUE ;
3295
    PProfilT.Lact[6] := PBAliLactPt6.AsFloat ;
3296
    CalcAliLactTot ;
3297
    AffGraphAli ;
3298
  end ;
3299
end ;
3300
3301
procedure TFProfilT.PBAliLactPt7Change (Sender : TObject) ;
3302
begin
3303
  if not Update
3304
  then
3305
  begin
3306
    Modified := TRUE ;
3307
    PProfilT.Lact[7] := PBAliLactPt7.AsFloat ;
3308
    CalcAliLactTot ;
3309
    AffGraphAli ;
3310
  end ;
3311
end ;
3312
3313
procedure TFProfilT.PBAliLactPt8Change (Sender : TObject) ;
3314
begin
3315
  if not Update
3316
  then
3317
  begin
3318
    Modified := TRUE ;
3319
    PProfilT.Lact[8] := PBAliLactPt8.AsFloat ;
3320
    CalcAliLactTot ;
3321
    AffGraphAli ;
3322
  end ;
3323
end ;
3324
3325
procedure TFProfilT.CalcAliLactTot ;
3326
begin
3327
  if PBNbrTot.AsInteger = 0
3328
  then
3329
    PBAliLactTot.Text := ''
3330
  else
3331
    PBAliLactTot.AsFloat := (PBAliLactPt1.AsFloat * PBNbrPt1.AsInteger
3332
      + PBAliLactPt2.AsFloat * PBNbrPt2.AsInteger
3333
      + PBAliLactPt3.AsFloat * PBNbrPt3.AsInteger
3334
      + PBAliLactPt4.AsFloat * PBNbrPt4.AsInteger
3335
      + PBAliLactPt5.AsFloat * PBNbrPt5.AsInteger
3336
      + PBAliLactPt6.AsFloat * PBNbrPt6.AsInteger
3337
      + PBAliLactPt7.AsFloat * PBNbrPt7.AsInteger
3338
      + PBAliLactPt8.AsFloat * PBNbrPt8.AsInteger) / PBNbrTot.AsInteger ;
3339
end ;
3340
3341
procedure TFProfilT.InitGraphAli ;
3342
begin
3343
  // BarGest : s?rie (barre) graphique
3344
  BarGest := TBarSeries.Create (GraphAli) ;
3345
  BarGest.ParentChart := GraphAli ;
3346
  BarGest.Title := LAliGest.Caption ;
3347
  BarGest.BarPen.Color := BarGest.SeriesColor ;
3348
  BarGest.Marks.Style := smsValue ;
3349
  BarGest.Marks.ArrowLength := 0 ;
3350
  BarGest.Marks.Arrow.Visible := FALSE ;
3351
  BarGest.Marks.Brush.Style := bsClear ;
3352
  BarGest.Marks.Frame.Visible := FALSE ;
3353
  GraphAli.AddSeries (BarGest) ;
3354
  // BarLact : s?rie (barre) graphique
3355
  BarLact := TBarSeries.Create (GraphAli) ;
3356
  BarLact.ParentChart := GraphAli ;
3357
  BarLact.Title := LAliLact.Caption ;
3358
  BarLact.BarPen.Color := BarLact.SeriesColor ;
3359
  BarLact.Marks.Style := smsValue ;
3360
  BarLact.Marks.ArrowLength := 0 ;
3361
  BarLact.Marks.Arrow.Visible := FALSE ;
3362
  BarLact.Marks.Brush.Style := bsClear ;
3363
  BarLact.Marks.Frame.Visible := FALSE ;
3364
  GraphAli.AddSeries (BarLact) ;
3365
end ;
3366
3367
procedure TFProfilT.AffGraphAli ;
3368
var
3369
  i : integer ;
3370
begin
3371
  with PProfilT^ do
3372
  begin
3373
    if Unite = -1
3374
    then
3375
      GraphAli.LeftAxis.Title.Caption := ''
3376
    else
3377
      GraphAli.LeftAxis.Title.Caption := CBUnite.Items[Unite] ;
3378
    BarGest.Clear ;
3379
    BarLact.Clear ;
3380
    for i := 1 to NB_CYCLES do
3381
      BarGest.AddBar (Gest[i], IntToStr (i), clTeeColor) ;
3382
    for i := 1 to NB_CYCLES do
3383
      BarLact.AddBar (Lact[i], IntToStr (i), clTeeColor) ;
3384
  end ;
3385
  AjustEchelle (GraphAli) ;
3386
end ;
3387
3388
// Graphiques
3389
3390
procedure TFProfilT.CBOngletChange (Sender : TObject) ;
3391
begin
3392
  case CBOnglet.ItemIndex of
3393
    0 : // Truie
3394
    begin
3395
      CBTruie.Visible := TRUE ;
3396
      CBPortee.Visible := FALSE ;
3397
    end ;
3398
    1 : // Porcelets
3399
    begin
3400
      CBTruie.Visible := FALSE ;
3401
      CBPortee.Visible := TRUE ;
3402
    end ;
3403
  end ;
3404
  AffGraph ;
3405
end ;
3406
3407
procedure TFProfilT.CBGraphChange (Sender : TObject) ;
3408
begin
3409
  AffGraph ;
3410
end ;
3411
3412
procedure TFProfilT.InitGraph ;
3413
begin
3414
  // LinePds : s?rie (ligne) graphique
3415
  LinePds := TLineSeries.Create (Graph) ;
3416
  LinePds.ParentChart := Graph ;
3417
  LinePds.SeriesColor := clTeal ;
3418
  LinePds.LinePen.Color := LinePds.SeriesColor ;
3419
  LinePds.LinePen.Width := 2 ;
3420
  LinePds.Pointer.Visible := TRUE ;
3421
  LinePds.Pointer.HorizSize := 2 ;
3422
  LinePds.Pointer.VertSize := 2 ;
3423
  Graph.AddSeries (LinePds) ;
3424
  // LineP2 : s?rie (ligne) graphique
3425
  LineP2 := TLineSeries.Create (Graph) ;
3426
  LineP2.ParentChart := Graph ;
3427
  LineP2.SeriesColor := clTeal ;
3428
  LineP2.LinePen.Color := LineP2.SeriesColor ;
3429
  LineP2.LinePen.Width := 2 ;
3430
  LineP2.Pointer.Visible := TRUE ;
3431
  LineP2.Pointer.HorizSize := 2 ;
3432
  LineP2.Pointer.VertSize := 2 ;
3433
  Graph.AddSeries (LineP2) ;
3434
  // LineAjust : s?rie (ligne) graphique
3435
  LineAjust := TLineSeries.Create (Graph) ;
3436
  LineAjust.ParentChart := Graph ;
3437
  LineAjust.SeriesColor := clRed ;
3438
  LineAjust.LinePen.Color := LineAjust.SeriesColor ;
3439
  LineAjust.LinePen.Width := 2 ;
3440
  Graph.AddSeries (LineAjust) ;
3441
  // PointAjust : s?rie (point) graphique
3442
  PointAjust := TPointSeries.Create (Graph) ;
3443
  PointAjust.ParentChart := Graph ;
3444
  PointAjust.SeriesColor := clGreen ;
3445
  PointAjust.Pointer.HorizSize := 2 ;
3446
  PointAjust.Pointer.VertSize := 2 ;
3447
  Graph.AddSeries (PointAjust) ;
3448
  // LineNesTotaux : s?rie (ligne) graphique
3449
  LineNesTotaux := TLineSeries.Create (Graph) ;
3450
  LineNesTotaux.ParentChart := Graph ;
3451
  LineNesTotaux.Title := LNbTot.Caption ;
3452
  LineNesTotaux.SeriesColor := clRed ;
3453
  LineNesTotaux.LinePen.Color := LineNesTotaux.SeriesColor ;
3454
  LineNesTotaux.LinePen.Width := 2 ;
3455
  LineNesTotaux.Pointer.Visible := TRUE ;
3456
  LineNesTotaux.Pointer.HorizSize := 2 ;
3457
  LineNesTotaux.Pointer.VertSize := 2 ;
3458
  Graph.AddSeries (LineNesTotaux) ;
3459
  // LineNesVivants : s?rie (ligne) graphique
3460
  LineNesVivants := TLineSeries.Create (Graph) ;
3461
  LineNesVivants.ParentChart := Graph ;
3462
  LineNesVivants.Title := LNbVif.Caption ;
3463
  LineNesVivants.SeriesColor := clNavy ;
3464
  LineNesVivants.LinePen.Color := LineNesVivants.SeriesColor ;
3465
  LineNesVivants.LinePen.Width := 2 ;
3466
  LineNesVivants.Pointer.Visible := TRUE ;
3467
  LineNesVivants.Pointer.HorizSize := 2 ;
3468
  LineNesVivants.Pointer.VertSize := 2 ;
3469
  Graph.AddSeries (LineNesVivants) ;
3470
  // LineSevres : s?rie (ligne) graphique
3471
  LineSevres := TLineSeries.Create (Graph) ;
3472
  LineSevres.ParentChart := Graph ;
3473
  LineSevres.Title := LNbSev.Caption ;
3474
  LineSevres.SeriesColor := clGreen ;
3475
  LineSevres.LinePen.Color := LineSevres.SeriesColor ;
3476
  LineSevres.LinePen.Width := 2 ;
3477
  LineSevres.Pointer.Visible := TRUE ;
3478
  LineSevres.Pointer.HorizSize := 2 ;
3479
  LineSevres.Pointer.VertSize := 2 ;
3480
  Graph.AddSeries (LineSevres) ;
3481
  // LinePdsNais : s?rie (ligne) graphique
3482
  LinePdsNais := TLineSeries.Create (Graph) ;
3483
  LinePdsNais.ParentChart := Graph ;
3484
  LinePdsNais.Title := LPVNais.Caption ;
3485
  LinePdsNais.SeriesColor := clRed ;
3486
  LinePdsNais.LinePen.Color := LinePdsNais.SeriesColor ;
3487
  LinePdsNais.LinePen.Width := 2 ;
3488
  LinePdsNais.Pointer.Visible := TRUE ;
3489
  LinePdsNais.Pointer.HorizSize := 2 ;
3490
  LinePdsNais.Pointer.VertSize := 2 ;
3491
  Graph.AddSeries (LinePdsNais) ;
3492
  // LinePdsSev : s?rie (ligne) graphique
3493
  LinePdsSev := TLineSeries.Create (Graph) ;
3494
  LinePdsSev.ParentChart := Graph ;
3495
  LinePdsSev.Title := LPVSev.Caption ;
3496
  LinePdsSev.SeriesColor := clGreen ;
3497
  LinePdsSev.LinePen.Color := LinePdsSev.SeriesColor ;
3498
  LinePdsSev.LinePen.Width := 2 ;
3499
  LinePdsSev.Pointer.Visible := TRUE ;
3500
  LinePdsSev.Pointer.HorizSize := 2 ;
3501
  LinePdsSev.Pointer.VertSize := 2 ;
3502
  Graph.AddSeries (LinePdsSev) ;
3503
  // LineGMQ : s?rie (ligne) graphique
3504
  LineGMQ := TLineSeries.Create (Graph) ;
3505
  LineGMQ.ParentChart := Graph ;
3506
  LineGMQ.SeriesColor := clTeal ;
3507
  LineGMQ.LinePen.Color := LineGMQ.SeriesColor ;
3508
  LineGMQ.LinePen.Width := 2 ;
3509
  LineGMQ.Pointer.Visible := TRUE ;
3510
  LineGMQ.Pointer.HorizSize := 2 ;
3511
  LineGMQ.Pointer.VertSize := 2 ;
3512
  Graph.AddSeries (LineGMQ) ;
3513
end ;
3514
3515
procedure TFProfilT.AffGraph;
3516
var
3517
  i: integer;
3518
begin
3519
  Graph.Title.Text.Clear;
3520
  Graph.SubTitle.Text.Clear;
3521
  LinePds.Active := FALSE;
3522
  LineP2.Active := FALSE;
3523
  LineAjust.Active := FALSE;
3524
  PointAjust.Active := FALSE;
3525
  LineSevres.Active := FALSE;
3526
  LineNesVivants.Active := FALSE;
3527
  LineNesTotaux.Active := FALSE;
3528
  LinePdsNais.Active := FALSE;
3529
  LinePdsSev.Active := FALSE;
3530
  LineGMQ.Active := FALSE;
3531
  case CBOnglet.ItemIndex of
3532
    0: // Truie
3533
    begin
3534
      Graph.Title.Text.Add (Format ('%s : %s', [CBOnglet.Text, CBTruie.Text]));
3535
      Graph.Legend.Visible := FALSE ;
3536
      Graph.BottomAxis.Title.Caption := Format('%s (%s)', [_('Age'), _('d')]);
3537
      case CBTruie.ItemIndex of
3538
        0: // Poids
3539
        begin
3540
          Graph.LeftAxis.Title.Caption := Format('%s (%s)', [_('Body weight'), _('kg')]);
3541
          LinePds.Active := TRUE ;
3542
          LinePds.Clear ;
3543
          for i := 1 to NB_CYCLES do
3544
            with PProfilT.Truies[i] do
3545
            begin
3546
              LinePds.AddXY (AgeSail, PdsSail) ;
3547
              LinePds.AddXY (AgeSail + DureeGest, PdsAvMB) ;
3548
              LinePds.AddXY (AgeSail + DureeGest, PdsApMB) ;
3549
            end;
3550
        end;
3551
        1: // Epaisseur de lard
3552
        begin
3553
          Graph.LeftAxis.Title.Caption := Format('%s (%s)', [_('Backfat thickness'), _('mm')]);
3554
          LineP2.Active := TRUE ;
3555
          LineP2.Clear ;
3556
          for i := 1 to NB_CYCLES do
3557
            with PProfilT.Truies[i] do
3558
            begin
3559
              LineP2.AddXY (AgeSail, P2Sail) ;
3560
              LineP2.AddXY (AgeSail + DureeGest, P2MB) ;
3561
            end;
3562
        end;
3563
        2: // Ajustement poids apr?s mise-bas
3564
        begin
3565
          Graph.LeftAxis.Title.Caption := '' ;
3566
          LineAjust.Active := TRUE ;
3567
          PointAjust.Active := TRUE ;
3568
          LineAjust.Clear ;
3569
          PointAjust.Clear ;
3570
          AjustPdsApMB ;
3571
          if PProfilT.pmax > 0
3572
          then
3573
          begin
3574
            Graph.SubTitle.Text.Add (Format ('Y = %.1f * (1 - Exp ((- %.2f / 1000) * X^%.2f))', [PProfilT.pmax, PProfilT.a, PProfilT.b])) ;
3575
            for i := PProfilT.Truies[1].AgeSail + DureeGest to PProfilT.Truies[NB_CYCLES].AgeSail + DureeGest do
3576
              LineAjust.AddXY (i, PProfilT.pmax * (1 - Exp ((- PProfilT.a / 1000) * Power (i, PProfilT.b)))) ;
3577
          end;
3578
          for i := 1 to NB_CYCLES do
3579
            with PProfilT.Truies[i] do
3580
              PointAjust.AddXY (AgeSail + DureeGest, PdsApMB) ;
3581
        end;
3582
      end;
3583
    end;
3584
    1: // Porcelets
3585
    begin
3586
      Graph.Title.Text.Add (Format ('%s : %s', [CBOnglet.Text, CBPortee.Text]));
3587
      Graph.BottomAxis.Title.Caption := _('Litter');
3588
      case CBPortee.ItemIndex of
3589
        0: // Nombre
3590
        begin
3591
          Graph.Legend.Visible := TRUE ;
3592
          Graph.LeftAxis.Title.Caption := '' ;
3593
          LineNesTotaux.Active := TRUE ;
3594
          LineNesVivants.Active := TRUE ;
3595
          LineSevres.Active := TRUE ;
3596
          LineNesTotaux.Clear ;
3597
          LineNesVivants.Clear ;
3598
          LineSevres.Clear ;
3599
          for i := 1 to NB_CYCLES do
3600
            with PProfilT.Porcelets[i] do
3601
            begin
3602
              LineNesTotaux.AddXY (i, NesTotaux) ;
3603
              LineNesVivants.AddXY (i, NesVivants) ;
3604
              LineSevres.AddXY (i, Sevres) ;
3605
            end;
3606
        end;
3607
        1: // Poids
3608
        begin
3609
          Graph.Legend.Visible := TRUE ;
3610
          Graph.LeftAxis.Title.Caption := Format('%s (%s)', [_('Body weight'), _('kg')]);
3611
          LinePdsNais.Active := TRUE ;
3612
          LinePdsSev.Active := TRUE ;
3613
          LinePdsNais.Clear ;
3614
          LinePdsSev.Clear ;
3615
          for i := 1 to NB_CYCLES do
3616
            with PProfilT.Porcelets[i] do
3617
            begin
3618
              LinePdsNais.AddXY (i, PdsNais) ;
3619
              LinePdsSev.AddXY (i, PdsSev) ;
3620
            end;
3621
        end;
3622
        2: // GMQ port?e
3623
        begin
3624
          Graph.Legend.Visible := FALSE ;
3625
          Graph.LeftAxis.Title.Caption := '' ;
3626
          LineGMQ.Active := TRUE ;
3627
          LineGMQ.Clear ;
3628
          for i := 1 to NB_CYCLES do
3629
            LineGMQ.AddXY (i, TabGMQ[i]) ;
3630
        end;
3631
      end;
3632
    end;
3633
  end;
3634
  AjustEchelle(Graph);
3635
end;
3636
3637
procedure TFProfilT.AjustPdsApMB ;
3638
const
3639
  DELTA = 0.3 ;
3640
  SEUIL = 0.001 ;
3641
  MAX_TOURS = 1000 ;
3642
var
3643
  tour, i, j, k, cycle, mini : integer ;
3644
  delta_pmax, delta_a, delta_b, estim, ecart : double ;
3645
  tab_pmax, tab_a, tab_b, tab_ecart : array[-13..13] of double ;
3646
  ok : boolean ;
3647
begin
3648
  if PProfilT.pmax = 0
3649
  then
3650
  begin
3651
    tab_pmax[0] := 0 ;
3652
    for i := 1 to NB_CYCLES do
3653
      with PProfilT.Truies[i] do
3654
        if PdsApMB > tab_pmax[0]
3655
        then
3656
          tab_pmax[0] := PdsApMB ;
3657
    tab_a[0] := 5.0 ;
3658
    tab_b[0] := 1.0 ;
3659
  end
3660
  else
3661
  begin
3662
    tab_pmax[0] := PProfilT.pmax ;
3663
    tab_a[0] := PProfilT.a ;
3664
    tab_b[0] := PProfilT.b ;
3665
  end ;
3666
  delta_pmax := tab_pmax[0] * DELTA ;
3667
  delta_a := tab_a[0] * DELTA ;
3668
  delta_b := tab_b[0] * DELTA ;
3669
  tour := 0 ;
3670
  repeat
3671
    // ?value les points
3672
    for i := -1 to 1 do
3673
      for j := -1 to 1 do
3674
        for k := -1 to 1 do
3675
        begin
3676
          tab_pmax[i + 3*j + 9*k] := Max (tab_pmax[0] + i * delta_pmax, 0) ;
3677
          tab_a[i + 3*j + 9*k] := Max (tab_a[0] + j * delta_a, 0) ;
3678
          tab_b[i + 3*j + 9*k] := Max (tab_b[0] + k * delta_b, 0) ;
3679
        end ;
3680
    for i := -13 to 13 do
3681
      tab_ecart[i] := 0 ;
3682
    for i := -13 to 13 do
3683
      for cycle := 1 to NB_CYCLES do
3684
        with PProfilT.Truies[cycle] do
3685
        begin
3686
          estim := tab_pmax[i] * (1 - Exp ((- tab_a[i] / 1000) * Power (AgeSail + DureeGest, tab_b[i]))) ;
3687
          ecart := estim - PdsApMB ;
3688
          tab_ecart[i] := tab_ecart[i] + Power (ecart, 2) * Nombre ;
3689
        end ;
3690
    // recherche le meilleur point
3691
    mini := 0 ;
3692
    for i := -13 to 13 do
3693
      if tab_ecart[i] < tab_ecart[mini]
3694
      then
3695
        mini := i ;
3696
    // d?termine le point central
3697
    if mini = 0
3698
    then
3699
    begin
3700
      delta_pmax := delta_pmax * 0.9 ;
3701
      delta_a := delta_a * 0.9 ;
3702
      delta_b := delta_b * 0.9 ;
3703
    end
3704
    else
3705
    begin
3706
      tab_pmax[0] := tab_pmax[mini] ;
3707
      tab_a[0] := tab_a[mini] ;
3708
      tab_b[0] := tab_b[mini] ;
3709
    end ;
3710
    // ?value si les crit?res de sortie sont satisfaits
3711
    ok := (delta_pmax < Abs (tab_pmax [mini] * SEUIL))
3712
      and (delta_a < Abs (tab_a [mini] * SEUIL))
3713
      and (delta_b < Abs (tab_b [mini] * SEUIL)) ;
3714
    Inc (tour) ;
3715
  until ok or (tour > MAX_TOURS) ;
3716
  if ok
3717
  then
3718
  begin
3719
    PProfilT.pmax := tab_pmax[0] ;
3720
    PProfilT.a := tab_a[0] ;
3721
    PProfilT.b := tab_b[0] ;
3722
  end
3723
  else
3724
  begin
3725
    PProfilT.pmax := 0 ;
3726
    PProfilT.a := 0 ;
3727
    PProfilT.b := 0 ;
3728
  end ;
3729
end ;
3730
3731
// Calibrage
3732
3733
procedure TFProfilT.AffGraphCal ;
3734
var
3735
  i, j : integer ;
3736
begin
3737
  // LignePds
3738
  LignePds.Clear ;
3739
  for j := 1 to PResSimulT.NbJSim do
3740
  begin
3741
    if (j > 1) and (PResSimulT.TabResult[3, j] <> PResSimulT.TabResult[3, j - 1])
3742
    then // Rupture de stade
3743
      LignePds.AddXY (PResSimulT.TabResult[1, j], PResSimulT.TabResult[60, j], '', clNone) ;
3744
    LignePds.AddXY (PResSimulT.TabResult[1, j], PResSimulT.TabResult[60, j], '', clTeeColor) ;
3745
  end ;
3746
  // PointPds
3747
  PointPds.Clear ;
3748
  for i := 1 to NB_CYCLES do
3749
    with PProfilT.Truies[i] do
3750
    begin
3751
      PointPds.AddXY (AgeSail, PdsSail) ;
3752
      PointPds.AddXY (AgeSail + DureeGest, PdsApMB) ;
3753
    end ;
3754
  // LigneP2
3755
  LigneP2.Clear ;
3756
  for j := 1 to PResSimulT.NbJSim do
3757
  begin
3758
    if (j > 1) and (PResSimulT.TabResult[3, j] <> PResSimulT.TabResult[3, j - 1])
3759
    then // Rupture de stade
3760
      LigneP2.AddXY (PResSimulT.TabResult[1, j], PResSimulT.TabResult[67, j], '', clNone) ;
3761
    LigneP2.AddXY (PResSimulT.TabResult[1, j], PResSimulT.TabResult[67, j], '', clTeeColor) ;
3762
  end ;
3763
  // PointP2
3764
  PointP2.Clear ;
3765
  for i := 1 to NB_CYCLES do
3766
    with PProfilT.Truies[i] do
3767
    begin
3768
      PointP2.AddXY (AgeSail, P2Sail) ;
3769
      PointP2.AddXY (AgeSail + DureeGest, P2MB) ;
3770
    end ;
3771
end ;
3772
3773
procedure TFProfilT.SBCalibrClick(Sender: TObject);
3774
begin
3775
  Modal := True;
3776
  Modified:= True;
3777
  Update := True;
3778
  GraphCalibr.Title.Visible := True;
3779
  GraphCalibr.SubTitle.Visible := True;
3780
  FCalibrage := TFCalibrage.Create (Self) ;
3781
  FCalibrage.ShowModal ;
3782
  FCalibrage.Release ;
3783
  GraphCalibr.Title.Visible := False;
3784
  GraphCalibr.SubTitle.Visible := False;
3785
  Update := False;
3786
  Modal := False;
3787
end;
3788
3789
procedure TFProfilT.SBResetClick(Sender: TObject);
3790
var
3791
  cycle : integer ;
3792
begin
3793
  Modified := True;
3794
  PProfilT.CoefEntretienGest := 1;
3795
  PProfilT.CoefEntretienLact := 1;
3796
  PProfilT.RatioLipProt := 0.9;
3797
  for cycle := 1 to NB_CYCLES do
3798
    PProfilT.CoefNR[cycle] := DefaultCoefNR[cycle];
3799
  Update := True;
3800
  PBCoefEntGest.AsFloat := PProfilT.CoefEntretienGest;
3801
  PBCoefEntLact.AsFloat := PProfilT.CoefEntretienLact;
3802
  PBRatioLipProt.AsFloat := 1 - PProfilT.RatioLipProt;
3803
  Update := False;
3804
  ValidBBCalibre;
3805
end;
3806
3807
procedure TFProfilT.PBCoefEntGestChange(Sender: TObject);
3808
begin
3809
  if not Update
3810
  then
3811
  begin
3812
    Modified := True;
3813
    PProfilT.CoefEntretienGest := PBCoefEntGest.AsFloat;
3814
    ValidBBCalibre;
3815
  end;
3816
end;
3817
3818
procedure TFProfilT.PBCoefEntLactChange(Sender: TObject);
3819
begin
3820
  if not Update
3821
  then
3822
  begin
3823
    Modified := True;
3824
    PProfilT.CoefEntretienLact := PBCoefEntLact.AsFloat;
3825
    ValidBBCalibre;
3826
  end;
3827
end;
3828
3829
procedure TFProfilT.PBRatioLipProtChange(Sender: TObject);
3830
begin
3831
  if not Update
3832
  then
3833
  begin
3834
    Modified := True;
3835
    PProfilT.RatioLipProt := 1 - PBRatioLipProt.AsFloat;
3836
    ValidBBCalibre;
3837
  end;
3838
end;
3839
3840
procedure TFProfilT.ValidBBCalibre;
3841
var
3842
  cycle, jour: Integer;
3843
  GainProt: double;
3844
begin
3845
  SBCalibr.Enabled := ProfilTValid(PProfilT);
3846
  if SBCalibr.Enabled
3847
  then // Calcul de la simulation et affichage du graphique
3848
  begin
3849
    New(PResSimulT);
3850
    // calcul des CoefNR
3851
    for cycle := 1 to NB_CYCLES do
3852
      PProfilT.CoefNR[cycle] := 1;
3853
    CalcSimulT(-1, -1, 1, 1, 8, 0, PResSimulT);
3854
    GainProt := 0;
3855
    for jour := 1 to PResSimulT.NbJSim do
3856
      if PResSimulT.TabResult[3, jour] = 0
3857
      then // Gestation
3858
        GainProt := GainProt + PResSimulT.TabResult[63, jour]
3859
      else
3860
        if (PResSimulT.TabResult[3, jour] = 1) and (PResSimulT.TabResult[3, jour - 1] = 0)
3861
        then // Mise bas
3862
        begin
3863
          cycle := Round(PResSimulT.TabResult[2, jour]);
3864
          with PProfilT.Truies[cycle] do
3865
            PProfilT.CoefNR[cycle] := Max((0.178 * (PdsApMB - PdsSail) - 0.333 * (P2MB - P2Sail)) / (GainProt / 1000), 0);
3866
          GainProt := 0;
3867
        end;
3868
    CalcSimulT(-1, -1, 1, 1, 8, 0, PResSimulT);
3869
    AffGraphCal;
3870
    Dispose(PResSimulT);
3871
  end
3872
  else // Pas de graphique
3873
  begin
3874
    LignePds.Clear;
3875
    PointPds.Clear;
3876
    LigneP2.Clear;
3877
    PointP2.Clear;
3878
  end;
3879
end;
3880
3881
// GTTT
3882
3883
procedure TFProfilT.PBNbrTruiesChange(Sender: TObject);
3884
begin
3885
  if not Update
3886
  then
3887
  begin
3888
    Modified := TRUE ;
3889
    PProfilT.NbTruies := PBNbrTruies.AsInteger ;
3890
    ValidBBCalcul ;
3891
  end ;
3892
end;
3893
3894
procedure TFProfilT.PBAge1ereMBChange(Sender: TObject);
3895
begin
3896
  if not Update
3897
  then
3898
  begin
3899
    Modified := TRUE ;
3900
    PProfilT.AgeMB1 := PBAge1ereMB.AsInteger ;
3901
    ValidBBCalcul ;
3902
  end ;
3903
end;
3904
3905
procedure TFProfilT.PBISOChange(Sender: TObject);
3906
begin
3907
  if not Update
3908
  then
3909
  begin
3910
    Modified := TRUE ;
3911
    PProfilT.ISO := PBISO.AsFloat ;
3912
    ValidBBCalcul ;
3913
  end ;
3914
end;
3915
3916
procedure TFProfilT.PBPds1ereSaillieChange(Sender: TObject);
3917
begin
3918
  if not Update
3919
  then
3920
  begin
3921
    Modified := TRUE ;
3922
    PProfilT.PVSail1 := PBPds1ereSaillie.AsFloat ;
3923
    ValidBBCalcul ;
3924
  end ;
3925
end;
3926
3927
procedure TFProfilT.PBPdsAdulteChange(Sender: TObject);
3928
begin
3929
  if not Update
3930
  then
3931
  begin
3932
    Modified := TRUE ;
3933
    PProfilT.PVAdulte := PBPdsAdulte.AsFloat ;
3934
    ValidBBCalcul ;
3935
  end ;
3936
end;
3937
3938
procedure TFProfilT.PBPertePdsPrimChange(Sender: TObject);
3939
begin
3940
  if not Update
3941
  then
3942
  begin
3943
    Modified := TRUE ;
3944
    PProfilT.PertePVPrim := PBPertePdsPrim.AsFloat ;
3945
    ValidBBCalcul ;
3946
  end ;
3947
end;
3948
3949
procedure TFProfilT.PBPertePdsMultChange(Sender: TObject);
3950
begin
3951
  if not Update
3952
  then
3953
  begin
3954
    Modified := TRUE ;
3955
    PProfilT.PertePVMult := PBPertePdsMult.AsFloat ;
3956
    ValidBBCalcul ;
3957
  end ;
3958
end;
3959
3960
procedure TFProfilT.PBP21ereSaillieChange(Sender: TObject);
3961
begin
3962
  if not Update
3963
  then
3964
  begin
3965
    Modified := TRUE ;
3966
    PProfilT.P2Sail1 := PBP21ereSaillie.AsFloat ;
3967
    ValidBBCalcul ;
3968
  end ;
3969
end;
3970
3971
procedure TFProfilT.PBP2ObjectifChange(Sender: TObject);
3972
begin
3973
  if not Update
3974
  then
3975
  begin
3976
    Modified := TRUE ;
3977
    PProfilT.P2Objectif := PBP2Objectif.AsFloat ;
3978
    ValidBBCalcul ;
3979
  end ;
3980
end;
3981
3982
procedure TFProfilT.PBPerteP2PrimChange(Sender: TObject);
3983
begin
3984
  if not Update
3985
  then
3986
  begin
3987
    Modified := TRUE ;
3988
    PProfilT.PerteP2Prim := PBPerteP2Prim.AsFloat ;
3989
    ValidBBCalcul ;
3990
  end ;
3991
end;
3992
3993
procedure TFProfilT.PBPerteP2MultChange(Sender: TObject);
3994
begin
3995
  if not Update
3996
  then
3997
  begin
3998
    Modified := TRUE ;
3999
    PProfilT.PerteP2Mult := PBPerteP2Mult.AsFloat ;
4000
    ValidBBCalcul ;
4001
  end ;
4002
end;
4003
4004
procedure TFProfilT.PBNbrVifsChange(Sender: TObject);
4005
begin
4006
  if not Update
4007
  then
4008
  begin
4009
    Modified := TRUE ;
4010
    PProfilT.NbVifs := PBNbrVifs.AsFloat ;
4011
    ValidBBCalcul ;
4012
  end ;
4013
end;
4014
4015
procedure TFProfilT.PBNbrMortsChange(Sender: TObject);
4016
begin
4017
  if not Update
4018
  then
4019
  begin
4020
    Modified := TRUE ;
4021
    PProfilT.NbMorts := PBNbrMorts.AsFloat ;
4022
    ValidBBCalcul ;
4023
  end ;
4024
end;
4025
4026
procedure TFProfilT.PBNbrSevresChange(Sender: TObject);
4027
begin
4028
  if not Update
4029
  then
4030
  begin
4031
    Modified := TRUE ;
4032
    PProfilT.NbSevres := PBNbrSevres.AsFloat ;
4033
    ValidBBCalcul ;
4034
  end ;
4035
end;
4036
4037
procedure TFProfilT.PBAgeSevChange(Sender: TObject);
4038
begin
4039
  if not Update
4040
  then
4041
  begin
4042
    Modified := TRUE ;
4043
    PProfilT.AgeSevr := PBAgeSev.AsInteger ;
4044
  end ;
4045
end;
4046
4047
procedure TFProfilT.PBPdsNaisChange(Sender: TObject);
4048
begin
4049
  if not Update
4050
  then
4051
  begin
4052
    Modified := TRUE ;
4053
    PProfilT.PVNais := PBPdsNais.AsFloat ;
4054
    ValidBBCalcul ;
4055
  end ;
4056
end;
4057
4058
procedure TFProfilT.PBPdsSevChange(Sender: TObject);
4059
begin
4060
  if not Update
4061
  then
4062
  begin
4063
    Modified := TRUE ;
4064
    PProfilT.PVSevr := PBPdsSev.AsFloat ;
4065
    ValidBBCalcul ;
4066
  end ;
4067
end;
4068
4069
procedure TFProfilT.PBConsoLactChange(Sender: TObject);
4070
begin
4071
  if not Update
4072
  then
4073
  begin
4074
    Modified := TRUE ;
4075
    PProfilT.ConsoLact := PBConsoLact.AsFloat ;
4076
    CalcConsoAn ;
4077
    ValidBBCalcul ;
4078
  end ;
4079
end;
4080
4081
procedure TFProfilT.PBConsoGestChange(Sender: TObject);
4082
begin
4083
  if not Update
4084
  then
4085
  begin
4086
    Modified := TRUE ;
4087
    PProfilT.ConsoGest := PBConsoGest.AsFloat ;
4088
    CalcConsoAn ;
4089
    ValidBBCalcul ;
4090
  end ;
4091
end;
4092
4093
procedure TFProfilT.CalcConsoAn;
4094
begin
4095
  with PProfilT^ do
4096
    PBConsoAn.AsFloat := ((ConsoLact * AgeSevr)
4097
        + (ConsoGest * (DureeGest + ISO)))
4098
      * 365 / (AgeSevr + DureeGest + ISO) ;
4099
end;
4100
4101
procedure TFProfilT.ValidBBCalcul ;
4102
begin
4103
  BBCalcul.Enabled := (PBNbrTruies.AsInteger > 0)
4104
    and (PBAge1ereMB.AsInteger > 0)
4105
    and (PBISO.AsFloat > 0)
4106
    and (PBPds1ereSaillie.AsFloat > 0)
4107
    and (PBPdsAdulte.AsFloat > PBPds1ereSaillie.AsFloat)
4108
    and (PBPertePdsPrim.AsFloat > 0)
4109
    and (PBPertePdsMult.AsFloat > 0)
4110
    and (PBP21ereSaillie.AsFloat > 0)
4111
    and (PBP2Objectif.AsFloat > PBP21ereSaillie.AsFloat)
4112
    and (PBPerteP2Prim.AsFloat > 0)
4113
    and (PBPerteP2Mult.AsFloat > 0)
4114
    and (PBNbrVifs.AsFloat >= PBNbrSevres.AsFloat)
4115
    and (PBNbrSevres.AsFloat > 0)
4116
    and (PBPdsNais.AsFloat > 0)
4117
    and (PBPdsSev.AsFloat > PBPdsNais.AsFloat)
4118
    and (PBConsoLact.AsFloat > 0)
4119
    and (PBConsoGest.AsFloat > 0) ;
4120
end ;
4121
4122
procedure TFProfilT.BBCalculClick(Sender: TObject);
4123
const
4124
  RefNb : array[1..NB_CYCLES] of integer
4125
    = (215289, 190252, 168459, 143260, 119502, 91709, 63910, 74647) ;
4126
  RefNV : array[1..NB_CYCLES] of double
4127
    = (11.7, 12.0, 12.7, 12.8, 12.6, 12.4, 12.1, 11.5) ;
4128
  RefMN : array[1..NB_CYCLES] of double
4129
    = (0.7, 0.7, 0.9, 1.0, 1.2, 1.3, 1.3, 1.3) ;
4130
  RefSv : array[1..NB_CYCLES] of double
4131
    = (10.1, 10.5, 11.0, 11.0, 10.8, 10.6, 10.3, 9.9) ;
4132
  RefISO : array[1..NB_CYCLES] of double
4133
    = (7.33956043956044, 5.3, 4.99010989010989, 4.68021978021978, 4.18021978021978, 4.17032967032967, 4, 4) ;
4134
  RefGainNet : array[1..NB_CYCLES] of double
4135
    = (55.0, 45.0, 36.5, 28.0, 23.0, 18.0, 17.0, 15.0) ;
4136
  RefPerteLact : array[1..NB_CYCLES] of double
4137
    = (20.0, 17.5, 15.0, 15.0, 15.0, 15.0, 15.0, 15.0) ;
4138
var
4139
  i, RefNbTot : integer ;
4140
  RefNVMoy, RefMNMoy, RefSvMoy, RefISOMoy : double ;
4141
  MoyLact, MoyGest, Coeff : double ;
4142
  GainNet, PerteLact : array[1..NB_CYCLES] of double ;
4143
begin
4144
  if MessageDlg (MsgGTTT, mtConfirmation, [mbYes, mbNo], 0) = mrYes
4145
  then
4146
  begin
4147
    Modified := TRUE ;
4148
    // Totaux et moyennes des tableaux de r?f?rence
4149
    RefNbTot := SumInt (RefNb) ;
4150
    RefNVMoy := 0 ;
4151
    for i := 1 to NB_CYCLES do
4152
      RefNVMoy := RefNVMoy + RefNV[i] * RefNb[i] ;
4153
    RefNVMoy := RefNVMoy / RefNbTot ;
4154
    RefMNMoy := 0 ;
4155
    for i := 1 to NB_CYCLES do
4156
      RefMNMoy := RefMNMoy + RefMN[i] * RefNb[i] ;
4157
    RefMNMoy := RefMNMoy / RefNbTot ;
4158
    RefSvMoy := 0 ;
4159
    for i := 1 to NB_CYCLES do
4160
      RefSvMoy := RefSvMoy + RefSv[i] * RefNb[i] ;
4161
    RefSvMoy := RefSvMoy / RefNbTot ;
4162
    RefISOMoy := 0 ;
4163
    for i := 1 to NB_CYCLES do
4164
      RefISOMoy := RefISOMoy + RefISO[i] * RefNb[i] ;
4165
    RefISOMoy := RefISOMoy / RefNbTot ;
4166
    // R?gles de 3
4167
    with PProfilT^ do
4168
    begin
4169
      // Dur?e de lactation
4170
      DureeLact := AgeSevr ;
4171
      // Effectif truies
4172
      for i := 1 to NB_CYCLES do
4173
        Truies[i].Nombre := Round (NbTruies * (RefNb[i] / RefNbTot)) ;
4174
      // Porcelets n?s vifs
4175
      for i := 1 to NB_CYCLES do
4176
        Porcelets[i].NesVivants := RoundTo (NbVifs * (RefNV[i] / RefNVMoy), -1) ;
4177
      // Porcelets n?s totaux (morts n?s + n?s vifs)
4178
      for i := 1 to NB_CYCLES do
4179
        Porcelets[i].NesTotaux := RoundTo (NbMorts * (RefMN[i] / RefMNMoy) + Porcelets[i].NesVivants, -1) ;
4180
      // Porcelets sevr?s
4181
      for i := 1 to NB_CYCLES do
4182
        Porcelets[i].Sevres := RoundTo (NbSevres * (RefSv[i] / RefSvMoy), -1) ;
4183
      // Age saillie
4184
      Truies[1].AgeSail := AgeMB1 - DureeGest ;
4185
      for i := 2 to NB_CYCLES do
4186
//        Truies[i].AgeSail := Round (Truies[i-1].AgeSail + DureeGest + DureeLact + ISO * (RefISO[i-1] / RefISOMoy)) ;
4187
        TabISO[i] := Round (ISO * (RefISO[i-1] / RefISOMoy)) ;
4188
      CalcAgeSail ;
4189
      // Poids truies
4190
      PerteLact[1] := PertePVPrim ;
4191
      PerteLact[2] := RoundTo ((PertePVPrim + PertePVMult) / 2, -1) ;
4192
      for i := 3 to NB_CYCLES do
4193
        PerteLact[i] := PertePVMult ;
4194
      Coeff := (PVAdulte - PVSail1) / (270 - 145) ;
4195
      GainNet[1] := RoundTo (RefGainNet[1] * Coeff, -1) ;
4196
      for i := 2 to NB_CYCLES do
4197
        GainNet[i] := (RefGainNet[i] - RefPerteLact[i-1]) * Coeff + PerteLact[i-1] ;
4198
      Truies[1].PdsSail := PVSail1 ;
4199
      Truies[1].PdsApMB := PVSail1 + GainNet[1] ;
4200
      for i := 2 to NB_CYCLES do
4201
      begin
4202
        Truies[i].PdsSail := Truies[i-1].PdsApMB - PerteLact[i-1] ;
4203
        Truies[i].PdsApMB := Truies[i].PdsSail + GainNet[i] ;
4204
      end ;
4205
      for i := 1 to NB_CYCLES do
4206
        Truies[i].PdsAvMB := RoundTo (Truies[i].PdsApMB + (0.3 + 1.329 * Porcelets[i].NesTotaux * PVNais), -1) ;
4207
      // Epaisseur de lard saillie
4208
      Truies[1].P2Sail := P2Sail1 ;
4209
      Truies[2].P2Sail := P2Objectif - PerteP2Prim ;
4210
      Truies[3].P2Sail := P2Objectif - RoundTo ((PerteP2Prim + PerteP2Mult) / 2, -1) ;
4211
      for i := 4 to NB_CYCLES do
4212
        Truies[i].P2Sail := P2Objectif - PerteP2Mult ;
4213
      // Epaisseur de lard mise-bas
4214
      for i := 1 to NB_CYCLES do
4215
        Truies[i].P2MB := P2Objectif ;
4216
      // Poids porcelets
4217
      for i := 1 to NB_CYCLES do
4218
        Porcelets[i].PdsNais := PVNais ;
4219
      for i := 1 to NB_CYCLES do
4220
        Porcelets[i].PdsSev := PVSevr ;
4221
      // Ration lactation
4222
      Lact[1] := ConsoLact * 0.83 ;
4223
      Lact[2] := ConsoLact * 0.96 ;
4224
      for i := 3 to NB_CYCLES do
4225
        Lact[i] := ConsoLact * 1.05 ;
4226
      MoyLact := 0 ;
4227
      for i := 1 to NB_CYCLES do
4228
        MoyLact := MoyLact + Lact[i] * RefNb[i] ;
4229
      MoyLact := MoyLact / RefNbTot ;
4230
      for i := 1 to NB_CYCLES do
4231
        Lact[i] := RoundTo (Lact[i] * ConsoLact / MoyLact, -3) ;
4232
      // Ration gestation
4233
      for i := 1 to NB_CYCLES do
4234
        Gest[i] := (0.440 * Power ((Truies[i].PdsSail + Truies[i].PdsAvMB) / 2, 0.75) + ((13.65 * GainNet[i] + 45.9 * (Truies[i].P2MB - Truies[i].P2Sail)) / 0.77) / DureeGest + (Porcelets[i].NesTotaux * PVNais * 5.4 / 0.48) / DureeGest) / 12.5 ;
4235
      MoyGest := 0 ;
4236
      for i := 1 to NB_CYCLES do
4237
        MoyGest := MoyGest + Gest[i] * RefNb[i] ;
4238
      MoyGest := MoyGest / RefNbTot ;
4239
      for i := 1 to NB_CYCLES do
4240
        Gest[i] := RoundTo (Gest[i] * ConsoGest / MoyGest, -3) ;
4241
    end ;
4242
    // Affichage
4243
    CBProfilChange(nil);
4244
  end;
4245
end;
4246
4247
end.