InraPorc

unit UFBesLactE ;

interface

uses

  Windows, Forms, Classes, Controls, StdCtrls, Buttons, UVariables;

type

  TFBesLactE = class(TForm)

    GBProfil: TGroupBox;

    CBProfil: TComboBox;

    GBResult: TGroupBox;

    BBRapLact: TBitBtn;

    BBResLact: TBitBtn;

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

    procedure FormActivate(Sender: TObject);

    procedure CBProfilChange(Sender: TObject);

    procedure BBResLactClick(Sender: TObject);

    procedure BBRapLactClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormShow(Sender: TObject);

  private

    { D?clarations priv?es }

    Update, Modal: boolean;

    procedure CalcApport;

    procedure CalcResult;

  public

    { D?clarations publiques }

    AppAliTot, AppEDTot, AppEMTot, AppENTot: array[1..NB_CYCLES] of double;

    BesEMTot, BesEMEntTot, BesEMLaitTot: array[1..NB_CYCLES] of double;

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

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

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

  end;

var

  FBesLactE: TFBesLactE;

implementation

uses

  Math, gnugettext, UInit, UFindRec, UCalcul, UFResBesLactE, UFRapBesLactE;

{$R *.dfm}

{ TFBesLactE }

procedure TFBesLactE.FormCreate(Sender: TObject);

begin

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

  then

    Font.Name := 'Arial Unicode MS';

  TranslateComponent(Self);

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

  Width := Constraints.MinWidth;

  Constraints.MaxWidth := Constraints.MinWidth;

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

  Height := Constraints.MinHeight;

  Constraints.MaxHeight := Constraints.MinHeight;

end;

procedure TFBesLactE.FormShow(Sender: TObject);

begin

  Modal := False;

end;

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

begin

  Action := caFree;

  NumWinBesLactE := -1;

end;

procedure TFBesLactE.FormActivate(Sender: TObject);

begin

  if not Modal

  then

    StringsProfilT(CBProfil.Items, False);

end;

procedure TFBesLactE.CBProfilChange(Sender: TObject);

begin

  if CBProfil.ItemIndex = -1

  then

    CBProfil.Hint := ''

  else

  begin

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

    CBProfil.Hint := PProfilT.Memo ;

    Update := TRUE ;

    CalcApport ;

    CalcResult ;

    Update := FALSE ;

    BBResLact.Enabled := TRUE ;

    BBRapLact.Enabled := TRUE ;

  end ;

end;

procedure TFBesLactE.CalcApport ;

var

  i, Cycle, 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

  for Cycle := 1 to NB_CYCLES do

  begin

    PSeqAliT := ListSeqAliT[FindIdxSeqAliT (FindNomSeqAliT (PProfilT.SeqAli))] ;

    for i := 1 to PSeqAliT.NbRuleLact do

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

    NumRuleSeqAli := 1 ;

    RuleSeqAliInit := 1 ;

    with RuleRation[1] do

    begin

      ModeFin := -1 ;

      Equation := 3 ; // Curvilin?aire

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

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

      d := PProfilT.DureeLact ; // Dur?e

    end ;

    Unite := PProfilT.Unite ;

    NumRuleRation := 1 ;

    RuleRationInit := 1 ;

    // Boucle des jours

    for Jour := 1 to PProfilT.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 ;

        // 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 ;

        // 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 / (PProfilT.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[Cycle, Jour] := Ingere ;

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

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

      // Energie ing?r?e

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

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

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

      // Acides amin?s digestibles

      for AA := 1 to 12 do

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

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

      // met+cys

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

      // phe+tyr

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

    end ;

    // Totaux

    AppAliTot[Cycle] := Sum (Slice (AppAli[Cycle], PProfilT.DureeLact)) ;

    AppEDTot[Cycle] := Sum (Slice (AppED[Cycle], PProfilT.DureeLact)) ;

    AppEMTot[Cycle] := Sum (Slice (AppEM[Cycle], PProfilT.DureeLact)) ;

    AppENTot[Cycle] := Sum (Slice (AppEN[Cycle], PProfilT.DureeLact)) ;

  end ;

end;

procedure TFBesLactE.CalcResult ;

var

  Cycle, Jour, AA : integer ;

  GMQPort, RA, NRLait : double ;

begin

  for Cycle := 1 to NB_CYCLES do

  begin

    // GMQ port?e

    GMQPort := (PProfilT.Porcelets[Cycle].PdsSev - PProfilT.Porcelets[Cycle].PdsNais) * PProfilT.Porcelets[Cycle].Sevres / PProfilT.DureeLact ;

    //

    // Besoins ?n?rg?tiques

    //

    // Energie pour l'entretien

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

    for Jour := 1 to PProfilT.DureeLact do

      BesEMEnt[Cycle, Jour] := BesEMEntTot[Cycle] ;

    // Energie pour la production de lait

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

    for Jour := 1 to PProfilT.DureeLact do

      BesEMLait[Cycle, 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[Cycle] := Mean (Slice (BesEMLait[Cycle], PProfilT.DureeLact)) ;

    // Besoin total en ?nergie

    BesEMTot[Cycle] := BesEMEntTot[Cycle] + BesEMLaitTot[Cycle] ;

    //

    // Besoins en acides amin?s

    //

    for Jour := 1 to PProfilT.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[Cycle, 1, Jour] := (14.2 + 0.629 * NRLait) / 1.335 ;

      for AA := 2 to 12 do

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

      // met+cys

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

      // phe+tyr

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

      // 2) Besoin d'entretien

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

      for AA := 2 to 12 do

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

      // met+cys

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

      // phe+tyr

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

      // 3) Besoin pour la port?e

      for AA := 1 to 14 do

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

    end ;

    //

    // Besoins en min?raux

    //

    for Jour := 1 to PProfilT.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[Cycle, Jour] := 10 * PProfilT.Truies[Cycle].PdsApMB / 1000

        + NRLait * 6.38 / 0.050 / 1000 * 1.55 ;

      // Calcium total

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

    end ;

  end ;

end;

procedure TFBesLactE.BBResLactClick(Sender: TObject);

begin

  Modal := True;

  FResBesLactE := TFResBesLactE.Create (Self) ;

  FResBesLactE.ShowModal ;

  FResBesLactE.Release ;

  Modal := False;

end;

procedure TFBesLactE.BBRapLactClick(Sender: TObject);

begin

  Modal := True;

  FRapBesLactE := TFRapBesLactE.Create(Self);

  FRapBesLactE.QRRapport.PreviewModal ;

  FRapBesLactE.Release;

  Modal := False;

end;

end.