InraPorc

unit UFBesLactT ;

interface

uses

  Windows, Forms, Classes, Controls, StdCtrls, Buttons, PBNumEdit, PBSuperSpin;

type

  TFBesLactT = class(TForm)

    GBProfil: TGroupBox;

    LPortee: TLabel;

    CBProfil: TComboBox;

    PBPortee: TPBSuperSpin;

    GBSevrage: TGroupBox;

    LSevres: TLabel;

    LPdsNais: TLabel;

    PBSevres: TPBNumEdit;

    PBPdsNais: TPBNumEdit;

    ChkSevres: TCheckBox;

    ChkPdsNais: TCheckBox;

    GBMiseBas: TGroupBox;

    GBAliment: TGroupBox;

    LRation: TLabel;

    LSeqAli: TLabel;

    LAppAli: TLabel;

    LEMAli: TLabel;

    CBRation: TComboBox;

    CBSeqAli: TComboBox;

    PBAppAli: TPBNumEdit;

    PBEMAli: TPBNumEdit;

    ChkSeqAli: TCheckBox;

    ChkRation: TCheckBox;

    ChkAppAli: TCheckBox;

    ChkEMAli: TCheckBox;

    GBResult: TGroupBox;

    LAliment: TLabel;

    LBesoins: TLabel;

    LdLys: TLabel;

    LEN: TLabel;

    LEM: TLabel;

    PBBesdLys: TPBNumEdit;

    PBBesEN: TPBNumEdit;

    PBBesEM: TPBNumEdit;

    PBBesAli: TPBNumEdit;

    BBRapLact: TBitBtn;

    BBResLact: TBitBtn;

    LP2MB: TLabel;

    LPdsApMB: TLabel;

    PBPdsApMB: TPBNumEdit;

    PBP2MB: TPBNumEdit;

    ChkPdsApMB: TCheckBox;

    ChkP2MB: TCheckBox;

    LDureeLact: TLabel;

    PBDureeLact: TPBSuperSpin;

    LPdsSev: TLabel;

    PBPdsSev: TPBNumEdit;

    ChkPdsSev: TCheckBox;

    LGMQ: TLabel;

    PBGMQ: TPBNumEdit;

    Label2: TLabel;

    PBDefEN: TPBNumEdit;

    PBDefEM: TPBNumEdit;

    PBDefAli: TPBNumEdit;

    CBRationProfil: TComboBox;

    ChkDureeLact: TCheckBox;

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure FormActivate(Sender: TObject);

    procedure CBProfilChange(Sender: TObject);

    procedure PBPorteeChange(Sender: TObject);

    procedure PBPdsApMBChange(Sender: TObject);

    procedure ChkPdsApMBClick(Sender: TObject);

    procedure PBP2MBChange(Sender: TObject);

    procedure ChkP2MBClick(Sender: TObject);

    procedure PBDureeLactChange(Sender: TObject);

    procedure PBSevresChange(Sender: TObject);

    procedure ChkSevresClick(Sender: TObject);

    procedure PBPdsNaisChange(Sender: TObject);

    procedure ChkPdsNaisClick(Sender: TObject);

    procedure PBPdsSevChange(Sender: TObject);

    procedure ChkPdsSevClick(Sender: TObject);

    procedure CBSeqAliChange(Sender: TObject);

    procedure ChkSeqAliClick(Sender: TObject);

    procedure CBRationChange(Sender: TObject);

    procedure ChkRationClick(Sender: TObject);

    procedure PBAppAliChange(Sender: TObject);

    procedure ChkAppAliClick(Sender: TObject);

    procedure PBEMAliChange(Sender: TObject);

    procedure ChkEMAliClick(Sender: TObject);

    procedure BBResLactClick(Sender: TObject);

    procedure BBRapLactClick(Sender: TObject);

    procedure FormShow(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure ChkDureeLactClick(Sender: TObject);

  private

    { D?clarations priv?es }

    Update, Modal: boolean;

    cycle: integer;

    PdsSev, GMQPort: double;

    procedure CalcApport;

    procedure CalcGMQ;

    procedure CalcResult;

    procedure AjustEnabled;

  public

    { D?clarations publiques }

    DureeLact: integer;

    AppAliTot, AppEDTot, AppEMTot, AppENTot: double;

    BesEMTot, BesEMEntTot, BesEMLaitTot: double;

    AppAli, AppED, AppEM, AppEN: array [1..28] of double;

    BesEMEnt, BesEMLait, BesP, BesCa: array [1..28] of double;

    AppAA, BesAA, BesAAEnt, BesAALait: array[1..14, 1..28] of double;

  end;

var

  FBesLactT: TFBesLactT;

implementation

uses

  Math, gnugettext, UVariables, UInit, UFindRec, UCalcul, UFResBesLactT,

  UFRapBesLactT;

{$R *.dfm}

{ TFBesLactT }

procedure TFBesLactT.FormCreate(Sender: TObject);

begin

  if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1

  then

    Font.Name := 'Arial Unicode MS';

  TranslateComponent(Self);

  Constraints.MinWidth := 624 + (Width - ClientWidth);

  Width := Constraints.MinWidth;

  Constraints.MaxWidth := Constraints.MinWidth;

  Constraints.MinHeight := 464 + (Height - ClientHeight);

  Height := Constraints.MinHeight;

  Constraints.MaxHeight := Constraints.MinHeight;

  CBRationProfil.ItemIndex := 0;

end;

procedure TFBesLactT.FormShow(Sender: TObject);

begin

  Modal := False;

  Update := True;

  PBPortee.AsInteger := 1;

  PBDureeLact.AsInteger := 28;

  Update := False;

end;

procedure TFBesLactT.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  Action := caFree;

  NumWinBesLactT := -1;

end;

procedure TFBesLactT.FormActivate(Sender: TObject);

begin

  if not Modal

  then

  begin

    StringsProfilT(CBProfil.Items, False);

    StringsSeqAliT(CBSeqAli.Items, False);

    StringsRationT(CBRation.Items, False);

    CBProfilChange(nil);

  end;

end;

procedure TFBesLactT.CBProfilChange(Sender: TObject);

begin

  if CBProfil.ItemIndex = -1

  then

  begin

    CBProfil.Hint := '' ;

    Update := TRUE ;

    ChkPdsApMB.Checked := FALSE ;

    ChkP2MB.Checked := FALSE ;

    ChkSevres.Checked := FALSE ;

    ChkPdsNais.Checked := FALSE ;

    ChkPdsSev.Checked := FALSE ;

    ChkSeqAli.Checked := FALSE ;

    ChkRation.Checked := FALSE ;

    ChkAppAli.Checked := FALSE ;

    ChkEMAli.Checked := FALSE ; 

    CalcApport ; // L'apport est recalcul? avec des teneurs standards

    CalcResult ;

    Update := FALSE ;

  end

  else

  begin

    PProfilT := ListProfilT[FindIdxProfilT (CBProfil.Text)] ;

    CBProfil.Hint := PProfilT.Memo ;

    // Remplissage des champs avec les valeurs du profil

    Update := TRUE ;

    if ChkDureeLact.Checked

    then

      ChkDureeLactClick (nil)

    else

      ChkDureeLact.Checked := TRUE ;

    if ChkPdsApMB.Checked

    then

      ChkPdsApMBClick (nil)

    else

      ChkPdsApMB.Checked := TRUE ;

    if ChkP2MB.Checked

    then

      ChkP2MBClick (nil)

    else

      ChkP2MB.Checked := TRUE ;

    if ChkSevres.Checked

    then

      ChkSevresClick (nil)

    else

      ChkSevres.Checked := TRUE ;

    if ChkPdsNais.Checked

    then

      ChkPdsNaisClick (nil)

    else

      ChkPdsNais.Checked := TRUE ;

    if ChkPdsSev.Checked

    then

      ChkPdsSevClick (nil)

    else

      ChkPdsSev.Checked := TRUE ;

    if ChkSeqAli.Checked

    then

      ChkSeqAliClick (nil)

    else

      ChkSeqAli.Checked := TRUE ;

    if ChkRation.Checked

    then

      ChkRationClick (nil)

    else

      ChkRation.Checked := TRUE ;

    ChkAppAli.Checked := TRUE ;

    ChkEMAli.Checked := TRUE ;

    CalcApport ;

    ChkAppAliClick (nil) ;

    ChkEMAliClick (nil) ;

    CalcGMQ ;

    CalcResult ;

    Update := FALSE ;

  end ;

  AjustEnabled ;

end;

procedure TFBesLactT.PBPorteeChange(Sender: TObject);

begin

  cycle := PBPortee.AsInteger ;

  if CBProfil.ItemIndex <> -1

  then

  begin

    // Remplissage des champs avec les valeurs du profil

    Update := TRUE ;

    if ChkPdsApMB.Checked

    then

      ChkPdsApMBClick (nil)

    else

      ChkPdsApMB.Checked := TRUE ;

    if ChkP2MB.Checked

    then

      ChkP2MBClick (nil)

    else

      ChkP2MB.Checked := TRUE ;

    if ChkSevres.Checked

    then

      ChkSevresClick (nil)

    else

      ChkSevres.Checked := TRUE ;

    if ChkPdsNais.Checked

    then

      ChkPdsNaisClick (nil)

    else

      ChkPdsNais.Checked := TRUE ;

    if ChkPdsSev.Checked

    then

      ChkPdsSevClick (nil)

    else

      ChkPdsSev.Checked := TRUE ;

    if ChkRation.Checked

    then

      ChkRationClick (nil)

    else

      ChkRation.Checked := TRUE ;

    ChkAppAli.Checked := TRUE ;

    ChkEMAli.Checked := TRUE ;

    CalcApport ;

    ChkAppAliClick (nil) ;

    ChkEMAliClick (nil) ;

    CalcGMQ ;

    CalcResult ;

    Update := FALSE ;

  end ;

end;

procedure TFBesLactT.PBPdsApMBChange(Sender: TObject);

begin

  if not Update

  then

  begin

    Update := TRUE ;

    CalcResult ;

    Update := FALSE ;

  end ;

end;

procedure TFBesLactT.ChkPdsApMBClick(Sender: TObject);

begin

  PBPdsApMB.Enabled := not ChkPdsApMB.Checked ;

  if ChkPdsApMB.Checked

  then

    if not Update

    then

    begin

      Update := TRUE ;

      PBPdsApMB.AsFloat := PProfilT.Truies[cycle].PdsApMB ;

      CalcResult ;

      Update := FALSE ;

    end

    else

      PBPdsApMB.AsFloat := PProfilT.Truies[cycle].PdsApMB ;

end;

procedure TFBesLactT.PBP2MBChange(Sender: TObject);

begin

  if not Update

  then

  begin

    Update := TRUE ;

    CalcResult ;

    Update := FALSE ;

  end ;

end;

procedure TFBesLactT.ChkP2MBClick(Sender: TObject);

begin

  PBP2MB.Enabled := not ChkP2MB.Checked ;

  if ChkP2MB.Checked

  then

    if not Update

    then

    begin

      Update := TRUE ;

      PBP2MB.AsFloat := PProfilT.Truies[cycle].P2MB ;

      CalcResult ;

      Update := FALSE ;

    end

    else

      PBP2MB.AsFloat := PProfilT.Truies[cycle].P2MB ;

end;

procedure TFBesLactT.PBDureeLactChange(Sender: TObject);

begin

  DureeLact := PBDureeLact.AsInteger ;

  if not Update

  then

  begin

    Update := TRUE ;

    ChkPdsSevClick (nil) ;

    CalcApport ;

    ChkAppAliClick (nil) ;

    ChkEMAliClick (nil) ;

    CalcGMQ ;

    CalcResult ;

    Update := FALSE ;

  end ;

end;

procedure TFBesLactT.ChkDureeLactClick(Sender: TObject);

begin

  PBDureeLact.Enabled := not ChkDureeLact.Checked ;

  if ChkDureeLact.Checked

  then

    if not Update

    then

    begin

      Update := TRUE ;

      PBDureeLact.AsInteger := PProfilT.DureeLact ;

      ChkPdsSevClick (nil) ;

      CalcApport ;

      ChkAppAliClick (nil) ;

      ChkEMAliClick (nil) ;

      CalcGMQ ;

      CalcResult ;

      Update := FALSE ;

    end

    else

      PBDureeLact.AsInteger := PProfilT.DureeLact ;

end;

procedure TFBesLactT.PBSevresChange(Sender: TObject);

begin

  if not Update

  then

  begin

    Update := TRUE ;

    CalcGMQ ;

    CalcResult ;

    Update := FALSE ;

  end ;

end;

procedure TFBesLactT.ChkSevresClick(Sender: TObject);

begin

  PBSevres.Enabled := not ChkSevres.Checked ;

  if ChkSevres.Checked

  then

    if not Update

    then

    begin

      Update := TRUE ;

      PBSevres.AsFloat := PProfilT.Porcelets[cycle].Sevres ;

      CalcGMQ ;

      CalcResult ;

      Update := FALSE ;

    end

    else

      PBSevres.AsFloat := PProfilT.Porcelets[cycle].Sevres ;

end;

procedure TFBesLactT.PBPdsNaisChange(Sender: TObject);

begin

  if not Update

  then

  begin

    Update := TRUE ;

    CalcGMQ ;

    CalcResult ;

    Update := FALSE ;

  end ;

end;

procedure TFBesLactT.ChkPdsNaisClick(Sender: TObject);

begin

  PBPdsNais.Enabled := not ChkPdsNais.Checked ;

  if ChkPdsNais.Checked

  then

    if not Update

    then

    begin

      Update := TRUE ;

      PBPdsNais.AsFloat := PProfilT.Porcelets[cycle].PdsNais ;

      CalcGMQ ;

      CalcResult ;

      Update := FALSE ;

    end

    else

      PBPdsNais.AsFloat := PProfilT.Porcelets[cycle].PdsNais ;

end;

procedure TFBesLactT.PBPdsSevChange(Sender: TObject);

begin

  if not Update

  then

  begin

    Update := TRUE ;

    CalcGMQ ;

    CalcResult ;

    Update := FALSE ;

  end ;

end;

procedure TFBesLactT.ChkPdsSevClick(Sender: TObject);

var

  GainProfil, GainSimul : double ;

begin

  PBPdsSev.Enabled := not ChkPdsSev.Checked ;

  if ChkPdsSev.Checked

  then

    if not Update

    then

    begin

      Update := TRUE ;

      // Ajustement du poids de sevrage ? la dur?e de lactation

      GainProfil := (273 * PProfilT.DureeLact + (289 / 0.38) * Exp (-0.38 * PProfilT.DureeLact) - 289 / 0.38) / 1000 ;

      GainSimul := (273 * DureeLact + (289 / 0.38) * Exp (-0.38 * DureeLact) - 289 / 0.38) / 1000 ;

      PdsSev := PProfilT.Porcelets[cycle].PdsNais + GainSimul * (PProfilT.Porcelets[cycle].PdsSev - PProfilT.Porcelets[cycle].PdsNais) / GainProfil ;

      PBPdsSev.AsFloat := PdsSev ;

      CalcGMQ ;

      CalcResult ;

      Update := FALSE ;

    end

    else

    begin

      // Ajustement du poids de sevrage ? la dur?e de lactation

      GainProfil := (273 * PProfilT.DureeLact + (289 / 0.38) * Exp (-0.38 * PProfilT.DureeLact) - 289 / 0.38) / 1000 ;

      GainSimul := (273 * DureeLact + (289 / 0.38) * Exp (-0.38 * DureeLact) - 289 / 0.38) / 1000 ;

      PdsSev := PProfilT.Porcelets[cycle].PdsNais + GainSimul * (PProfilT.Porcelets[cycle].PdsSev - PProfilT.Porcelets[cycle].PdsNais) / GainProfil ;

      PBPdsSev.AsFloat := PdsSev ;

    end ;

end;

procedure TFBesLactT.CBSeqAliChange(Sender: TObject);

begin

  if CBSeqAli.ItemIndex = -1

  then

    CBSeqAli.Hint := ''

  else

  begin

    PSeqAliT := ListSeqAliT[FindIdxSeqAliT (CBSeqAli.Text)] ;

    CBSeqAli.Hint := PSeqAliT.Memo ;

    if not Update

    then

    begin

      Update := TRUE ;

      ChkEMAli.Checked := TRUE ;

      CalcApport ;

      ChkAppAliClick (nil) ;

      ChkEMAliClick (nil) ;

      CalcResult ;

      Update := FALSE ;

    end ;

  end ;

  AjustEnabled ;

end;

procedure TFBesLactT.ChkSeqAliClick(Sender: TObject);

begin

  CBSeqAli.Enabled := not ChkSeqAli.Checked ;

  if ChkSeqAli.Checked

  then

    if not Update

    then

    begin

      Update := TRUE ;

      CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (FindNomSeqAliT (PProfilT.SeqAli)) ;

      CBSeqAliChange (nil) ;

      ChkEMAli.Checked := TRUE ;

      CalcApport ;

      ChkAppAliClick (nil) ;

      ChkEMAliClick (nil) ;

      CalcResult ;

      Update := FALSE ;

    end

    else

    begin

      CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (FindNomSeqAliT (PProfilT.SeqAli)) ;

      CBSeqAliChange (nil) ;

    end ;

end;

procedure TFBesLactT.CBRationChange(Sender: TObject);

begin

  if CBRation.ItemIndex = -1

  then

    CBRation.Hint := ''

  else

  begin

    PRationT := ListRationT[FindIdxRationT (CBRation.Text)] ;

    CBRation.Hint := PRationT.Memo ;

    if not Update

    then

    begin

      Update := TRUE ;

      ChkAppAli.Checked := TRUE ;

      CalcApport ;

      ChkAppAliClick (nil) ;

      if ChkEMAli.Checked

      then

        ChkEMAliClick (nil) ;

      CalcResult ;

      Update := FALSE ;

    end ;

  end ;

  AjustEnabled ;

end;

procedure TFBesLactT.ChkRationClick(Sender: TObject);

begin

  CBRation.Visible := not ChkRation.Checked ;

  CBRationProfil.Visible := ChkRation.Checked ;

  if ChkRation.Checked

  then

    if not Update

    then

    begin

      Update := TRUE ;

      CBRation.ItemIndex := -1 ;

      CBRationChange (nil) ;

      ChkAppAli.Checked := TRUE ;

      CalcApport ;

      ChkAppAliClick (nil) ;

      if ChkEMAli.Checked

      then

        ChkEMAliClick (nil) ;

      CalcResult ;

      Update := FALSE ;

    end

    else

    begin

      CBRation.ItemIndex := -1 ;

      CBRationChange (nil) ;

    end ;

end;

procedure TFBesLactT.PBAppAliChange(Sender: TObject);

begin

  if not Update

  then

  begin

    Update := TRUE ;

    CalcApport ;

    if ChkEMAli.Checked

    then

      ChkEMAliClick (nil) ;

    CalcResult ;

    Update := FALSE ;

  end ;

end;

procedure TFBesLactT.ChkAppAliClick(Sender: TObject);

begin

  PBAppAli.Enabled := not ChkAppAli.Checked ;

  if ChkAppAli.Checked

  then

    if not Update

    then

    begin

      Update := TRUE ;

      CalcApport ;

      PBAppAli.AsFloat := AppAliTot / DureeLact ;

      if ChkEMAli.Checked

      then

        ChkEMAliClick (nil) ;

      CalcResult ;

      Update := FALSE ;

    end

    else

      PBAppAli.AsFloat := AppAliTot / DureeLact ;

end;

procedure TFBesLactT.PBEMAliChange(Sender: TObject);

begin

  if not Update

  then

  begin

    Update := TRUE ;

    CalcApport ;

    CalcResult ;

    Update := FALSE ;

  end ;

end;

procedure TFBesLactT.ChkEMAliClick(Sender: TObject);

begin

  PBEMAli.Enabled := not ChkEMAli.Checked ;

  if ChkEMAli.Checked

  then

    if not Update

    then

    begin

      Update := TRUE ;

      CalcApport ;

      if AppAliTot = 0

      then

        PBEMAli.Text := ''

      else

        PBEMAli.AsFloat := AppEMTot / AppAliTot ;

      CalcResult ;

      Update := FALSE ;

    end

    else

      if AppAliTot = 0

      then

        PBEMAli.Text := ''

      else

        PBEMAli.AsFloat := AppEMTot / AppAliTot

  else

    if not Update

    then

    begin

      Update := TRUE ;

      CalcApport ; // L'apport est recalcul? avec des teneurs standards

      CalcResult ;

      Update := FALSE ;

    end ;

end;

procedure TFBesLactT.CalcApport ;

var

  i, Jour, AA, Unite : integer ;

  PctAli1, PctAli2, Quantite, Ingere, IngSec1, IngSec2 : double ;

  NumRuleSeqAli, NumRuleRation : integer ;

  RuleSeqAli : array[1..MAX_RULE] of RecRuleSeqAliT ;

  RuleRation : array[1..MAX_RULE] of RecRuleRationT ;

  RuleSeqAliInit, RuleRationInit, Ecart : integer ;

  RecCC1, RecCC2 : CompositionChimique ;

  TabAAtotal1, TabAAtotal2, TabCUDAA1, TabCUDAA2 : array[0..12] of double ;

  ok : boolean ;

begin

  // Initialisation

  AppAliTot := 0 ;

  AppEDTot := 0 ;

  AppEMTot := 0 ;

  AppENTot := 0 ;

  for Jour := 1 to DureeLact do

  begin

    AppAli[Jour] := 0 ;

    AppED[Jour] := 0 ;

    AppEM[Jour] := 0 ;

    AppEN[Jour] := 0 ;

    for AA := 1 to 14 do

      AppAA[AA, Jour] := 0 ;

  end ;

  if ChkEMAli.Checked

  then // S?quence alimentaire

    if CBSeqAli.ItemIndex = -1

    then

      Exit

    else // Chargement des r?gles

      for i := 1 to PSeqAliT.NbRuleLact do

        RuleSeqAli[i] := PSeqAliT.RuleLact[i]

  else // Teneur en EM

    if PBEMAli.AsFloat = 0

    then

      Exit

    else

      if CBSeqAli.ItemIndex = -1

      then // Cr?ation d'une r?gle sans aliment

        with RuleSeqAli[1] do

        begin

          ModeFin := -1 ;

          NumAli1 := -1 ;

          NumAli2 := -1 ;

          PctAli1Init := 100 ;

          PctAli1Fin := 100 ;

        end

      else // Chargement des r?gles

        for i := 1 to PSeqAliT.NbRuleGest do

          RuleSeqAli[i] := PSeqAliT.RuleGest[i] ;

  NumRuleSeqAli := 1 ;

  RuleSeqAliInit := 1 ;

  if ChkAppAli.Checked

  then

    if ChkRation.Checked

    then // Profil animal

      if CBProfil.ItemIndex = -1

      then

        Exit

      else // Cr?ation d'une r?gle ? partir du profil animal

      begin

        with RuleRation[1] do

        begin

          ModeFin := -1 ;

          Equation := 3 ; // Curvilin?aire

          a := PProfilT.Lact[Cycle] / 2 ; // Initial

          c := PProfilT.Lact[Cycle] ; // Moyenne

          d := DureeLact ; // Dur?e

        end ;

        Unite := PProfilT.Unite ;

      end

    else // Plan de rationnement

      if CBRation.ItemIndex = -1

      then

        Exit

      else // Chargement des r?gles

      begin

        for i := 1 to PRationT.NbRuleLact do

          RuleRation[i] := PRationT.RuleLact[i] ;

        Unite := PRationT.UniteLact ;

      end

  else // Consommation moyenne

    if PBAppAli.AsFloat = 0

    then

      Exit

    else // Cr?ation d'une r?gle ? partir de la consommation moyenne

    begin

      with RuleRation[1] do

      begin

        ModeFin := -1 ;

        Equation := 3 ; // Curvilin?aire

        a := PBAppAli.AsFloat / 2 ; // Initial

        c := PBAppAli.AsFloat ; // Moyenne

        d := DureeLact ; // Dur?e

      end ;

      Unite := 0 ; // Quantit?

    end ;

  NumRuleRation := 1 ;

  RuleRationInit := 1 ;

  // Boucle des jours

  for Jour := 1 to DureeLact do

  begin

    // Aliment(s) distribu?(s)

    repeat

      ok := TRUE ;

      with RuleSeqAli[NumRuleSeqAli] do

        if ModeFin = 0

        then // Dur?e

          if (Jour - RuleSeqAliInit + 1 > ValFin) then ok := FALSE ;

      if not (ok)

      then // Changement de r?gle

      begin

        Inc (NumRuleSeqAli) ;

        RuleSeqAliInit := Jour ;

      end ;

    until ok ;

    with RuleSeqAli[NumRuleSeqAli] do

    begin

      // Composition aliment 1

      if NumAli1 = -1

      then

      begin

        RecCC1 := CCVide ;

        for i := 0 to 12 do

          TabAAtotal1[i] := 0 ;

        for i := 0 to 12 do

          TabCUDAA1[i] := 0 ;

      end

      else

      begin

        PAliment := ListAliment[FindIdxAliment (FindNomAliment (NumAli1))] ;

        RecCC1 := PAliment.CC ;

        for i := 0 to 12 do

          TabAAtotal1[i] := PAliment.AAtotal[i] ;

        for i := 0 to 12 do

          TabCUDAA1[i] := PAliment.CUDAA[i] ;

      end ;

      if not ChkEMAli.Checked

      then // Teneur en EM

        with RecCC1 do

        begin

          ED_T := (PBEMAli.AsFloat / 0.96) / MS * 1000 ;

          EM_T := (PBEMAli.AsFloat) / MS * 1000 ;

          EN_T := (PBEMAli.AsFloat * 0.74) / MS * 1000 ;

        end ;

      // Composition aliment 2

      if NumAli2 = -1

      then

      begin

        RecCC2 := CCVide ;

        for i := 0 to 12 do

          TabAAtotal2[i] := 0 ;

        for i := 0 to 12 do

          TabCUDAA2[i] := 0 ;

      end

      else

      begin

        PAliment := ListAliment[FindIdxAliment (FindNomAliment (NumAli2))] ;

        RecCC2 := PAliment.CC ;

        for i := 0 to 12 do

          TabAAtotal2[i] := PAliment.AAtotal[i] ;

        for i := 0 to 12 do

          TabCUDAA2[i] := PAliment.CUDAA[i] ;

      end ;

      if not ChkEMAli.Checked

      then // Teneur en EM

        with RecCC2 do

        begin

          ED_T := (PBEMAli.AsFloat / 0.96) / MS * 1000 ;

          EM_T := (PBEMAli.AsFloat) / MS * 1000 ;

          EN_T := (PBEMAli.AsFloat * 0.74) / MS * 1000 ;

        end ;

      // Calcul des % aliments

      if PctAli1Init = PctAli1Fin

      then

        PctAli1 := PctAli1Init

      else // Transition

      begin

        Ecart := PctAli1Fin - PctAli1Init ;

        if ModeFin = 0

        then // Dur?e

          PctAli1 := PctAli1Init + (Jour - RuleSeqAliInit) * Ecart / ValFin

        else // Fin

          PctAli1 := PctAli1Init + (Jour - RuleSeqAliInit) * Ecart / (DureeLact - RuleSeqAliInit) ;

      end ;

    end ;

    PctAli2 := 100 - PctAli1 ;

    // Quantit?(s) distribu?e(s)

    repeat

      ok := TRUE ;

      with RuleRation[NumRuleRation] do

        if ModeFin = 0

        then // Dur?e

          if Jour - RuleRationInit + 1 > ValFin then ok := FALSE ;

      if not (ok)

      then // Changement de r?gle

      begin

        Inc (NumRuleRation) ;

        RuleRationInit := Jour ;

      end ;

    until ok ;

    with RuleRation[NumRuleRation] do

    begin

      // Calcul des quantit?s

      case Equation of

        0 : // Constant

          Quantite := a ;

        1 : // Lin?aire

          Quantite := a + b * (Jour - RuleRationInit) ;

        2 : // Lin?aire-plateau

          Quantite := LPvaleur (a, b, c, Jour - RuleRationInit + 1, d) ;

        3 : // Curvilin?aire

          Quantite := CLvaleur (a, c, Jour - RuleRationInit + 1, d) ;

        else

          Quantite := 0 ;

      end ;

      // Convertion de ED, EM, EN en quantit? si besoin

      case Unite of

        1 : // ED (MJ/j)

          Ingere := Quantite

            / (PctAli1 / 100 * RecCC1.ED_T * RecCC1.MS / 1000

              + PctAli2 / 100 * RecCC2.ED_T * RecCC2.MS / 1000) ;

        2 : // EM (MJ/j)

          Ingere := Quantite

            / (PctAli1 / 100 * RecCC1.EM_T * RecCC1.MS / 1000

              + PctAli2 / 100 * RecCC2.EM_T * RecCC2.MS / 1000) ;

        3 : // EN (MJ/j)

          Ingere := Quantite

            / (PctAli1 / 100 * RecCC1.EN_T * RecCC1.MS / 1000

              + PctAli2 / 100 * RecCC2.EN_T * RecCC2.MS / 1000) ;

        4 : // MS (kg/j)

          Ingere := Quantite

            / (PctAli1 / 100 * RecCC1.MS / 1000

              + PctAli2 / 100 * RecCC2.MS / 1000) ;

        else // QI (kg/j)

          Ingere := Quantite ;

      end ;

    end ;

    // Aliment ing?r?

    AppAli[Jour] := Ingere ;

    IngSec1 := Ingere * PctAli1 / 100 * RecCC1.MS / 1000 ;

    IngSec2 := Ingere * PctAli2 / 100 * RecCC2.MS / 1000 ;

    // Energie ing?r?e

    AppED[Jour] := IngSec1 * RecCC1.ED_T + IngSec2 * RecCC2.ED_T ;

    AppEM[Jour] := IngSec1 * RecCC1.EM_T + IngSec2 * RecCC2.EM_T ;

    AppEN[Jour] := IngSec1 * RecCC1.EN_T + IngSec2 * RecCC2.EN_T ;

    // Acides amin?s digestibles

    for AA := 1 to 12 do

      AppAA[AA, Jour] := IngSec1 * TabAAtotal1[AA] * TabCUDAA1[AA] / 100

        + IngSec2 * TabAAtotal2[AA] * TabCUDAA2[AA] / 100 ;

    // met+cys

    AppAA[13, Jour] := AppAA[2, Jour] + AppAA[3, Jour] ;

    // phe+tyr

    AppAA[14, Jour] := AppAA[6, Jour] + AppAA[7, Jour] ;

  end ;

  // Totaux

  AppAliTot := Sum (Slice (AppAli, DureeLact)) ;

  AppEDTot := Sum (Slice (AppED, DureeLact)) ;

  AppEMTot := Sum (Slice (AppEM, DureeLact)) ;

  AppENTot := Sum (Slice (AppEN, DureeLact)) ;

end;

procedure TFBesLactT.CalcGMQ ;

begin

  GMQPort := (PBPdsSev.AsFloat - PBPdsNais.AsFloat) * PBSevres.AsFloat / DureeLact ;

  PBGMQ.AsFloat := GMQPort ;

end ;

procedure TFBesLactT.CalcResult ;

var

  Jour, AA : integer ;

  RA, NRLait : double ;

begin

  if (PBPdsApMB.AsFloat > 0)

    and (PBP2MB.AsFloat > 0)

    and (PBSevres.AsFloat > 0)

    and (PBPdsNais.AsFloat > 0)

    and (PBPdsSev.AsFloat > PBPdsNais.AsFloat)

    and (PBAppAli.AsFloat > 0)

    and (PBEMAli.AsFloat > 0)

  then

  begin

    //

    // Besoins ?n?rg?tiques

    //

    // Energie pour l'entretien

    BesEMEntTot := Power (PProfilT.Truies[Cycle].PdsApMB, 0.75) * EELact ;

    for Jour := 1 to DureeLact do

      BesEMEnt[Jour] := BesEMEntTot ;

    // Energie pour la production de lait

    RA := 0.0000023096 * Power (DureeLact, 4) - 0.00027619 * Power (DureeLact, 3) + 0.012889 * Power (DureeLact, 2) - 0.28116 * DureeLact + 4.799 ;

    for Jour := 1 to DureeLact do

      BesEMLait[Jour] := (20.6 * GMQPort * 1000 - 376 * PProfilT.Porcelets[cycle].Sevres) * RA * Exp (-0.025 * Jour) * Exp (-Exp (0.5 - 0.1 * Jour)) / 1000 / KL ;

    BesEMLaitTot := Mean (Slice (BesEMLait, DureeLact)) ;

    // Besoin total en ?nergie

    BesEMTot := BesEMEntTot + BesEMLaitTot ;

    //

    // Besoins en acides amin?s

    //

    for Jour := 1 to DureeLact do

    begin

      // Production d'azote dans le lait

      NRLait := (0.0257 * GMQPort * 1000 + 0.42 * PProfilT.Porcelets[cycle].Sevres) * RA * Exp (-0.025 * Jour) * Exp (- Exp (0.5 - 0.1 * Jour)) ;

      // 1) Besoin total

      BesAA[1, Jour] := (14.2 + 0.629 * NRLait) / 1.335 ;

      for AA := 2 to 12 do

        BesAA[AA, Jour] := BesAA[1, Jour] * ProtIdLact[AA] / 100 ;

      // met+cys

      BesAA[13, Jour] := BesAA[1, Jour] * (ProtIdLact[2] + ProtIdLact[3]) / 100 ;

      // phe+tyr

      BesAA[14, Jour] := BesAA[1, Jour] * (ProtIdLact[6] + ProtIdLact[7]) / 100 ;

      // 2) Besoin d'entretien

      BesAAEnt[1, Jour] := Power (PProfilT.Truies[Cycle].PdsApMB, 0.75) * 0.036 ;

      for AA := 2 to 12 do

        BesAAEnt[AA, Jour] := BesAAEnt[1, Jour] * ProtIdEnt[AA] / 100 ;

      // met+cys

      BesAAEnt[13, Jour] := BesAAEnt[1, Jour] * (ProtIdEnt[2] + ProtIdEnt[3]) / 100 ;

      // phe+tyr

      BesAAEnt[14, Jour] := BesAAEnt[1, Jour] * (ProtIdEnt[6] + ProtIdEnt[7]) / 100 ;

      // 3) Besoin pour la port?e

      for AA := 1 to 14 do

        BesAALait[AA, Jour] := BesAA[AA, Jour] - BesAAEnt[AA, Jour] ;

    end ;

    //

    // Besoins en min?raux

    //

    for Jour := 1 to DureeLact do

    begin

      // Production d'azote dans le lait

      NRLait := (0.0257 * GMQPort * 1000 + 0.42 * PProfilT.Porcelets[cycle].Sevres) * RA * Exp (-0.025 * Jour) * Exp (- Exp (0.5 - 0.1 * Jour)) ;

      // Phosphore digestible

      BesP[Jour] := 10 * PProfilT.Truies[Cycle].PdsApMB / 1000

        + NRLait * 6.38 / 0.050 / 1000 * 1.55 ;

      // Calcium total

      BesCa[Jour] := BesP[Jour] * 3.2 ;

    end ;

    //

    // Affichage des r?sultats

    //

    if (AppEMTot = 0)

    then

      PBBesAli.AsFloat := 0

    else

      PBBesAli.AsFloat := BesEMTot * AppAliTot / AppEMTot ;

    PBBesEM.AsFloat := BesEMTot ;

    if (AppEMTot = 0)

    then

      PBBesEN.AsFloat := 0

    else

      PBBesEN.AsFloat := BesEMTot * AppENTot / AppEMTot ;

    if (PBAppAli.AsFloat = 0)

    then

      PBBesdLys.AsFloat := 0

    else

      PBBesdLys.AsFloat := Mean (Slice (BesAA[1], DureeLact)) ;

    if (BesEMTot > AppEMTot / DureeLact)

    then // D?ficit

    begin

      PBDefAli.AsFloat := PBBesAli.AsFloat - PBAppAli.AsFloat ;

      PBDefEM.AsFloat := PBBesEM.AsFloat - AppEMTot / DureeLact ;

      PBDefEN.AsFloat := PBBesEN.AsFloat - AppENTot / DureeLact ;

    end

    else // Exc?s

    begin

      PBDefAli.AsFloat := 0 ;

      PBDefEM.AsFloat := 0 ;

      PBDefEN.AsFloat := 0 ;

    end ;

    BBResLact.Enabled := TRUE ;

    BBRapLact.Enabled := TRUE ;

  end

  else

  begin

    PBBesAli.Text := '' ;

    PBBesEM.Text := '' ;

    PBBesEN.Text := '' ;

    PBBesdLys.Text := '' ;

    PBDefAli.Text := '' ;

    PBDefEM.Text := '' ;

    PBDefEN.Text := '' ;

    BBResLact.Enabled := FALSE ;

    BBRapLact.Enabled := FALSE ;

  end ;

end;

procedure TFBesLactT.BBResLactClick(Sender: TObject);

begin

  Modal := True;

  FResBesLactT := TFResBesLactT.Create (Self) ;

  FResBesLactT.ShowModal ;

  FResBesLactT.Release ;

  Modal := False;

end;

procedure TFBesLactT.BBRapLactClick(Sender: TObject);

begin

  Modal := True;

  FRapBesLactT := TFRapBesLactT.Create(Self);

  FRapBesLactT.QRRapport.PreviewModal ;

  FRapBesLactT.Release;

  Modal := False;

end;

procedure TFBesLactT.AjustEnabled;

begin

  ChkPdsApMB.Visible := CBProfil.ItemIndex <> -1 ;

  ChkP2MB.Visible := CBProfil.ItemIndex <> -1 ;

  ChkSevres.Visible := CBProfil.ItemIndex <> -1 ;

  ChkPdsNais.Visible := CBProfil.ItemIndex <> -1 ;

  ChkPdsSev.Visible := CBProfil.ItemIndex <> -1 ;

  ChkSeqAli.Visible := CBProfil.ItemIndex <> -1 ;

  ChkRation.Visible := CBProfil.ItemIndex <> -1 ;

  ChkAppAli.Visible := (CBProfil.ItemIndex <> -1) or (CBRation.ItemIndex <> -1) ;

  ChkEMAli.Visible := (CBProfil.ItemIndex <> -1) or (CBSeqAli.ItemIndex <> -1) ;

end;

end.