InraPorc

unit UFSimulT ;

interface

uses

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

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

  JvExControls, JvComponent, JvEnterTab, UVariables, gnugettext;

type

  TFSimulT = class(TForm)

    PC: TPageControl;

    ResSimul: TTabSheet;

    CompSimul: TTabSheet;

    SensSimul: TTabSheet;

    GBSimul: TGroupBox;

    SBAddSimul: TSpeedButton;

    SBDelSimul: TSpeedButton;

    CBSimul: TComboBox;

    CBProfil: TComboBox;

    CBRation: TComboBox;

    CBSeqAli: TComboBox;

    CBCompSimul1: TCheckBox;

    CBCompSimul2: TCheckBox;

    CBCompSimul3: TCheckBox;

    CBCompSimul4: TCheckBox;

    CBCompSimul5: TCheckBox;

    LVariable: TLabel;

    LVariation: TLabel;

    PBVariation: TPBSuperSpin;

    LProfil: TLabel;

    LSeqAli: TLabel;

    LRation: TLabel;

    PSimul: TPanel;

    BBResSimul: TBitBtn;

    BBTabSimul: TBitBtn;

    SBRename: TSpeedButton;

    SBComment: TSpeedButton;

    BBRapSimul: TBitBtn;

    PResSimul: TPanel;

    CBSimulSens: TComboBox;

    LSimulSens: TLabel;

    PSensSimul: TPanel;

    BBSensSimul: TBitBtn;

    CBSimulComp1: TComboBox;

    CBSimulComp2: TComboBox;

    CBSimulComp3: TComboBox;

    CBSimulComp4: TComboBox;

    CBSimulComp5: TComboBox;

    PCompSimul: TPanel;

    BBCompSimul: TBitBtn;

    GBAlim: TGroupBox;

    GBFin: TGroupBox;

    GBInit: TGroupBox;

    PCenter: TPanel;

    PLeft: TPanel;

    GBParam: TGroupBox;

    LLoge: TLabel;

    CBLoge: TComboBox;

    LDureeLact: TLabel;

    LPorteeInit: TLabel;

    LPorteeFin: TLabel;

    CBStadeInit: TComboBox;

    CBStadeFin: TComboBox;

    LBPortee: TListBox;

    PBDureeLact: TPBSuperSpin;

    PBPorteeInit: TPBSuperSpin;

    PBPorteeFin: TPBSuperSpin;

    PAlim: TPanel;

    LOptInit: TLabel;

    CBOptInit: TComboBox;

    CBVariable: TComboBox;

    GBEtatVar: TGroupBox;

    LPorteeVar: TLabel;

    CBStadeVar: TComboBox;

    PBPorteeVarInit: TPBSuperSpin;

    PBPorteeVarFin: TPBSuperSpin;

    LAVar: TLabel;

    LStadeVar: TLabel;

    GBModulation: TGroupBox;

    SBSave: TSpeedButton;

    ChkSeqAli: TCheckBox;

    ChkRation: TCheckBox;

    CBRationProfil: TComboBox;

    JvEnterAsTab: TJvEnterAsTab;

    procedure FormShow(Sender: TObject);

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

    procedure CBSimulChange(Sender: TObject);

    procedure FormActivate(Sender: TObject);

    procedure FormDeactivate(Sender: TObject);

    procedure SBAddSimulClick(Sender: TObject);

    procedure SBDelSimulClick(Sender: TObject);

    procedure PCChange(Sender: TObject);

    procedure BBResSimulClick(Sender: TObject);

    procedure BBCompSimulClick(Sender: TObject);

    procedure BBSensSimulClick(Sender: TObject);

    procedure CBProfilChange(Sender: TObject);

    procedure CBRationChange(Sender: TObject);

    procedure CBSeqAliChange(Sender: TObject);

    procedure CBCompSimul1Click(Sender: TObject);

    procedure CBCompSimul2Click(Sender: TObject);

    procedure CBCompSimul3Click(Sender: TObject);

    procedure CBCompSimul4Click(Sender: TObject);

    procedure CBCompSimul5Click(Sender: TObject);

    procedure BBTabSimulClick(Sender: TObject);

    procedure SBRenameClick(Sender: TObject);

    procedure SBCommentClick(Sender: TObject);

    procedure BBRapSimulClick(Sender: TObject);

    procedure CBSimulSensChange(Sender: TObject);

    procedure CBSimulComp1Change(Sender: TObject);

    procedure CBSimulComp2Change(Sender: TObject);

    procedure CBSimulComp3Change(Sender: TObject);

    procedure CBSimulComp4Change(Sender: TObject);

    procedure CBSimulComp5Change(Sender: TObject);

    procedure LBPorteeDrawItem(Control: TWinControl; Index: Integer;

      Rect: TRect; State: TOwnerDrawState);

    procedure LBPorteeClick(Sender: TObject);

    procedure PBDureeLactChange(Sender: TObject);

    procedure PBPorteeInitChange(Sender: TObject);

    procedure PBPorteeFinChange(Sender: TObject);

    procedure CBStadeInitChange(Sender: TObject);

    procedure CBStadeFinChange(Sender: TObject);

    procedure CBLogeChange(Sender: TObject);

    procedure CBOptInitChange(Sender: TObject);

    procedure CBVariableChange(Sender: TObject);

    procedure PBPorteeVarInitChange(Sender: TObject);

    procedure PBPorteeVarFinChange(Sender: TObject);

    procedure SBSaveClick(Sender: TObject);

    procedure BBRapSensSimulClick(Sender: TObject);

    procedure BBRapCompSimulClick(Sender: TObject);

    procedure ChkSeqAliClick(Sender: TObject);

    procedure ChkRationClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

  private

    { D?clarations priv?es }

    Update, Modified, Modal: boolean;

    IdxSimulT: integer;

    procedure Save;

    procedure ValidBBResSimul;

    procedure ValidBBCompSimul;

    procedure ValidBBSensSimul;

  public

    { D?clarations publiques }

  end;

var

  FSimulT: TFSimulT;

implementation

uses

  UStrings, UInit, UUtil, UFindRec, UFComment, UCalcSimulT, UFResSimulT,

  UFRapSimulT, {UFTabSimulT,} UFCompSimulT, UFWarning;

{$R *.dfm}

{ TFSimulT }

procedure TFSimulT.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.MinHeight := 396 + (Height - ClientHeight);

  Height := Constraints.MinHeight;

  CBOptInit.ItemIndex := 0;

  CBRationProfil.ItemIndex := 0;

  CBStadeVar.ItemIndex := 0;

end;

procedure TFSimulT.FormShow(Sender: TObject);

begin

  Modified := False;

  Modal := False;

  PC.ActivePageIndex := 0;

  // Simualtion simple

  StringsSimulT(CBSimul.Items, True);

  SBAddSimul.Enabled := IsComplete or (ListSimulT.Count < 5);

  SBSave.Enabled := IsComplete or IsEducation;

  // Comparaison

  StringsSimulT(CBSimulComp1.Items, False);

  StringsSimulT(CBSimulComp2.Items, False);

  StringsSimulT(CBSimulComp3.Items, False);

  StringsSimulT(CBSimulComp4.Items, False);

  StringsSimulT(CBSimulComp5.Items, False);

  // Sensibilit?

  StringsSimulT(CBSimulSens.Items, False);

  PBPorteeVarInit.AsInteger := 1;

  PBPorteeVarFin.AsInteger := 8;

  IdxSimulT := -1;

//  CBSimulChange(nil);

end;

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

begin

  if Modified then Save;

  Action := caFree;

  NumWinSimulT := -1;

end;

procedure TFSimulT.FormActivate(Sender: TObject);

begin

  if not Modal

  then

  begin

    StringsProfilT(CBProfil.Items, False);

    StringsLogeT(CBLoge.Items, False);

    StringsSeqAliT(CBSeqAli.Items, False);

    StringsRationT(CBRation.Items, False);

    PCChange(nil);

    PSimul.Enabled := IsComplete or IsEducation or IsEvaluation;

  end;

end;

procedure TFSimulT.FormDeactivate(Sender: TObject);

begin

  if Modified and not Modal then Save;

end;

procedure TFSimulT.PCChange(Sender: TObject);

begin

//  if Modified then Save;

  case PC.ActivePageIndex of

    0: // Simulation simple

      CBSimulChange(nil);

    1: // Comparaison

    begin

      StringsSimulT(CBSimulComp1.Items, False);

      CBSimulComp1Change(nil);

      StringsSimulT(CBSimulComp2.Items, False);

      CBSimulComp2Change(nil);

      StringsSimulT(CBSimulComp3.Items, False);

      CBSimulComp3Change(nil);

      StringsSimulT(CBSimulComp4.Items, False);

      CBSimulComp4Change(nil);

      StringsSimulT(CBSimulComp5.Items, False);

      CBSimulComp5Change(nil);

    end;

    2: // Sensibilit?

    begin

      StringsSimulT(CBSimulSens.Items, False);

      CBSimulSensChange(nil);

    end;

  end;

end;

// Simulation simple

procedure TFSimulT.Save;

var

  s: string;

begin

  Modified := False;

  if IsComplete or IsEducation

  then

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

    then

    begin

      SaveSimulT;

      if not SimulTValid(PSimulT)

      then

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

      // Comparaison

      StringsSimulT(CBSimulComp1.Items, False);

      StringsSimulT(CBSimulComp2.Items, False);

      StringsSimulT(CBSimulComp3.Items, False);

      StringsSimulT(CBSimulComp4.Items, False);

      StringsSimulT(CBSimulComp5.Items, False);

      // Sensibilit?

      StringsSimulT(CBSimulSens.Items, False);

    end

    else

    begin

      LoadSimulT;

      s := CBSimul.Text;

      StringsSimulT(CBSimul.Items, True);

      if FindIdxSimulT(s) = -1

      then

      begin

        IdxSimulT := -1;

        CBSimulChange(nil);

      end

      else

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

    end;

end;

procedure TFSimulT.CBSimulChange(Sender: TObject);

begin

  if (IdxSimulT <> -1) and (CBSimul.Text <> PSimulT.Nom)

  then

    if Modified then Save;

  IdxSimulT := FindIdxSimulT (CBSimul.Text);

  if IdxSimulT = -1

  then // Pas d'enregistrement

  begin

    CBSimul.Repaint ;

    SBDelSimul.Enabled := FALSE ;

    SBRename.Enabled := FALSE ;

    SBComment.Enabled := FALSE ;

    SBSave.Enabled := FALSE ;

    PSimul.Visible := FALSE ;

    BBResSimul.Enabled := FALSE ;

    BBRapSimul.Enabled := FALSE ;

    BBTabSimul.Enabled := FALSE ;

  end

  else // Affichage de l'enregistrement

  begin

    SBDelSimul.Enabled := TRUE ;

    SBRename.Enabled := TRUE ;

    SBComment.Enabled := TRUE ;

    SBSave.Enabled := TRUE ;

    PSimul.Visible := TRUE ;

    PSimulT := ListSimulT[IdxSimulT] ;

    with PSimulT^ do

    begin

      Update := TRUE ;

      CBSimul.Hint := Memo ;

      if Profil = -1

      then

        CBProfil.ItemIndex := -1

      else

        CBProfil.ItemIndex := CBProfil.Items.IndexOf (FindNomProfilT (Profil)) ;

      if CBProfil.ItemIndex = -1

      then

        CBProfil.Hint := ''

      else

      begin

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

        CBProfil.Hint := PProfilT.Memo ;

      end ;

      if Logement = -1

      then

        CBLoge.ItemIndex := -1

      else

        CBLoge.ItemIndex := CBLoge.Items.IndexOf (FindNomLogeT (Logement)) ;

      if CBLoge.ItemIndex = -1

      then

        CBLoge.Hint := ''

      else

      begin

        PLogeT := ListLogeT[FindIdxLogeT (CBLoge.Text)] ;

        CBLoge.Hint := PLogeT.Memo ;

      end ;

      PBDureeLact.AsInteger := DureeLact ;

      CBOptInit.ItemIndex := OptInit ;

      PBPorteeInit.AsInteger := StadeInit div 3 + 1 ;

      CBStadeInit.ItemIndex := StadeInit mod 3 ;

      PBPorteeFin.AsInteger := StadeFin div 3 + 1 ;

      CBStadeFin.ItemIndex := StadeFin mod 3 ;

      LBPortee.ItemIndex := -1 ;

      LBPorteeClick (nil) ;

      LBPortee.Repaint ;

      Update := FALSE ;

    end ;

    ValidBBResSimul;

  end;

end;

procedure TFSimulT.SBAddSimulClick (Sender : TObject) ;

var

  i, n, q : integer ;

  s : string ;

  ok : boolean ;

  PBackup : PRecSimulT ;

begin

  if Modified then Save ;

  if IdxSimulT = -1

  then

    q := mrNo

  else

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

  // saisie du nouveau nom

  s := '' ;

  repeat

    if InputQuery (FSimulT.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 < ListSimulT.Count) do

          begin

            PSimulT := ListSimulT[i] ;

            if PSimulT.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 (IdxSimulT <> -1)

      then

        PSimulT := ListSimulT[IdxSimulT] ;

      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 < ListSimulT.Count) do

      begin

        PSimulT := ListSimulT[i] ;

        if PSimulT.Num = n

        then

          ok := FALSE

        else

          Inc (i) ;

      end ;

    until ok ;

    New (PSimulT) ;

    with PSimulT^ do

    begin

      Nom := s ;

      Num := n ;

      if q = mrYes

      then

      begin

        PBackup := ListSimulT[IdxSimulT] ;

        Memo := PBackup.Memo ;

        Profil := PBackup.Profil ;

        Logement := PBackup.Logement ;

        DureeLact := PBackup.DureeLact ;

        DureeISSF := PBackup.DureeISSF ; // DureeISSF n'est plus utilis?

        OptInit := PBackup.OptInit ;

        StadeInit := PBackup.StadeInit ;

        StadeFin := PBackup.StadeFin ;

        SeqAli := PBackup.SeqAli ;

        Ration := PBackup.Ration ;

      end

      else

      begin

        Memo := '' ;

        Profil := -1 ;

        Logement := -1 ;

        DureeLact := 28 ;

        DureeISSF := 5 ; // DureeISSF n'est plus utilis?

        OptInit := 0 ;

        StadeInit := 0 ;

        StadeFin := 2 ;

        for i := 1 to NB_CYCLES do

          SeqAli[i] := -1 ;

        for i := 1 to NB_CYCLES do

          Ration[i] := -1 ;

      end ;

    end ;

    ListSimulT.Add (PSimulT) ;

    CBSimul.Items.Add (PSimulT.Nom) ;

    CBSimul.ItemIndex := CBSimul.Items.IndexOf (PSimulT.Nom) ;

    CBSimulChange (nil) ;

    Modified := TRUE ;

    SBAddSimul.Enabled := IsComplete or (ListSimulT.Count < 5) ;

    SBCommentClick (nil) ;

  end ;

end ;

procedure TFSimulT.SBDelSimulClick (Sender : TObject) ;

begin

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

  then

  begin

    Dispose (PSimulT) ;

    ListSimulT.Delete (IdxSimulT) ;

    SaveSimulT ; // Sauvegarde !

    Modified := FALSE ;

    CBSimul.DeleteSelected ;

    IdxSimulT := -1 ;

    CBSimul.ItemIndex := -1 ;

    CBSimulChange (nil) ;

    SBAddSimul.Enabled := IsComplete or (ListSimulT.Count < 5) ;

  end ;

end ;

procedure TFSimulT.SBRenameClick (Sender : TObject) ;

var

  i : integer ;

  s : string ;

  ok : boolean ;

begin

  // Saisie du nouveau nom

  s := CBSimul.Text ;

  repeat

    if InputQuery (FSimulT.Caption, MsgRename, s) and (s <> CBSimul.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 < ListSimulT.Count) do

          begin

            PSimulT := ListSimulT[i] ;

            if PSimulT.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 ;

  PSimulT := ListSimulT[IdxSimulT] ;

  if s <> ''

  then // Renommer l'enregistrement

  begin

    PSimulT.Nom := s ;

    Modified := TRUE ;

    StringsSimulT (CBSimul.Items, TRUE) ;

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

  end ;

end ;

procedure TFSimulT.SBCommentClick (Sender : TObject) ;

begin

  // Saisie du commentaire

  FComment := TFComment.Create (Self) ;

  with FComment do

  begin

    Memo.Text := PSimulT.Memo ;

    if ShowModal = mrOk

    then // Commenter l'enregistrement

    begin

      PSimulT.Memo := Memo.Text ;

      Modified := TRUE ;

      CBSimul.Hint := PSimulT.Memo ;

    end ;

    Release ;

  end ;

end ;

procedure TFSimulT.SBSaveClick(Sender: TObject);

begin

  SaveSimulT ;

  if not SimulTValid (PSimulT)

  then

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

  Modified := FALSE ;

end;

procedure TFSimulT.CBProfilChange (Sender : TObject) ;

begin

  if CBProfil.ItemIndex = -1

  then

    CBProfil.Hint := ''

  else

  begin

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

    CBProfil.Hint := PProfilT.Memo ;

  end ;

  if not Update

  then

  begin

    Modified := TRUE ;

    PSimulT.Profil := FindNumProfilT (CBProfil.Text) ;

    PBDureeLact.AsInteger := PProfilT.DureeLact ;

    ValidBBResSimul ;

  end ;

end ;

procedure TFSimulT.CBLogeChange (Sender : TObject) ;

begin

  if CBLoge.ItemIndex = -1

  then

    CBLoge.Hint := ''

  else

  begin

    PLogeT := ListLogeT[FindIdxLogeT (CBLoge.Text)] ;

    CBLoge.Hint := PLogeT.Memo ;

  end ;

  if not Update

  then

  begin

    Modified := TRUE ;

    PSimulT.Logement := FindNumLogeT (CBLoge.Text) ;

    ValidBBResSimul ;

  end ;

end ;

procedure TFSimulT.PBDureeLactChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    PSimulT.DureeLact := PBDureeLact.AsInteger ;

  end ;

end ;

procedure TFSimulT.CBOptInitChange (Sender : TObject) ;

begin

  if CBOptInit.ItemIndex = 2

  then // Au d?part seulement

    if AffOptInit

    then

    begin

      FWarning := TFWarning.Create (Self) ;

      with FWarning do

      begin

        Msg := 'OptInit';

        ShowModal ;

        Release ;

        AffOptInit := FALSE ;

      end ;

    end ;

  if not Update

  then

  begin

    Modified := TRUE ;

    PSimulT.OptInit := CBOptInit.ItemIndex ;

  end ;

end ;

procedure TFSimulT.PBPorteeInitChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    PSimulT.StadeInit := (PBPorteeInit.AsInteger - 1) * 3

      + CBStadeInit.ItemIndex ;

    if PSimulT.StadeInit >= PSimulT.StadeFin

    then

      if PSimulT.StadeFin >= 21

      then // Port?e 8

      begin

        PSimulT.StadeFin := PSimulT.StadeFin + 1 ;

        Update := TRUE ;

        CBStadeFin.ItemIndex := PSimulT.StadeFin mod 3 ;

        Update := FALSE ;

      end

      else

      begin

        PSimulT.StadeFin := PSimulT.StadeFin + 3 ;

        Update := TRUE ;

        PBPorteeFin.AsInteger := PSimulT.StadeFin div 3 + 1 ;

        Update := FALSE ;

      end ;

    LBPortee.Repaint ;

  end ;

end ;

procedure TFSimulT.CBStadeInitChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    PSimulT.StadeInit := (PBPorteeInit.AsInteger - 1) * 3

      + CBStadeInit.ItemIndex ;

    if PSimulT.StadeInit >= PSimulT.StadeFin

    then

      if PSimulT.StadeFin mod 3 = 2

      then // Sevrage

      begin

        PSimulT.StadeFin := PSimulT.StadeFin + 3 ;

        Update := TRUE ;

        PBPorteeFin.AsInteger := PSimulT.StadeFin div 3 + 1 ;

        Update := FALSE ;

      end

      else

      begin

        PSimulT.StadeFin := PSimulT.StadeFin + 1 ;

        Update := TRUE ;

        CBStadeFin.ItemIndex := PSimulT.StadeFin mod 3 ;

        Update := FALSE ;

      end ;

    LBPortee.Repaint ;

  end ;

end ;

procedure TFSimulT.PBPorteeFinChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    PSimulT.StadeFin := (PBPorteeFin.AsInteger - 1) * 3

      + CBStadeFin.ItemIndex ;

    if PSimulT.StadeInit >= PSimulT.StadeFin

    then

      if PSimulT.StadeFin div 3 = PSimulT.StadeInit div 3

      then

      begin

        PSimulT.StadeFin := PSimulT.StadeInit + 1 ;

        Update := TRUE ;

        CBStadeFin.ItemIndex := PSimulT.StadeFin mod 3 ;

        Update := FALSE ;

      end

      else

      begin

        PSimulT.StadeFin := PSimulT.StadeFin + 3 ;

        Update := TRUE ;

        PBPorteeFin.AsInteger := PSimulT.StadeFin div 3 + 1 ;

        Update := FALSE ;

      end ;

    LBPortee.Repaint ;

  end ;

end ;

procedure TFSimulT.CBStadeFinChange (Sender : TObject) ;

begin

  if not Update

  then

  begin

    Modified := TRUE ;

    PSimulT.StadeFin := (PBPorteeFin.AsInteger - 1) * 3

      + CBStadeFin.ItemIndex ;

    if PSimulT.StadeInit >= PSimulT.StadeFin

    then

      if PSimulT.StadeFin >= 21

      then // Port?e 8

      begin

        PSimulT.StadeFin := PSimulT.StadeInit + 1 ;

        Update := TRUE ;

        CBStadeFin.ItemIndex := PSimulT.StadeFin mod 3 ;

        Update := FALSE ;

      end

      else

      begin

        PSimulT.StadeFin := PSimulT.StadeFin + 3 ;

        Update := TRUE ;

        PBPorteeFin.AsInteger := PSimulT.StadeFin div 3 + 1 ;

        Update := FALSE ;

      end ;

    LBPortee.Repaint ;

  end ;

end ;

procedure TFSimulT.LBPorteeDrawItem (Control : TWinControl ; Index : Integer ;

  Rect : TRect ; State : TOwnerDrawState) ;

begin

  with (Control as TListBox).Canvas do

  begin

    // Cadre principal

    FillRect (Rect) ;

//    if (PSimulT.SeqAli[Index + 1] = -1) or (PSimulT.Ration[Index + 1] = -1)

//    then

//      Font.Color := clRed

//    else

      if (odSelected in State)

      then

        Font.Color := clYellow

      else

        Font.Color := clBlue ;

    // ISSF

    if (Index * 3 + 2 >= PSimulT.StadeInit)

      and (Index * 3 + 2 < PSimulT.StadeFin)

    then

      TextRect (Rect, Rect.Left + 240, Rect.Top, StrISSF) ;

    Rect.Right := 240 ;

    // Lactation

    if (Index * 3 + 1 >= PSimulT.StadeInit)

      and (Index * 3 + 1 < PSimulT.StadeFin)

    then

      TextRect (Rect, Rect.Left + 160, Rect.Top, StrLactation) ;

    Rect.Right := 160 ;

    // Gestation

    if (Index * 3 >= PSimulT.StadeInit)

      and (Index * 3 < PSimulT.StadeFin)

    then

      TextRect (Rect, Rect.Left + 80, Rect.Top, StrGestation) ;

    Rect.Right := 80 ;

    // Texte

    if (odSelected in State)

    then

      Font.Color := clWhite

    else

      Font.Color := clBlack ;

    TextRect (Rect, Rect.Left, Rect.Top, LBPortee.Items[Index]) ;

  end ;

end ;

procedure TFSimulT.LBPorteeClick (Sender : TObject) ;

begin

  if LBPortee.ItemIndex = -1

  then

    LBPortee.ItemIndex := PBPorteeInit.AsInteger - 1 ;

  Update := TRUE ;

  ChkSeqAli.Checked := (PSimulT.SeqAli[LBPortee.ItemIndex + 1] = -1) ;

  ChkRation.Checked := (PSimulT.Ration[LBPortee.ItemIndex + 1] = -1) ;

  if PSimulT.Profil = -1

  then

    CBSeqAli.ItemIndex := -1

  else

    if ChkSeqAli.Checked

    then

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

    else

      CBSeqAli.ItemIndex := CBSeqAli.Items.IndexOf (FindNomSeqAliT (PSimulT.SeqAli[LBPortee.ItemIndex + 1])) ;

  CBSeqAliChange (nil) ;

  if ChkRation.Checked

  then

    CBRation.ItemIndex := -1

  else

    CBRation.ItemIndex := CBRation.Items.IndexOf (FindNomRationT (PSimulT.Ration[LBPortee.ItemIndex + 1])) ;

  CBRationChange (nil) ;

  Update := FALSE ;

end ;

procedure TFSimulT.CBSeqAliChange (Sender : TObject) ;

begin

  if CBSeqAli.ItemIndex = -1

  then

    CBSeqAli.Hint := ''

  else

  begin

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

    CBSeqAli.Hint := PSeqAliT.Memo ;

  end ;

  if not Update

  then

  begin

    Modified := TRUE ;

    PSimulT.SeqAli[LBPortee.ItemIndex + 1] := FindNumSeqAliT (CBSeqAli.Text) ;

//    LBPortee.Repaint ;

  end ;

end ;

procedure TFSimulT.ChkSeqAliClick(Sender: TObject);

begin

  CBSeqAli.Enabled := not ChkSeqAli.Checked ;

  if ChkSeqAli.Checked

  then

    if not Update

    then

    begin

      Modified := TRUE ;

      PSimulT.SeqAli[LBPortee.ItemIndex + 1] := -1 ;

      Update := TRUE ;

      if PSimulT.Profil = -1

      then

        CBSeqAli.ItemIndex := -1

      else

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

      CBSeqAliChange (nil) ;

      Update := FALSE ;

//      LBPortee.Repaint ;

    end ;

end;

procedure TFSimulT.CBRationChange (Sender : TObject) ;

begin

  if CBRation.ItemIndex = -1

  then

    CBRation.Hint := ''

  else

  begin

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

    CBRation.Hint := PRationT.Memo ;

  end ;

  if not Update

  then

  begin

    Modified := TRUE ;

    PSimulT.Ration[LBPortee.ItemIndex + 1] := FindNumRationT (CBRation.Text) ;

//    LBPortee.Repaint ;

  end ;

end ;

procedure TFSimulT.ChkRationClick(Sender: TObject);

begin

  CBRation.Visible := not ChkRation.Checked ;

  CBRationProfil.Visible := ChkRation.Checked ;

  if ChkRation.Checked

  then

    if not Update

    then

    begin

      Modified := TRUE ;

      PSimulT.Ration[LBPortee.ItemIndex + 1] := -1 ;

      Update := TRUE ;

      CBRation.ItemIndex := -1 ;

      CBRationChange (nil) ;

      Update := FALSE ;

//      LBPortee.Repaint ;

    end ;

end;

procedure TFSimulT.BBResSimulClick (Sender : TObject) ;

begin

  if AffSimulT

  then

  begin

    FWarning := TFWarning.Create (Self) ;

    with FWarning do

    begin

      Msg := 'SimulT';

      ShowModal ;

      Release ;

      AffSimulT := FALSE ;

    end ;

  end ;

  Modal := True;

  New (PResSimulT) ;

  CalcSimulT (PSimulT.Num, -1, 1, 1, 8, 0, PResSimulT) ;

  FResSimulT := TFResSimulT.Create (Self) ;

  FResSimulT.ShowModal ;

  FResSimulT.Release ;

  Dispose (PResSimulT) ;

  Modal := False;

end ;

procedure TFSimulT.BBRapSimulClick (Sender : TObject) ;

begin

  if AffSimulT

  then

  begin

    FWarning := TFWarning.Create (Self) ;

    with FWarning do

    begin

      Msg := 'SimulT';

      ShowModal ;

      Release ;

      AffSimulT := FALSE ;

    end ;

  end ;

  Modal := True;

  New (PResSimulT) ;

  CalcSimulT (PSimulT.Num, -1, 1, 1, 8, 0, PResSimulT) ;

  FRapSimulT := TFRapSimulT.Create (Self) ;

  FRapSimulT.QRRapport.PreviewModal ;

  FRapSimulT.Release ;

  Dispose (PResSimulT) ;

  Modal := False;

end ;

procedure TFSimulT.BBTabSimulClick (Sender : TObject) ;

begin

//  Modal := True;

//  New (PResSimulT) ;

//  CalcSimulT (PSimulT.Num, -1, 1, 1, 8, 0, PResSimulT) ;

//  FTabSimulT := TFTabSimulT.Create (Self) ;

//  FTabSimulT.ShowModal ;

//  FTabSimulT.Release ;

//  Dispose (PResSimulT) ;

//  Modal := False;

end ;

procedure TFSimulT.ValidBBResSimul ;

var

  ok : boolean ;

begin

  ok := SimulTValid (PSimulT) ;

//  PCenter.Visible := ok ;

  BBResSimul.Enabled := ok ;

  BBRapSimul.Enabled := ok ;

  BBTabSimul.Enabled := ok ;

  if ok then LBPorteeClick (nil) ;

end ;

// Comparaison

procedure TFSimulT.CBCompSimul1Click (Sender : TObject) ;

begin

  if CBCompSimul1.Checked

  then

    CBSimulComp1.Enabled := TRUE

  else

    CBSimulComp1.Enabled := FALSE ;

  ValidBBCompSimul ;

end ;

procedure TFSimulT.CBCompSimul2Click (Sender : TObject) ;

begin

  if CBCompSimul2.Checked

  then

    CBSimulComp2.Enabled := TRUE

  else

    CBSimulComp2.Enabled := FALSE ;

  ValidBBCompSimul ;

end ;

procedure TFSimulT.CBCompSimul3Click (Sender : TObject) ;

begin

  if CBCompSimul3.Checked

  then

    CBSimulComp3.Enabled := TRUE

  else

    CBSimulComp3.Enabled := FALSE ;

  ValidBBCompSimul ;

end ;

procedure TFSimulT.CBCompSimul4Click (Sender : TObject) ;

begin

  if CBCompSimul4.Checked

  then

    CBSimulComp4.Enabled := TRUE

  else

    CBSimulComp4.Enabled := FALSE ;

  ValidBBCompSimul ;

end ;

procedure TFSimulT.CBCompSimul5Click (Sender : TObject) ;

begin

  if CBCompSimul5.Checked

  then

    CBSimulComp5.Enabled := TRUE

  else

    CBSimulComp5.Enabled := FALSE ;

  ValidBBCompSimul ;

end ;

procedure TFSimulT.CBSimulComp1Change (Sender : TObject) ;

begin

  if CBSimulComp1.ItemIndex = -1

  then

    CBSimulComp1.Hint := ''

  else

  begin

    PSimulT := ListSimulT[FindIdxSimulT (CBSimulComp1.Text)] ;

    CBSimulComp1.Hint := PSimulT.Memo ;

  end ;

  ValidBBCompSimul ;

end ;

procedure TFSimulT.CBSimulComp2Change (Sender : TObject) ;

begin

  if CBSimulComp2.ItemIndex = -1

  then

    CBSimulComp2.Hint := ''

  else

  begin

    PSimulT := ListSimulT[FindIdxSimulT (CBSimulComp2.Text)] ;

    CBSimulComp2.Hint := PSimulT.Memo ;

  end ;

  ValidBBCompSimul ;

end ;

procedure TFSimulT.CBSimulComp3Change (Sender : TObject) ;

begin

  if CBSimulComp3.ItemIndex = -1

  then

    CBSimulComp3.Hint := ''

  else

  begin

    PSimulT := ListSimulT[FindIdxSimulT (CBSimulComp3.Text)] ;

    CBSimulComp3.Hint := PSimulT.Memo ;

  end ;

  ValidBBCompSimul ;

end ;

procedure TFSimulT.CBSimulComp4Change (Sender : TObject) ;

begin

  if CBSimulComp4.ItemIndex = -1

  then

    CBSimulComp4.Hint := ''

  else

  begin

    PSimulT := ListSimulT[FindIdxSimulT (CBSimulComp4.Text)] ;

    CBSimulComp4.Hint := PSimulT.Memo ;

  end ;

  ValidBBCompSimul ;

end ;

procedure TFSimulT.CBSimulComp5Change (Sender : TObject) ;

begin

  if CBSimulComp5.ItemIndex = -1

  then

    CBSimulComp5.Hint := ''

  else

  begin

    PSimulT := ListSimulT[FindIdxSimulT (CBSimulComp5.Text)] ;

    CBSimulComp5.Hint := PSimulT.Memo ;

  end ;

  ValidBBCompSimul ;

end ;

procedure TFSimulT.BBCompSimulClick (Sender : TObject) ;

var

  i : integer ;

begin

  if AffSimulT

  then

  begin

    FWarning := TFWarning.Create (Self) ;

    with FWarning do

    begin

      Msg := 'SimulT';

      ShowModal ;

      Release ;

      AffSimulT := FALSE ;

    end ;

  end ;

  Modal := True;

  // Simulation 1

  with TabSimulT[1] do

    if CBCompSimul1.Checked and (CBSimulComp1.ItemIndex <> -1)

    then

    begin

      Ok := TRUE ;

      Simul := FindNumSimulT (CBSimulComp1.Text) ;

    end

    else

      Ok := FALSE ;

  // Simulation 2

  with TabSimulT[2] do

    if CBCompSimul2.Checked and (CBSimulComp2.ItemIndex <> -1)

    then

    begin

      Ok := TRUE ;

      Simul := FindNumSimulT (CBSimulComp2.Text) ;

    end

    else

      Ok := FALSE ;

  // Simulation 3

  with TabSimulT[3] do

    if CBCompSimul3.Checked and (CBSimulComp3.ItemIndex <> -1)

    then

    begin

      Ok := TRUE ;

      Simul := FindNumSimulT (CBSimulComp3.Text) ;

    end

    else

      Ok := FALSE ;

  // Simulation 4

  with TabSimulT[4] do

    if CBCompSimul4.Checked and (CBSimulComp4.ItemIndex <> -1)

    then

    begin

      Ok := TRUE ;

      Simul := FindNumSimulT (CBSimulComp4.Text) ;

    end

    else

      Ok := FALSE ;

  // Simulation 5

  with TabSimulT[5] do

    if CBCompSimul5.Checked and (CBSimulComp5.ItemIndex <> -1)

    then

    begin

      Ok := TRUE ;

      Simul := FindNumSimulT (CBSimulComp5.Text) ;

    end

    else

      Ok := FALSE ;

  // Calcul des simulations

  for i := 1 to 5 do

    with TabSimulT[i] do

      if Ok

      then

      begin

        New (Result) ;

        CalcSimulT (Simul, -1, 1, 1, 8, 0, Result) ;

      end ;

  FCompSimulT := TFCompSimulT.Create (Self) ;

  FCompSimulT.ShowModal ;

  FCompSimulT.Release ;

  for i := 1 to 5 do

    with TabSimulT[i] do

      if Ok then Dispose (Result) ;

  Modal := False;

end ;

procedure TFSimulT.BBRapCompSimulClick(Sender: TObject);

begin

//

end;

procedure TFSimulT.ValidBBCompSimul ;

begin

  if (CBCompSimul1.Checked and (CBSimulComp1.ItemIndex <> -1))

    or (CBCompSimul2.Checked and (CBSimulComp2.ItemIndex <> -1))

    or (CBCompSimul3.Checked and (CBSimulComp3.ItemIndex <> -1))

    or (CBCompSimul4.Checked and (CBSimulComp4.ItemIndex <> -1))

    or (CBCompSimul5.Checked and (CBSimulComp5.ItemIndex <> -1))

  then

    BBCompSimul.Enabled := TRUE

  else

    BBCompSimul.Enabled := FALSE ;

  BBCompSimul.Enabled := BBCompSimul.Enabled ;

end ;

// Sensibilit?

procedure TFSimulT.CBSimulSensChange (Sender : TObject) ;

begin

  if CBSimulSens.ItemIndex = -1

  then

    CBSimulSens.Hint := ''

  else

  begin

    PSimulT := ListSimulT[FindIdxSimulT (CBSimulSens.Text)] ;

    CBSimulSens.Hint := PSimulT.Memo ;

  end ;

  ValidBBSensSimul ;

end ;

procedure TFSimulT.CBVariableChange(Sender: TObject);

begin

  GBEtatVar.Visible := (CBVariable.ItemIndex > 2) ;

  CBStadeVar.Enabled := (CBVariable.ItemIndex <> 3) ;

  if CBVariable.ItemIndex = 3

  then // Temp?rature ambiante

    CBStadeVar.ItemIndex := 0 ; // Gestation

  ValidBBSensSimul ;

end;

procedure TFSimulT.PBPorteeVarInitChange(Sender: TObject);

begin

  if (PBPorteeVarInit.AsInteger >= PBPorteeVarInit.MinValue)

    and (PBPorteeVarInit.AsInteger <= PBPorteeVarInit.MaxValue)

  then

    if (PBPorteeVarInit.AsInteger > PBPorteeVarFin.AsInteger)

    then

      PBPorteeVarFin.AsInteger := PBPorteeVarInit.AsInteger ;

end;

procedure TFSimulT.PBPorteeVarFinChange(Sender: TObject);

begin

  if (PBPorteeVarFin.AsInteger >= PBPorteeVarFin.MinValue)

    and (PBPorteeVarFin.AsInteger <= PBPorteeVarFin.MaxValue)

  then

    if (PBPorteeVarFin.AsInteger < PBPorteeVarInit.AsInteger)

    then

      PBPorteeVarInit.AsInteger := PBPorteeVarFin.AsInteger ;

end;

procedure TFSimulT.BBSensSimulClick (Sender : TObject) ;

var

  i, k : integer ;

  d : double ;

begin

  if AffSimulT

  then

  begin

    FWarning := TFWarning.Create (Self) ;

    with FWarning do

    begin

      Msg := 'SimulT';

      ShowModal ;

      Release ;

      AffSimulT := FALSE ;

    end ;

  end ;

  Modal := True;

  i := CBVariable.ItemIndex ;

  d := PBVariation.AsFloat ;

  TabSimulT[1].Variation := (100 + d * 2) / 100 ;

  TabSimulT[2].Variation := (100 + d) / 100 ;

  TabSimulT[3].Variation := 1 ;

  TabSimulT[4].Variation := (100 - d) / 100 ;

  TabSimulT[5].Variation := (100 - d * 2) / 100 ;

  for k := 1 to 5 do

    with TabSimulT[k] do

    begin

      Ok := TRUE ;

      Simul := FindNumSimulT (CBSimulSens.Text) ;

      // Calcul des simulations

      New (Result) ;

      if (CBVariable.ItemIndex > 2)

      then

        CalcSimulT (Simul, i, Variation, PBPorteeVarInit.AsInteger, PBPorteeVarFin.AsInteger, CBStadeVar.ItemIndex, Result)

      else

        CalcSimulT (Simul, i, Variation, 1, 8, 0, Result) ;

    end ;

  FCompSimulT := TFCompSimulT.Create (Self) ;

  FCompSimulT.ShowModal ;

  FCompSimulT.Release ;

  for k := 1 to 5 do

    Dispose (TabSimulT[k].Result) ;

  Modal := False;

end ;

procedure TFSimulT.BBRapSensSimulClick(Sender: TObject);

begin

//

end;

procedure TFSimulT.ValidBBSensSimul ;

begin

  BBSensSimul.Enabled := (CBSimulSens.ItemIndex <> -1) and (CBVariable.ItemIndex <> -1);

  BBSensSimul.Enabled := BBSensSimul.Enabled;

end ;

end.