InraPorc

unit UFObservProfilP;

interface

uses

  Windows, Forms, Classes, Controls, Messages, Dialogs, StdCtrls, Buttons,

  DB, Grids, DBGrids, JvEnterTab, JvExControls, JvCsvData;

type

  TFObservProfilP = class(TForm)

    BBOk: TBitBtn;

    BBCancel: TBitBtn;

    DataSourceObservProfilP: TDataSource;

    DBGridObserv: TDBGrid;

    SBAddLine: TSpeedButton;

    SBDelLine: TSpeedButton;

    SBImport: TSpeedButton;

    JvEnterAsTab1: TJvEnterAsTab;

    MErrors: TMemo;

    JvCsvDataSetImport: TJvCsvDataSet;

    OpenDialogImport: TOpenDialog;

    procedure FormShow(Sender: TObject);

    procedure FormCreate(Sender: TObject);

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

    procedure SBAddLineClick(Sender: TObject);

    procedure SBDelLineClick(Sender: TObject);

    procedure SBImportClick(Sender: TObject);

    procedure DBGridObservKeyDown(Sender: TObject; var Key: Word;

      Shift: TShiftState);

    procedure FormDestroy(Sender: TObject);

  private

    { D?clarations priv?es }

    DBGridOldWndProc: TWndMethod;

    Procedure DBGridNewWndProc(var Mess: TMessage);

  public

    { D?clarations publiques }

  end;

var

  FObservProfilP: TFObservProfilP;

implementation

uses

  SysUtils, gnugettext, UVariables, UFProfilP;

{$R *.dfm}

{ TFObservProfilP }

procedure TFObservProfilP.DBGridNewWndProc(var Mess: TMessage);

begin

  if Mess.Msg = WM_MOUSEWHEEL

  then // Interception de l'?v?nement WM_MOUSEWHEEL

    with FProfilP.ASQLite3TableObservProfilP do

      if SmallInt(Mess.WParamHi) < 0

      then

        Next

      else

        Prior

  else // Traitement des autres messages

    DBGridOldWndProc(Mess);

end;

procedure TFObservProfilP.DBGridObservKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin

  if DBGridObserv.DataSource.DataSet.CanModify

  then

    case Key of

      VK_DOWN:

        with FProfilP.ASQLite3TableObservProfilP do

          if FieldByName('Line').AsInteger = RecordCount

          then

            Key := 0;

      VK_TAB:

        with FProfilP.ASQLite3TableObservProfilP do

          if (FieldByName('Line').AsInteger = RecordCount)

          and (DBGridObserv.SelectedField = FieldByName('Lean'))

          then

            Key := 0;

      VK_INSERT:

        Key := 0;

      VK_DELETE:

        if Shift = [ssCtrl]

        then

          Key := 0;

    end;

end;

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

var

  AgePrec: Integer;

  FeedPrec: Double;

  FeedCount, WeightCount: Integer;

begin

  if ModalResult = mrOk

  then // V?rifier la coh?rence des donn?es

    with FProfilP.ASQLite3TableObservProfilP do

    begin

      MErrors.Lines.Clear;

      First;

      if (FieldByName('Age').AsInteger <= FProfilP.PBAgeInit.MinValue) or (FieldByName('Age').AsInteger >= FProfilP.PBAgeInit.MaxValue)

      then

        MErrors.Lines.Add(Format(_('Line %d: '), [FieldByName('Line').AsInteger])

          + Format(_('The initial age should be between %d and %d days.'), [FProfilP.PBAgeInit.MinValue, FProfilP.PBAgeInit.MaxValue]));

      if FieldByName('Feed').AsFloat <> 0

      then

        MErrors.Lines.Add(Format(_('Line %d: '), [FieldByName('Line').AsInteger])

          + _('The initial cumulative feed usage should be equal to zero.'));

      if (FieldByName('Weight').AsFloat <= FProfilP.PBPVInit.MinValue) or (FieldByName('Weight').AsFloat >= FProfilP.PBPVInit.MaxValue)

      then

        MErrors.Lines.Add(Format(_('Line %d: '), [FieldByName('Line').AsInteger])

          + Format(_('The initial body weight should be between %1.1f and %1.1f kg.'), [FProfilP.PBPVInit.MinValue, FProfilP.PBPVInit.MaxValue]));

      FeedCount := 1;

      WeightCount :=1;

      AgePrec := FieldByName('Age').AsInteger;

      FeedPrec := FieldByName('Feed').AsFloat;

      Next;

      while not Eof do

      begin

        if FieldByName('Age').IsNull

        then

          MErrors.Lines.Add(Format(_('Line %d: '), [FieldByName('Line').AsInteger])

            + ('The age should be given for each line.'))

        else

        begin

          if FieldByName('Age').AsInteger <= AgePrec

          then

            MErrors.Lines.Add(Format(_('Line %d: '), [FieldByName('Line').AsInteger])

              + _('The age should be given in ascending order.'));

          AgePrec := FieldByName('Age').AsInteger;

        end;

        if not FieldByName('Feed').IsNull

        then

        begin

          if FieldByName('Feed').AsFloat < FeedPrec

          then

            MErrors.Lines.Add(Format(_('Line %d: '), [FieldByName('Line').AsInteger])

              + _('The cumulative feed usage cannot decrease.'));

          Inc(FeedCount);

          FeedPrec := FieldByName('Feed').AsFloat;

        end;

        if not FieldByName('Weight').IsNull

        then

          Inc(WeightCount);

        Next;

      end;

      if FeedCount < 3

      then

        MErrors.Lines.Add(_('At least three measurements of cumulative feed usage should be given.'));

      if WeightCount < 3

      then

        MErrors.Lines.Add(_('At least three measurements of body weight should be given.'));

      if MErrors.Lines.Count > 0

      then

        Action := caNone;

    end;

end;

procedure TFObservProfilP.FormCreate(Sender: TObject);

begin

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

  then

    Font.Name := 'Arial Unicode MS';

  TranslateComponent(Self);

  DBGridOldWndProc := DBGridObserv.WindowProc;

  DBGridObserv.WindowProc := DBGridNewWndProc;

end;

procedure TFObservProfilP.FormDestroy(Sender: TObject);

begin

  DBGridObserv.WindowProc := DBGridOldWndProc;

end;

procedure TFObservProfilP.FormShow(Sender : TObject);

begin

  with FProfilP.ASQLite3TableObservProfilP do

    if IsEmpty

    then // Initialisation avec ?tat initial et ?tat final

    begin

      Append;

      FieldByName('Profile').AsInteger := PProfilP.Num;

      FieldByName('Line').AsInteger := 1;

      FieldByName('Age').AsInteger := PProfilP.AgeInit;

      FieldByName('Feed').AsFloat := 0;

      FieldByName('Weight').AsFloat := PProfilP.PVInit;

      Post;

      Append;

      FieldByName('Profile').AsInteger := PProfilP.Num;

      FieldByName('Line').AsInteger := 3;

      if PProfilP.ModeFin = 0

      then // Dur?e

        FieldByName('Age').AsInteger := PProfilP.AgeInit + PProfilP.Duree

      else // poids vif

        FieldByName('Weight').AsFloat := PProfilP.PVFin;

      Post;

      Insert;

      FieldByName('Profile').AsInteger := PProfilP.Num;

      FieldByName('Line').AsInteger := 2;

      Post;

    end;

end;

procedure TFObservProfilP.SBAddLineClick(Sender: TObject);

var

  i: integer;

begin

  with FProfilP.ASQLite3TableObservProfilP do

    if FieldByName('Line').AsInteger > 1

    then

    begin

      i := FieldByName('Line').AsInteger;

      DisableControls;

      try

        Last;

        repeat

          Edit;

          FieldByName('Line').AsInteger := FieldByName('Line').AsInteger + 1;

          Post;

          Prior;

        until FieldByName('Line').AsInteger < i;

        Next;

        Insert;

        FieldByName('Profile').AsInteger := PProfilP.Num;

        FieldByName('Line').AsInteger := i;

        Post;

      finally

        EnableControls;

        ActiveControl := DBGridObserv;

        DBGridObserv.SelectedField := FieldByName('Age');

      end;

    end

    else

      Beep;

end;

procedure TFObservProfilP.SBDelLineClick(Sender: TObject);

var

  i: integer;

begin

  with FProfilP.ASQLite3TableObservProfilP do

    if (FieldByName('Line').AsInteger > 1) and (FieldByName('Line').AsInteger < RecordCount)

    then

    begin

      i := FieldByName('Line').AsInteger;

      DisableControls;

      try

        Last;

        while FieldByName('Line').AsInteger > i do

        begin

          Edit;

          FieldByName('Line').AsInteger := FieldByName('Line').AsInteger - 1;

          Post;

          Prior;

        end;

        Delete;

      finally

        EnableControls;

        ActiveControl := DBGridObserv;

        DBGridObserv.SelectedField := FieldByName('Age');

      end;

    end

    else

      Beep;

end;

procedure TFObservProfilP.SBImportClick(Sender: TObject);

var

  CurrentFormatSettings: TFormatSettings;

begin

  OpenDialogImport.InitialDir := GetCurrentDir;

  if not OpenDialogImport.Execute

  then // Annulation

    Exit;

  GetLocaleFormatSettings(GetUserDefaultLCID, CurrentFormatSettings);

  JvCsvDataSetImport.Separator := CurrentFormatSettings.ListSeparator;

  JvCsvDataSetImport.FileName := OpenDialogImport.FileName;

  try

    JvCsvDataSetImport.Active := True;

    try

      if JvCsvDataSetImport.FieldCount < 3

      then

      begin

        MessageDlg(_('File must contain at least 3 columns'), mtError, [mbOK], 0);

        Exit;

      end;

      // Suppression des lignes vides

      JvCsvDataSetImport.First;

      while not JvCsvDataSetImport.Eof do

      begin

        if JvCsvDataSetImport.Fields[0].IsNull

        and JvCsvDataSetImport.Fields[1].IsNull

        and JvCsvDataSetImport.Fields[2].IsNull

        and ((JvCsvDataSetImport.FieldCount < 4) or JvCsvDataSetImport.Fields[3].IsNull)

        and ((JvCsvDataSetImport.FieldCount < 4) or JvCsvDataSetImport.Fields[4].IsNull)

        then

          JvCsvDataSetImport.Delete

        else

          JvCsvDataSetImport.Next;

      end;

      if JvCsvDataSetImport.RecordCount < 2

      then

      begin

        MessageDlg(_('File must contain at least 2 lines'), mtError, [mbOK], 0);

        Exit;

      end;

      with FProfilP.ASQLite3TableObservProfilP do

      begin

        DisableControls;

        try

          First;

          while not Eof do

            Delete;

          JvCsvDataSetImport.First;

          while not JvCsvDataSetImport.Eof do

          begin

            Append;

            FieldByName('Profile').AsInteger := PProfilP.Num;

            FieldByName('Line').AsInteger := JvCsvDataSetImport.RecNo + 1;

            if not JvCsvDataSetImport.Fields[0].IsNull

            then

              FieldByName('Age').AsInteger := JvCsvDataSetImport.Fields[0].AsInteger;

            if not JvCsvDataSetImport.Fields[1].IsNull

            then

              FieldByName('Feed').AsFloat := JvCsvDataSetImport.Fields[1].AsFloat;

            if not JvCsvDataSetImport.Fields[2].IsNull

            then

              FieldByName('Weight').AsFloat := JvCsvDataSetImport.Fields[2].AsFloat;

            if (JvCsvDataSetImport.FieldCount > 3) and not JvCsvDataSetImport.Fields[3].IsNull

            then

              FieldByName('Backfat').AsFloat := JvCsvDataSetImport.Fields[3].AsFloat;

            if (JvCsvDataSetImport.FieldCount > 4) and not JvCsvDataSetImport.Fields[4].IsNull

            then

              FieldByName('Lean').AsFloat := JvCsvDataSetImport.Fields[4].AsFloat;

            Post;

            JvCsvDataSetImport.Next;

          end;

        finally

          EnableControls;

          ActiveControl := DBGridObserv;

          DBGridObserv.SelectedField := FieldByName('Age');

        end;

      end;

    finally

      JvCsvDataSetImport.Active := False;

    end;

  except

    MessageDlg(_('Invalid file format'), mtError, [mbOK], 0);

//    HtmlHelp(Handle, PChar(Application.CurrentHelpFile), HH_HELP_CONTEXT, 5350);

    Application.HelpContext(5350);

  end;

end;

end.