InraPorc

unit UFRationT ;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls, Math, PBNumEdit, PBSuperSpin, 

  TeEngine, Series, TeeProcs, Chart, JvExControls, JvComponent, JvEnterTab, 

  UVariables, gnugettext;

type

  TFRationT = class(TForm)

    GBRation: TGroupBox;

    SBAddRation: TSpeedButton;

    SBDelRation: TSpeedButton;

    CBRation: TComboBox;

    GBRule: TGroupBox;

    LModeFin: TLabel;

    LNo: TLabel;

    SBAddRule: TSpeedButton;

    SBDelRule: TSpeedButton;

    LAli: TLabel;

    LBRule: TListBox;

    GBEnd: TGroupBox;

    LUnitFin: TLabel;

    PBValFin: TPBNumEdit;

    GBAjust: TGroupBox;

    LUnite: TLabel;

    CBUnite: TComboBox;

    PBa: TPBNumEdit;

    PBb: TPBNumEdit;

    La: TLabel;

    Graph: TChart;

    SeriesLigne: TLineSeries;

    SBRename: TSpeedButton;

    SBComment: TSpeedButton;

    CBModeFin: TComboBox;

    LType: TLabel;

    CBType: TComboBox;

    TC: TTabControl;

    LMoyenne: TLabel;

    PBMoyenne: TPBNumEdit;

    Pa: TPanel;

    Pc: TPanel;

    Lc: TLabel;

    PBc: TPBNumEdit;

    Pb: TPanel;

    Lb: TLabel;

    Pd: TPanel;

    Ld: TLabel;

    PQuantite: TPanel;

    LQuantite: TLabel;

    PBQuantite: TPBNumEdit;

    PBd: TPBSuperSpin;

    SBSave: TSpeedButton;

    SBPrint: TSpeedButton;

    GBParam: TGroupBox;

    PRation: TPanel;

    JvEnterAsTab: TJvEnterAsTab;

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

    procedure FormShow(Sender: TObject);

    procedure CBRationChange(Sender: TObject);

    procedure SBAddRationClick(Sender: TObject);

    procedure SBDelRationClick(Sender: TObject);

    procedure LBRuleClick(Sender: TObject);

    procedure LBRuleDrawItem(Control: TWinControl; Index: Integer;

      Rect: TRect; State: TOwnerDrawState);

    procedure SBAddRuleClick(Sender: TObject);

    procedure SBDelRuleClick(Sender: TObject);

    procedure PBValFinChange(Sender: TObject);

    procedure CBUniteChange(Sender: TObject);

    procedure PBaChange(Sender: TObject);

    procedure PBbChange(Sender: TObject);

    procedure FormDeactivate(Sender: TObject);

    procedure SBRenameClick(Sender: TObject);

    procedure SBCommentClick(Sender: TObject);

    procedure CBTypeChange(Sender: TObject);

    procedure FormActivate(Sender: TObject);

    procedure TCChange(Sender: TObject);

    procedure PBcChange(Sender: TObject);

    procedure PBdChange(Sender: TObject);

    procedure PBQuantiteChange(Sender: TObject);

    procedure SBSaveClick(Sender: TObject);

    procedure SBPrintClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

  private

    { D?clarations priv?es }

    Update, Modified : boolean ;

    IdxRationT, NbRule, NumRule : integer ;

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

    procedure Save ;

    procedure AffGraph ;

  public

    { D?clarations publiques }

    function StrModeFin (etat, regle : integer) : string ;

    function StrEquation (etat, regle : integer) : string ;

  end;

var

  FRationT: TFRationT;

implementation

uses

  UStrings, UInit, UUtil, UFindRec, UEchelle, UCalcul, UFComment, UFRapRationT ;

{$R *.dfm}

{ TFRationT }

procedure TFRationT.FormCreate(Sender: TObject);

begin

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

  then

    Font.Name := 'Arial Unicode MS';

  TranslateComponent(Self);

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

  Width := Constraints.MinWidth;

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

  Height := Constraints.MinHeight;

  CBUnite.ItemIndex := 0;

  CBModeFin.ItemIndex := 0;

  CBType.ItemIndex := 0;

end;

procedure TFRationT.FormShow (Sender : TObject) ;

begin

  Modified := FALSE ;

  StringsRationT (CBRation.Items, TRUE) ;

  SBAddRation.Enabled := IsComplete or (ListRationT.Count < 5) ;

  SBSave.Enabled := IsComplete or IsEducation ;

  IdxRationT := -1 ;

//  CBRationChange (nil) ;

end ;

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

begin

  if Modified then Save ;

  Action := caFree ;

  NumWinRationT := -1 ;

end ;

procedure TFRationT.FormActivate (Sender : TObject) ;

begin

//  if IdxRationT <> -1

//  then

//    PRationT := ListRationT[IdxRationT] ;

  CBRationChange (nil) ;

  GBParam.Enabled := IsComplete or IsEducation or IsEvaluation ;

  SBAddRule.Visible := GBParam.Enabled ;

  SBDelRule.Visible := GBParam.Enabled ;

end ;

procedure TFRationT.FormDeactivate (Sender : TObject) ;

begin

  if Modified then Save ;

end ;

procedure TFRationT.Save ;

var

  s : string ;

begin

  Modified := FALSE ;

  if IsComplete or IsEducation

  then

    if MessageDlg (Caption + sLineBreak + MsgSave, mtConfirmation, [mbYes, mbNo], 0) = mrYes

    then

    begin

      SaveRationT ;

      if not RationTValid (PRationT)

      then

        MessageDlg(Format (MsgInvalidData, [Caption, PRationT.Nom]), mtWarning, [mbOK], 0) ;

    end

    else

    begin

      LoadRationT ;

      s := CBRation.Text ;

      StringsRationT (CBRation.Items, TRUE) ;

      if FindIdxRationT (s) = -1

      then

      begin

        IdxRationT := -1 ;

        CBRationChange (nil) ;

      end

      else

        CBRation.ItemIndex := CBRation.Items.IndexOf (s) ;

    end ;

end ;

procedure TFRationT.CBRationChange (Sender : TObject) ;

begin

  if (IdxRationT <> -1) and (CBRation.Text <> PRationT.Nom)

  then

    if Modified then Save ;

  IdxRationT := FindIdxRationT (CBRation.Text) ;

  if IdxRationT = -1

  then

  begin

    CBRation.Repaint ;

    SBDelRation.Enabled := FALSE ;

    SBRename.Enabled := FALSE ;

    SBComment.Enabled := FALSE ;

    SBSave.Enabled := FALSE ;

    SBPrint.Enabled := FALSE ;

    TC.Visible := FALSE ;

  end

  else // Affichage de l'enregistrement

  begin

    SBDelRation.Enabled := TRUE ;

    SBRename.Enabled := TRUE ;

    SBComment.Enabled := TRUE ;

    SBSave.Enabled := TRUE ;

    SBPrint.Enabled := TRUE ;

    TC.Visible := TRUE ;

    PRationT := ListRationT[IdxRationT] ;

    with PRationT^ do

      CBRation.Hint := Memo ;

    TCChange (nil) ;

  end ;

end ;

procedure TFRationT.SBAddRationClick (Sender : TObject) ;

var

  i, n, q : integer ;

  s : string ;

  ok : boolean ;

  PBackup : PRecRationT ;

begin

  if Modified then Save ;

  if IdxRationT = -1

  then

    q := mrNo

  else

    q := MessageDlg (MsgCopy, mtConfirmation, [mbYes, mbNo], 0) ;

  // saisie du nouveau nom

  s := '' ;

  repeat

    if InputQuery (FRationT.Caption, MsgName, s)

    then // V?rification du nom

    begin

      s := Trim (s) ; // Suppression des espaces au d?but et ? la fin

      if s = ''

      then // Pas de nom

      begin

        ok := FALSE ;

        MessageDlg (MsgNameEmpty, mtWarning, [mbOk], 0) ;

      end

      else

        if Length (s) > 25

        then // Nom trop long

        begin

          ok := FALSE ;

          MessageDlg (Format (MsgNameTooLarge, [25]), mtWarning, [mbOk], 0) ;

          s := Copy (s, 1, 25) ;

        end

        else

        begin

          ok := TRUE ;

          i := 0 ;

          while ok and (i < ListRationT.Count) do

          begin

            PRationT := ListRationT[i] ;

            if PRationT.Nom = s

            then // Nom d?j? utilis?

            begin

              ok := FALSE ;

              MessageDlg (MsgNameExists, mtWarning, [mbOk], 0) ;

            end

            else

              Inc (i) ;

          end ;

        end ;

    end

    else // Annulation

    begin

      s := '' ;

      if (IdxRationT <> -1)

      then

        PRationT := ListRationT[IdxRationT] ;

      ok := TRUE ;

    end ;

  until ok ;

  if s <> ''

  then // Cr?ation du nouvel enregistrement

  begin

    // recherche du premier num?ro libre

    n := 0 ;

    repeat

      Inc (n) ;

      ok := TRUE ;

      i := 0 ;

      while ok and (i < ListRationT.Count) do

      begin

        PRationT := ListRationT[i] ;

        if PRationT.Num = n

        then

          ok := FALSE

        else

          Inc (i) ;

      end ;

    until ok ;

    New (PRationT) ;

    with PRationT^ do

    begin

      Nom := s ;

      Num := n ;

      if q = mrYes

      then

      begin

        PBackup := ListRationT[IdxRationT] ;

        Memo := PBackup.Memo ;

        NbRuleGest := PBackup.NbRuleGest ;

        RuleGest := PBackup.RuleGest ;

        UniteGest := PBackup.UniteGest ;

        NbRuleLact := PBackup.NbRuleLact ;

        RuleLact := PBackup.RuleLact ;

        UniteLact := PBackup.UniteLact ;

        NbRuleISSF := PBackup.NbRuleISSF ;

        RuleISSF := PBackup.RuleISSF ;

        UniteISSF := PBackup.UniteISSF ;

      end

      else

      begin

        Memo := '' ;

        NbRuleGest := 1 ;

        for i := 1 to MAX_RULE do

          with RuleGest[i] do

          begin

            ModeFin := -1 ;

            ValFin := 0 ;

            Equation := 0 ;

            a := 0 ;

            b := 0 ;

            c := 0 ;

            d := 0 ;

          end ;

        UniteGest := 0 ;

        NbRuleLact := 1 ;

        for i := 1 to MAX_RULE do

          with RuleLact[i] do

          begin

            ModeFin := -1 ;

            ValFin := 0 ;

            Equation := 0 ;

            a := 0 ;

            b := 0 ;

            c := 0 ;

            d := 28 ;

          end ;

        UniteLact := 0 ;

        NbRuleISSF := 1 ;

        for i := 1 to MAX_RULE do

          with RuleISSF[i] do

          begin

            ModeFin := -1 ;

            ValFin := 0 ;

            Equation := 0 ;

            a := 0 ;

            b := 0 ;

            c := 0 ;

            d := 0 ;

          end ;

        UniteISSF := 0 ;

      end ;

    end ;

    ListRationT.Add (PRationT) ;

    CBRation.Items.Add (PRationT.Nom) ;

    CBRation.ItemIndex := CBRation.Items.IndexOf (PRationT.Nom) ;

    CBRationChange (nil) ;

    Modified := TRUE ;

    SBAddRation.Enabled := IsComplete or (ListRationT.Count < 5) ;

    SBCommentClick (nil) ;

  end ;

end;

procedure TFRationT.SBDelRationClick (Sender : TObject) ;

var

  i, j : integer ;

begin

  if RationTUsed (PRationT.Num)

  then // Enregistrement utilis?

    MessageDlg (MsgDelErr, mtWarning, [mbOk], 0)

  else // Suppression de l'enregistrement

    if MessageDlg (MsgDel, mtConfirmation, [mbYes, mbNo], 0) = mrYes

    then

    begin

      // Mise ? jour du 30/11/2006

      // Suppression des r?f?rences masqu?es dans des simulations

      if ListSimulT.Count > 0

      then

        for i := 0 to ListSimulT.Count - 1 do

        begin

          PSimulT := ListSimulT[i] ;

          for j := 1 to NB_CYCLES do

            if PSimulT.Ration[j] = PRationT.Num

            then

              PSimulT.Ration[j] := -1 ;

        end ;

      SaveSimulT ; // Sauvegarde !

      // Fin de mise ? jour

      Dispose (PRationT) ;

      ListRationT.Delete (IdxRationT) ;

      SaveRationT ; // Sauvegarde !

      Modified := FALSE ;

      CBRation.DeleteSelected ;

      IdxRationT := -1 ;

      CBRation.ItemIndex := -1 ;

      CBRationChange (nil) ;

      SBAddRation.Enabled := IsComplete or (ListRationT.Count < 5) ;

    end ;

end ;

procedure TFRationT.SBRenameClick (Sender : TObject) ;

var

  i : integer ;

  s : string ;

  ok : boolean ;

begin

  // Saisie du nouveau nom

  s := CBRation.Text ;

  repeat

    if InputQuery (FRationT.Caption, MsgRename, s) and (s <> CBRation.Text)

    then // V?rification du nom

    begin

      s := Trim (s) ; // Suppression des espaces au d?but et ? la fin

      if s = ''

      then // Pas de nom

      begin

        ok := FALSE ;

        MessageDlg (MsgNameEmpty, mtWarning, [mbOk], 0) ;

      end

      else

        if Length (s) > 25

        then // Nom trop long

        begin

          ok := FALSE ;

          MessageDlg (Format (MsgNameTooLarge, [25]), mtWarning, [mbOk], 0) ;

          s := Copy (s, 1, 25) ;

        end

        else

        begin

          ok := TRUE ;

          i := 0 ;

          while ok and (i < ListRationT.Count) do

          begin

            PRationT := ListRationT[i] ;

            if PRationT.Nom = s

            then // Nom d?j? utilis?

            begin

              ok := FALSE ;

              MessageDlg (MsgNameExists, mtWarning, [mbOk], 0) ;

            end

            else

              Inc (i) ;

          end ;

        end ;

    end

    else // Annulation

    begin

      s := '' ;

      ok := TRUE ;

    end ;

  until ok ;

  PRationT := ListRationT[IdxRationT] ;

  if s <> ''

  then // Renommer l'enregistrement

  begin

    PRationT.Nom := s ;

    Modified := TRUE ;

    StringsRationT (CBRation.Items, TRUE) ;

    CBRation.ItemIndex := CBRation.Items.IndexOf (s) ;

  end ;

end ;

procedure TFRationT.SBCommentClick (Sender : TObject) ;

begin

  // Saisie du commentaire

  FComment := TFComment.Create (Self) ;

  with FComment do

  begin

    Memo.Text := PRationT.Memo ;

    if ShowModal = mrOk

    then // Commenter l'enregistrement

    begin

      PRationT.Memo := Memo.Text ;

      Modified := TRUE ;

      CBRation.Hint := PRationT.Memo ;

    end ;

    Release ;

  end ;

end ;

procedure TFRationT.SBSaveClick(Sender: TObject);

begin

  SaveRationT ;

  if not RationTValid (PRationT)

  then

    MessageDlg(Format (MsgInvalidData, [Caption, PRationT.Nom]), mtWarning, [mbOK], 0) ;

  Modified := FALSE ;

end;

procedure TFRationT.SBPrintClick(Sender: TObject);

begin

  FRapRationT := TFRapRationT.Create (Self) ;

  FRapRationT.QRRapport.PreviewModal ;

  FRapRationT.Release ;

end;

procedure TFRationT.TCChange (Sender : TObject) ;

var

  i : integer ;

begin

  case TC.TabIndex of

    0 : // Gestation

      with PRationT^ do

      begin

        NbRule := NbRuleGest ;

        for i := 1 to MAX_RULE do

          Rule[i] := RuleGest[i] ;

        CBUnite.ItemIndex := UniteGest ;

      end ;

    1 : // Lactation

      with PRationT^ do

      begin

        NbRule := NbRuleLact ;

        for i := 1 to MAX_RULE do

          Rule[i] := RuleLact[i] ;

        CBUnite.ItemIndex := UniteLact ;

      end ;

    2 : // I.S.S.F.

      with PRationT^ do

      begin

        NbRule := NbRuleISSF ;

        for i := 1 to MAX_RULE do

          Rule[i] := RuleISSF[i] ;

        CBUnite.ItemIndex := UniteISSF ;

      end ;

  end ;

  LBRule.Clear ;

  with PRationT^ do

    for i := 1 to NbRule do

      LBRule.Items.Add ('') ;

  LBRule.ItemIndex := 0 ;

  LBRuleClick (nil) ;

  if TC.TabIndex = 1

  then // Lactation

    CBType.Enabled := TRUE

  else

    CBType.Enabled := FALSE ;

  AffGraph ;

end ;

procedure TFRationT.LBRuleClick (Sender : TObject) ;

begin

  NumRule := LBRule.ItemIndex + 1 ;

  if LBRule.Items.Count < MAX_RULE

  then

    SBAddRule.Enabled := TRUE

  else

    SBAddRule.Enabled := FALSE ;

  if NumRule = NbRule

  then // Fin

    SBDelRule.Enabled := FALSE

  else

    SBDelRule.Enabled := TRUE ;

  GBEnd.Visible := SBDelRule.Enabled ;

  with Rule[NumRule] do

  begin

    Update := TRUE ;

    PBValFin.AsInteger := ValFin ;

    CBType.ItemIndex := Equation ;

    CBTypeChange (nil) ;

    PBQuantite.AsFloat := a ;

    PBa.AsFloat := a ;

    PBb.AsFloat := b ;

    PBc.AsFloat := c ;

    PBd.AsInteger := d ;

    Update := FALSE ;

  end ;

end ;

procedure TFRationT.LBRuleDrawItem(Control: TWinControl; Index: Integer;

  Rect: TRect; State: TOwnerDrawState);

begin

  with (Control as TListBox).Canvas do

  begin

    // Cadre principal

    FillRect(Rect);

    // Texte

    SetTextAlign(Handle, TA_LEFT);

    Rect.Left := 22;

    TextRect(Rect, Rect.Left, Rect.Top, StrModeFin(TC.TabIndex, Index + 1));

    Rect.Left := 150;

    TextRect(Rect, Rect.Left, Rect.Top, StrEquation(TC.TabIndex, Index + 1));

    Rect.Left := 0;

    // Num?ro

    SetTextAlign(Handle, TA_RIGHT);

    Rect.Right := 14;

    TextRect(Rect, Rect.Right, Rect.Top, Format('%d', [Index + 1]));

  end;

end;

procedure TFRationT.SBAddRuleClick (Sender : TObject) ;

var

  i : integer ;

begin

  for i := NbRule downto NumRule do

    Rule[i + 1] := Rule[i] ;

  with Rule[NumRule] do

  begin

    ModeFin := 0 ;

    ValFin := 0 ;

  end ;

  Inc (NbRule) ;

  case TC.TabIndex of

    0 : // Gestation

      with PRationT^ do

      begin

        NbRuleGest := NbRule ;

        for i := 1 to MAX_RULE do

          RuleGest[i] := Rule[i] ;

      end ;

    1 : // Lactation

      with PRationT^ do

      begin

        NbRuleLact := NbRule ;

        for i := 1 to MAX_RULE do

          RuleLact[i] := Rule[i] ;

      end ;

    2 : // I.S.S.F.

      with PRationT^ do

      begin

        NbRuleISSF := NbRule ;

        for i := 1 to MAX_RULE do

          RuleISSF[i] := Rule[i] ;

      end ;

  end ;

  LBRule.Items.Add ('') ;

  LBRule.ItemIndex := NumRule - 1 ;

  LBRuleClick (nil) ;

  Modified := TRUE ;

  ActiveControl := PBValFin ;

end ;

procedure TFRationT.SBDelRuleClick (Sender : TObject) ;

var

  i : integer ;

begin

  NbRule := NbRule - 1 ;

  for i := NumRule to NbRule do

    Rule[i] := Rule[i + 1] ;

  case TC.TabIndex of

    0 : // Gestation

      with PRationT^ do

      begin

        NbRuleGest := NbRule ;

        for i := 1 to MAX_RULE do

          RuleGest[i] := Rule[i] ;

      end ;

    1 : // Lactation

      with PRationT^ do

      begin

        NbRuleLact := NbRule ;

        for i := 1 to MAX_RULE do

          RuleLact[i] := Rule[i] ;

      end ;

    2 : // I.S.S.F.

      with PRationT^ do

      begin

        NbRuleISSF := NbRule ;

        for i := 1 to MAX_RULE do

          RuleISSF[i] := Rule[i] ;

      end ;

  end ;

  i := NumRule ; // Position courante

  LBRule.DeleteSelected ;

  LBRule.ItemIndex := i - 1 ;

  LBRuleClick (nil) ;

  ActiveControl := LBRule ;

  Modified := TRUE ;

  AffGraph ;

end ;

procedure TFRationT.CBUniteChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    case TC.TabIndex of

      0 : // Gestation

        with PRationT^ do

          UniteGest := CBUnite.ItemIndex ;

      1 : // Lactation

        with PRationT^ do

          UniteLact := CBUnite.ItemIndex ;

      2 : // I.S.S.F.

        with PRationT^ do

          UniteISSF := CBUnite.ItemIndex ;

    end ;

    LBRule.Repaint ;

    AffGraph ;

  end ;

end ;

procedure TFRationT.PBValFinChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    Rule[NumRule].ValFin := PBValFin.AsInteger ;

    case TC.TabIndex of

      0 : // Gestation

        with PRationT^ do

        begin

          NbRuleGest := NbRule ;

          RuleGest[NumRule] := Rule[NumRule] ;

        end ;

      1 : // Lactation

        with PRationT^ do

        begin

          NbRuleLact := NbRule ;

          RuleLact[NumRule] := Rule[NumRule] ;

        end ;

      2 : // I.S.S.F.

        with PRationT^ do

        begin

          NbRuleISSF := NbRule ;

          RuleISSF[NumRule] := Rule[NumRule] ;

        end ;

    end ;

    LBRule.Repaint ;

    AffGraph ;

  end ;

end ;

procedure TFRationT.CBTypeChange (Sender : TObject) ;

begin

  case CBType.ItemIndex of

    0 : // Constant

    begin

      PQuantite.Visible := TRUE ;

      Pa.Visible := FALSE ;

      Pb.Visible := FALSE ;

      Pc.Visible := FALSE ;

      Pd.Visible := FALSE ;

    end ;

    1 : // Lin?aire

    begin

      PQuantite.Visible := FALSE ;

      Pa.Visible := TRUE ;

      Pb.Visible := TRUE ;

      Pc.Visible := FALSE ;

      Pd.Visible := FALSE ;

    end ;

    2 : // Lin?aire-plateau

    begin

      PQuantite.Visible := FALSE ;

      Pa.Visible := TRUE ;

      Pb.Visible := TRUE ;

      Pc.Visible := TRUE ;

      Pd.Visible := TRUE ;

    end ;

    3 : // Curvilin?aire

    begin

      PQuantite.Visible := FALSE ;

      Pa.Visible := TRUE ;

      Pb.Visible := FALSE ;

      Pc.Visible := TRUE ;

      Pd.Visible := TRUE ;

    end ;

  end ;

  if not Update

  then

  begin

    Modified := TRUE ;

    with Rule[NumRule] do

      Equation := CBType.ItemIndex ;

    case TC.TabIndex of

      0 : // Gestation

        with PRationT^ do

        begin

          NbRuleGest := NbRule ;

          RuleGest[NumRule] := Rule[NumRule] ;

        end ;

      1 : // Lactation

        with PRationT^ do

        begin

          NbRuleLact := NbRule ;

          RuleLact[NumRule] := Rule[NumRule] ;

        end ;

      2 : // I.S.S.F.

        with PRationT^ do

        begin

          NbRuleISSF := NbRule ;

          RuleISSF[NumRule] := Rule[NumRule] ;

        end ;

    end ;

    LBRule.Repaint ;

    AffGraph ;

  end ;

end ;

procedure TFRationT.PBQuantiteChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    Rule[NumRule].a := PBQuantite.AsFloat ;

    PBa.AsFloat := Rule[NumRule].a ;

    case TC.TabIndex of

      0 : // Gestation

        with PRationT^ do

        begin

          NbRuleGest := NbRule ;

          RuleGest[NumRule] := Rule[NumRule] ;

        end ;

      1 : // Lactation

        with PRationT^ do

        begin

          NbRuleLact := NbRule ;

          RuleLact[NumRule] := Rule[NumRule] ;

        end ;

      2 : // I.S.S.F.

        with PRationT^ do

        begin

          NbRuleISSF := NbRule ;

          RuleISSF[NumRule] := Rule[NumRule] ;

        end ;

    end ;

    LBRule.Repaint ;

    AffGraph ;

  end ;

end ;

procedure TFRationT.PBaChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    Rule[NumRule].a := PBa.AsFloat ;

    PBQuantite.AsFloat := Rule[NumRule].a ;

    case TC.TabIndex of

      0 : // Gestation

        with PRationT^ do

        begin

          NbRuleGest := NbRule ;

          RuleGest[NumRule] := Rule[NumRule] ;

        end ;

      1 : // Lactation

        with PRationT^ do

        begin

          NbRuleLact := NbRule ;

          RuleLact[NumRule] := Rule[NumRule] ;

        end ;

      2 : // I.S.S.F.

        with PRationT^ do

        begin

          NbRuleISSF := NbRule ;

          RuleISSF[NumRule] := Rule[NumRule] ;

        end ;

    end ;

    LBRule.Repaint ;

    AffGraph ;

  end ;

end ;

procedure TFRationT.PBbChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    Rule[NumRule].b := PBb.AsFloat ;

    case TC.TabIndex of

      0 : // Gestation

        with PRationT^ do

        begin

          NbRuleGest := NbRule ;

          RuleGest[NumRule] := Rule[NumRule] ;

        end ;

      1 : // Lactation

        with PRationT^ do

        begin

          NbRuleLact := NbRule ;

          RuleLact[NumRule] := Rule[NumRule] ;

        end ;

      2 : // I.S.S.F.

        with PRationT^ do

        begin

          NbRuleISSF := NbRule ;

          RuleISSF[NumRule] := Rule[NumRule] ;

        end ;

    end ;

    LBRule.Repaint ;

    AffGraph ;

  end ;

end ;

procedure TFRationT.PBcChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    Rule[NumRule].c := PBc.AsFloat ;

    case TC.TabIndex of

      0 : // Gestation

        with PRationT^ do

        begin

          NbRuleGest := NbRule ;

          RuleGest[NumRule] := Rule[NumRule] ;

        end ;

      1 : // Lactation

        with PRationT^ do

        begin

          NbRuleLact := NbRule ;

          RuleLact[NumRule] := Rule[NumRule] ;

        end ;

      2 : // I.S.S.F.

        with PRationT^ do

        begin

          NbRuleISSF := NbRule ;

          RuleISSF[NumRule] := Rule[NumRule] ;

        end ;

    end ;

    LBRule.Repaint ;

    AffGraph ;

  end ;

end ;

procedure TFRationT.PBdChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    Rule[NumRule].d := PBd.AsInteger ;

    case TC.TabIndex of

      0 : // Gestation

        with PRationT^ do

        begin

          NbRuleGest := NbRule ;

          RuleGest[NumRule] := Rule[NumRule] ;

        end ;

      1 : // Lactation

        with PRationT^ do

        begin

          NbRuleLact := NbRule ;

          RuleLact[NumRule] := Rule[NumRule] ;

        end ;

      2 : // I.S.S.F.

        with PRationT^ do

        begin

          NbRuleISSF := NbRule ;

          RuleISSF[NumRule] := Rule[NumRule] ;

        end ;

    end ;

    LBRule.Repaint ;

    AffGraph ;

  end ;

end ;

function TFRationT.StrModeFin (etat, regle : integer) : string ;

var

  Nb : integer ;

  Rec : RecRuleRationT ;

begin

  case etat of

    0 : // Gestation

      Nb := PRationT.NbRuleGest ;

    1 : // Lactation

      Nb := PRationT.NbRuleLact ;

    else // I.S.S.F.

      Nb := PRationT.NbRuleISSF ;

  end ;

  if regle = Nb

  then // Fin

    case etat of

      0 : // Gestation

        result := StrMiseBas ;

      1 : // Lactation

        result := StrSevrage ;

      2 : // I.S.S.F.

        result := StrSaillie ;

    end

  else

  begin

    case etat of

      0 : // Gestation

        Rec := PRationT.RuleGest[regle] ;

      1 : // Lactation

        Rec := PRationT.RuleLact[regle] ;

      2 : // I.S.S.F.

        Rec := PRationT.RuleISSF[regle] ;

    end ;

    with Rec do

      case ModeFin of

        0 : // Dur?e

          result := Format ('%s = %d %s', [CBModeFin.Items[ModeFin], ValFin, StrJ]) ;

        else

          result := '' ;

      end ;

  end ;

end ;

function TFRationT.StrEquation (etat, regle : integer) : string ;

var

  Rec : RecRuleRationT ;

begin

  case etat of

    0 : // Gestation

      Rec := PRationT.RuleGest[regle] ;

    1 : // Lactation

      Rec := PRationT.RuleLact[regle] ;

    2 : // I.S.S.F.

      Rec := PRationT.RuleISSF[regle] ;

  end ;

  with Rec do

    case Equation of

      0 : // Constant (a)

        result := Format ('%s=%s', [CBUnite.Text, DblToStr (a, PBa.Decimals)]) ;

      1 : // Lin?aire (a+b*jour)

        result := Format ('%s=%s+%s*%s', [CBUnite.Text, DblToStr (a, PBa.Decimals), DblToStr (b, PBb.Decimals), _('Day')]) ;

      else

        result := Format ('%s=%s', [CBUnite.Text, CBType.Items[Equation]]) ;

    end ;

end ;

procedure TFRationT.AffGraph ;

var

  f, i, j, k : integer ;

  q, t : double ;

  ok : boolean ;

  function Quantite : double ;

  begin

    with Rule[k] do

      case Equation of

        0 : // Constant

          result := a ;

        1 : // Lin?aire

          result := a + b * (i - 1) ;

        2 : // Lin?aire-plateau

          result := LPvaleur (a, b, c, i, d) ;

        3 : // Curvilin?aire

          result := CLvaleur (a, c, i, d) ;

        else

          result := 0 ;

      end ;

  end ;

begin

  Graph.LeftAxis.Title.Caption := CBUnite.Text ;

  SeriesLigne.Clear ;

  ok := TRUE ;

  case TC.TabIndex of

    0 : // Gestation

    begin

      f := 114 ;

      Graph.BottomAxis.Increment := 20 ;

      Graph.BottomAxis.MinorTickCount := 3 ;

      for k := 1 to NbRule do

        if Rule[k].a = 0 then ok := FALSE ;

    end ;

    1 : // Lactation

    begin

      f := 28 ;

      Graph.BottomAxis.Increment := 7 ;

      Graph.BottomAxis.MinorTickCount := 6 ;

      for k := 1 to NbRule do

        case Rule[k].Equation of

         1 : // Lin?aire

           begin

            if Rule[k].a = 0 then ok := FALSE ;

            if Rule[k].b = 0 then ok := FALSE ;

          end ;

          2 : // Lin?aire-plateau

          begin

            if Rule[k].a = 0 then ok := FALSE ;

            if Rule[k].b = 0 then ok := FALSE ;

            if Rule[k].c <= Rule[k].a then ok := FALSE ;

          end ;

          3 : // Curvilin?aire

          begin

            if Rule[k].a = 0 then ok := FALSE ;

            if Rule[k].c <= Rule[k].a then ok := FALSE ;

          end ;

          else // Constant

            if Rule[k].a = 0 then ok := FALSE ;

        end ;

    end ;

    else // I.S.S.F.

    begin

      f := 10 ;

      Graph.BottomAxis.Increment := 1 ;

      Graph.BottomAxis.MinorTickCount := 0 ;

      for k := 1 to NbRule do

        if Rule[k].a = 0 then ok := FALSE ;

    end ;

  end ;

  if not ok then Exit ;

  t := 0 ;

  j := 0 ;

  for k := 1 to NbRule do

    with Rule[k] do

    begin

      if (ModeFin = 0) and (ValFin > 0)

      then // R?gle dur?e

      begin

        for i := j + 1 to j + ValFin do

        begin

          q := Quantite ;

          SeriesLigne.AddXY (i, q) ;

          t := t + q ;

        end ;

        j := j + ValFin ;

      end

      else

        if (k = NbRule) and (j < f)

        then // R?gle fin

        begin

          for i := j + 1 to f do

          begin

            q := Quantite ;

            SeriesLigne.AddXY (i, q) ;

            t := t + q ;

          end ;

          j := f ;

        end ;

    end ;

  PBMoyenne.AsFloat := t / j ;

  AjustEchelle (Graph) ;

end ;

end.