InraPorc

unit UFResBesLactE;

interface

uses

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

  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, CheckLst, Menus, Printers, 

  Math, Contnrs, PBNumEdit, PBSuperSpin, Grids, TeEngine, Series, TeeProcs, 

  Chart, TeeEdit, UVariables, gnugettext;

type

  TFResBesLactE = class(TForm)

    PC: TPageControl;

    TabNRJ: TTabSheet;

    TabAA: TTabSheet;

    CBAA3: TComboBox;

    CBAA4: TComboBox;

    GBAAY: TGroupBox;

    Graph: TChart;

    GBNRJY: TGroupBox;

    CBNRJ3: TComboBox;

    LBAA: TListBox;

    LBNRJ: TListBox;

    TSAli: TTabSheet;

    TSMin: TTabSheet;

    GBMin: TGroupBox;

    CBMin3: TComboBox;

    CBMin4: TComboBox;

    CBNRJ4: TComboBox;

    PM: TPopupMenu;

    MI3D: TMenuItem;

    MIPreview: TMenuItem;

    MIPrint: TMenuItem;

    PD: TPrintDialog;

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

    procedure FormShow(Sender: TObject);

    procedure PCChange(Sender: TObject);

    procedure CBNRJ3Change(Sender: TObject);

    procedure CBNRJ4Change(Sender: TObject);

    procedure CBAA3Change(Sender: TObject);

    procedure CBAA4Change(Sender: TObject);

    procedure CBAli2Change(Sender: TObject);

    procedure CBMin3Change(Sender: TObject);

    procedure CBMin4Change(Sender: TObject);

    procedure MI3DClick(Sender: TObject);

    procedure MIPreviewClick(Sender: TObject);

    procedure MIPrintClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND;

  private

    { D?clarations priv?es }

    BarAli : TBarSeries ;

    ListNRJ : TStrings ;

    BarNRJ : array of TBarSeries ;

    ListAA : TStrings ;

    BarAA : array of TBarSeries ;

    BarMin : TBarSeries ;

    procedure ResetGraph ;

    procedure InitAli ;

    procedure AffGraphAli ;

    procedure InitNRJ ;

    procedure AffGraphNRJ ;

    procedure InitAA ;

    procedure AffGraphAA ;

    procedure InitMin ;

    procedure AffGraphMin ;

  public

    { D?clarations publiques }

  end;

var

  FResBesLactE: TFResBesLactE;

implementation

uses

  UStrings, UFindRec, UUtil, UEchelle, UFBesLactE, UFPrevGraph ;

{$R *.dfm}

{ TFResBesLactE }

procedure TFResBesLactE.FormCreate(Sender: TObject);

begin

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

  then

    Font.Name := 'Arial Unicode MS';

  TranslateComponent(Self);

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

  Width := 640;

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

  Height := 480;

  CBNRJ3.ItemIndex := 0;

  CBNRJ4.Items.Add(Format('%s/%s', [StrMJ, StrJ]));

  CBNRJ4.Items.Add('%');

  CBNRJ4.ItemIndex := 0;

  CBAA3.ItemIndex := 0;

  CBAA4.Items.Add(Format('%s/%s', [StrG, StrJ]));

  CBAA4.Items.Add('%');

  CBAA4.Items.Add(Format('%s/%s %s', [StrG, StrKg, StrAlimentUnit]));

  CBAA4.ItemIndex := 0;

  CBMin3.ItemIndex := 0;

  CBMin4.Items.Add(Format('%s/%s', [StrG, StrJ]));

  CBMin4.Items.Add(Format('%s/%s %s', [StrG, StrKg, StrAlimentUnit]));

  CBMin4.ItemIndex := 0;

end;

procedure TFResBesLactE.FormShow (Sender : TObject) ;

begin

  MIPrint.Enabled := IsComplete or IsEducation ;

  // Aliment

  InitAli ;

  // Energie

  InitNRJ ;

  // Acides Amin?s

  InitAA ;

  // Min?raux

  InitMin ;

  // Affichage principal

  PC.ActivePageIndex := 0 ;

  PCChange (nil) ;

end ;

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

var

  i : integer ;

begin

  // Aliment

  BarAli.Free ;

  // Energie

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

    BarNRJ[i].Free ;

  SetLength (BarNRJ, 0) ;

  ListNRJ.Free ;

  // Acides Amin?s

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

    BarAA[i].Free ;

  SetLength (BarAA, 0) ;

  ListAA.Free ;

  // Min?raux

  BarMin.Free ;

end ;

procedure TFResBesLactE.PCChange (Sender : TObject) ;

begin

  case PC.ActivePageIndex of

    0 : // Aliment

      AffGraphAli ;

    1 : // Energie

      AffGraphNRJ ;

    2 : // Acides Amin?s

      AffGraphAA ;

    3 : // Min?raux

      AffGraphMin ;

  end ;

end ;

procedure TFResBesLactE.ResetGraph ;

var

  i : integer ;

begin

  Graph.UndoZoom ;

  Graph.View3D := FALSE ;

  Graph.Legend.Visible := TRUE ;

  Graph.Title.Text.Clear ;

  Graph.SubTitle.Text.Clear ;

  Graph.LeftAxis.Automatic := FALSE ;

  Graph.BottomAxis.MinimumOffset := 0;

  Graph.BottomAxis.MaximumOffset := 0;

  // Aliment

  BarAli.Active := FALSE ;

  // Energie

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

    BarNRJ[i].Active := FALSE ;

  // Acides Amin?s

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

    BarAA[i].Active := FALSE ;

  // Min?raux

  BarMin.Active := FALSE ;

end ;

procedure TFResBesLactE.MI3DClick (Sender : TObject) ;

begin

  Graph.View3D := not (Graph.View3D) ;

end ;

procedure TFResBesLactE.MIPreviewClick (Sender : TObject) ;

begin

  FPrevGraph := TFPrevGraph.Create (Self) ;

  with FPrevGraph do

  begin

    TPPGraph.Panels.Add (Graph) ;

    ShowModal ;

    Release ;

  end ;

end ;

procedure TFResBesLactE.MIPrintClick (Sender : TObject) ;

begin

  if PD.Execute

  then

  begin

    Printer.Orientation := poLandscape ;

    Graph.Print ;

  end ;

end ;

/////////////////

//   Aliment   //

/////////////////

procedure TFResBesLactE.InitAli ;

begin

  // BarAli : s?rie (barre) graphique

  BarAli := TBarSeries.Create (Graph) ;

  BarAli.ParentChart := Graph ;

  BarAli.Title := ' ' ;

  BarAli.SeriesColor := clTeal ;

  BarAli.BarPen.Color := BarAli.SeriesColor ;

  BarAli.Marks.Style := smsValue ;

  BarAli.Marks.ArrowLength := 0 ;

  BarAli.Marks.Arrow.Visible := FALSE ;

  BarAli.Marks.Brush.Style := bsClear ;

  BarAli.Marks.Frame.Visible := FALSE ;

  BarAli.Marks.Font.Style := [fsBold] ;

  Graph.AddSeries (BarAli) ;

end ;

procedure TFResBesLactE.AffGraphAli ;

var

  j : integer ;

  // Ordonn?e

  function AliY : double ;

  begin

    with FBesLactE do

      if (AppEMTot[j] = 0)

      then

        result := 0

      else

        result := BesEMTot[j] * AppAliTot[j] / AppEMTot[j] ;

  end ;

// AffGraphAli

begin

  ResetGraph ;

  Graph.Legend.Visible := FALSE ;

  Graph.Title.Text.Add (TSAli.Caption) ;

  Graph.LeftAxis.Title.Caption := Format ('%s (%s/%s)', [TSAli.Caption, StrKg, StrJ]) ;

  Graph.BottomAxis.Title.Caption := _('Litter');

  // Affichage de la barre

  BarAli.Active := TRUE ;

  BarAli.Clear ;

  for j := 1 to NB_CYCLES do

    BarAli.AddBar (AliY, Format ('%d', [j]), clTeeColor) ;

  AjustEchelle (Graph) ;

end ;

procedure TFResBesLactE.CBAli2Change(Sender: TObject);

begin

end;

/////////////////

//   Energie   //

/////////////////

procedure TFResBesLactE.InitNRJ ;

const

  TabColor : array[0..1] of TColor

    = (clOlive, clWhite) ;

var

  i : integer ;

begin

  // ListNRJ : liste pour l'?nergie

  ListNRJ := TStringList.Create ;

  ListNRJ.Assign (LBNRJ.Items) ;

  // BarNRJ : s?ries (barres) graphiques

  SetLength (BarNRJ, ListNRJ.Count) ;

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

  begin

    BarNRJ[i] := TBarSeries.Create (Graph) ;

    BarNRJ[i].ParentChart := Graph ;

    BarNRJ[i].Title := ListNRJ[i] ;

    BarNRJ[i].SeriesColor := TabColor[i] ;

    BarNRJ[i].BarPen.Color := BarNRJ[i].SeriesColor ;

    BarNRJ[i].Marks.Visible := FALSE ;

    Graph.AddSeries (BarNRJ[i]) ;

  end ;

end ;

procedure TFResBesLactE.AffGraphNRJ ;

var

  i, j : integer ;

  m : double ;

  // Ordonn?e

  function NRJY : double ;

  begin

    case i of

      0 : // Entretien

        result := FBesLactE.BesEMEntTot[j] ;

      1 : // Lait

        result := FBesLactE.BesEMLaitTot[j] ;

      else

        result := 0 ;

    end ;

  end ;

// AffGraphNRJ

begin

  ResetGraph ;

  Graph.Title.Text.Add (TabNRJ.Caption) ;

  Graph.LeftAxis.Title.Caption := Format ('%s (%s)', [CBNRJ3.Text, CBNRJ4.Text]) ;

  Graph.BottomAxis.Title.Caption := _('Litter');

  // Affichage des barres

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

    BarNRJ[i].Active := TRUE ;

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

    BarNRJ[i].Clear ;

  if (CBNRJ4.ItemIndex = 1)

  then

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

      BarNRJ[i].MultiBar := mbStacked100

  else

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

      BarNRJ[i].MultiBar := mbStacked ;

  for j := 1 to NB_CYCLES do

  begin

    case CBNRJ3.ItemIndex of

      0 : // Energie digestible

        m := FBesLactE.AppEDTot[j] / FBesLactE.AppEMTot[j] ;

      2 : // Energie nette

        m := FBesLactE.AppENTot[j] / FBesLactE.AppEMTot[j] ;

      else

        m := 1 ;

    end ;

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

      BarNRJ[i].AddBar (NRJY * m, Format ('%d', [j]), clTeeColor) ;

  end ;

  AjustEchelle (Graph) ;

end ;

procedure TFResBesLactE.CBNRJ3Change (Sender : TObject) ;

begin

  AffGraphNRJ ;

end ;

procedure TFResBesLactE.CBNRJ4Change (Sender : TObject) ;

begin

  AffGraphNRJ ;

end ;

///////////////////////

//   Acides amin?s   //

///////////////////////

procedure TFResBesLactE.InitAA ;

const

  TabColor : array[0..1] of TColor

    = (clOlive, clWhite) ;

var

  i : integer ;

begin

  // ListAA : liste pour les acides amin?s

  ListAA := TStringList.Create ;

  ListAA.Assign (LBAA.Items) ;

  // BarAA : s?ries (barres) graphiques

  SetLength (BarAA, ListAA.Count) ;

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

  begin

    BarAA[i] := TBarSeries.Create (Graph) ;

    BarAA[i].ParentChart := Graph ;

    BarAA[i].Title := ListAA[i] ;

    BarAA[i].SeriesColor := TabColor[i] ;

    BarAA[i].BarPen.Color := BarAA[i].SeriesColor ;

    BarAA[i].Marks.Visible := FALSE ;

    Graph.AddSeries (BarAA[i]) ;

  end ;

end ;

procedure TFResBesLactE.AffGraphAA ;

var

  h, i, j : integer ;

  // Ordonn?e

  function AAY : double ;

  var

    a : integer ;

    d : double ;

  begin

    case h of

      3 : // met+cys

        a := 13 ;

      7 : // phe+tyr

        a := 14 ;

      else

        a := h ;

    end ;

    // Diviseur

    case CBAA4.ItemIndex of

      0 : // Dur?e

        d := PProfilT.DureeLact ;

      2 : // Aliment

        d := FBesLactE.AppAliTot[j] ;

      else

        d := 1 ;

    end ;

    case i of

      0 : // Entretien

        result := Sum (Slice (FBesLactE.BesAAEnt[j, a], PProfilT.DureeLact)) / d ;

      1 : // Lait

        result := Sum (Slice (FBesLactE.BesAALait[j, a], PProfilT.DureeLact)) / d ;

      else

        result := 0 ;

    end ;

  end ;

// AffGraphAA

begin

  ResetGraph ;

  Graph.Title.Text.Add (TabAA.Caption) ;

  Graph.SubTitle.Text.Add(StrDigestStd);

  Graph.LeftAxis.Title.Caption := Format ('%s (%s)', [CBAA3.Text, CBAA4.Text]) ;

  Graph.BottomAxis.Title.Caption := _('Litter');

  // Affichage des barres

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

    BarAA[i].Active := TRUE ;

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

    BarAA[i].Clear ;

  if (CBAA4.ItemIndex = 1)

  then

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

      BarAA[i].MultiBar := mbStacked100

  else

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

      BarAA[i].MultiBar := mbStacked ;

  h := CBAA3.ItemIndex + 1 ;

  for j := 1 to NB_CYCLES do

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

      BarAA[i].AddBar (AAY, Format ('%d', [j]), clTeeColor) ;

  AjustEchelle (Graph) ;

end ;

procedure TFResBesLactE.CBAA3Change (Sender : TObject) ;

begin

  AffGraphAA ;

end ;

procedure TFResBesLactE.CBAA4Change (Sender : TObject) ;

begin

  AffGraphAA ;

end ;

//////////////////

//   Min?raux   //

//////////////////

procedure TFResBesLactE.InitMin ;

begin

  // BarMin : s?rie (barre) graphique

  BarMin := TBarSeries.Create (Graph) ;

  BarMin.ParentChart := Graph ;

  BarMin.Title := ' ' ;

  BarMin.SeriesColor := clTeal ;

  BarMin.BarPen.Color := BarMin.SeriesColor ;

  BarMin.Marks.Style := smsValue ;

  BarMin.Marks.ArrowLength := 0 ;

  BarMin.Marks.Arrow.Visible := FALSE ;

  BarMin.Marks.Brush.Style := bsClear ;

  BarMin.Marks.Frame.Visible := FALSE ;

  BarMin.Marks.Font.Style := [fsBold] ;

  Graph.AddSeries (BarMin) ;

end ;

procedure TFResBesLactE.AffGraphMin ;

var

  j : integer ;

  // Ordonn?e

  function MinY : double ;

  var

    d : double ;

  begin

    // Diviseur

    case CBMin4.ItemIndex of

      0 : // Dur?e

        d := PProfilT.DureeLact ;

      1 : // Aliment

        d := FBesLactE.AppAliTot[j] ;

      else

        d := 1 ;

    end ;

    case CBMin3.ItemIndex of

      0 : // Phosphore digestible

        result := Sum (Slice (FBesLactE.BesP[j], PProfilT.DureeLact)) / d ;

      1 : // Calcium total

        result := Sum (Slice (FBesLactE.BesCa[j], PProfilT.DureeLact)) / d ;

      else

        result := 0 ;

    end ;

  end ;

// AffGraphMin

begin

  ResetGraph ;

  Graph.Legend.Visible := FALSE ;

  Graph.Title.Text.Add (TSMin.Caption) ;

  Graph.LeftAxis.Title.Caption := Format ('%s (%s)', [CBMin3.Text, CBMin4.Text]) ;

  Graph.BottomAxis.Title.Caption := _('Litter');

  // Affichage de la barre

  BarMin.Active := TRUE ;

  BarMin.Clear ;

  for j := 1 to NB_CYCLES do

    BarMin.AddBar (MinY, Format ('%d', [j]), clTeeColor) ;

  AjustEchelle (Graph) ;

end ;

procedure TFResBesLactE.CBMin3Change(Sender: TObject);

begin

  AffGraphMin ;

end;

procedure TFResBesLactE.CBMin4Change(Sender: TObject);

begin

  AffGraphMin ;

end;

procedure TFResBesLactE.WMSysCommand(var Message: TWMSysCommand);

begin

  if Message.CmdType = SC_MINIMIZE

  then

    Application.Minimize

  else

    inherited;

end;

end.