InraPorc

unit UFInraAfz;

interface

uses

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

  Dialogs, Grids, StdCtrls;

type

  TFInraAfz = class(TForm)

    ODInraAfz: TOpenDialog;

    SGInraAfz: TStringGrid;

    LBInraAfz: TListBox;

    procedure FormShow(Sender: TObject);

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

  private

    { D?clarations priv?es }

  public

    { D?clarations publiques }

  end;

var

  FInraAfz: TFInraAfz;

implementation

{$R *.dfm}

const

  NFicMatInraAfz = 'InraAfz.rec';

  MAX_MP = 50;

type

  CompositionChimique = record

    MS, MM, MO, Lip, MAT, Amidon, Sucres,

    dMO_T, dMO_C, dLip_T, dLip_C, dMAT_T, dMAT_C,

    EB, ED_T, ED_C, EM_T, EM_C, EN_T, EN_C,

    Ca, P, Na, K, Cl, Mg, Cu, Zn, Fe, Mn, S, Se, Co, Mb, I,

    Phytase, ActPhytE, ActPhytM, PdigG, PdigF,

    C6C8C10, C12_0, C14_0, C16_0, C16_1, C18_0, C18_1, C18_2, C18_3, C18_4,

    C20_0, C20_1, C20_4, C20_5, C22_0, C22_1, C22_5, C22_6, C24_0, AGsLip,

    CB, dCB_T, dCB_C, Residu, dResidu_T, dResidu_C,

    NDF, ADF, ADL, Parois: Double;

  end;

  RecMatiere = record

    Num: Integer;

    Nom: string[35];

    Memo: string[255];

    Typ: Integer; 

    CC: CompositionChimique;

    AAtotal, CUDAA: array[0..12] of Double;

  end;

  PRecMatiere = ^RecMatiere;

var

  PMatiere: PRecMatiere;

  ListMatiere: TList;

procedure TFInraAfz.FormShow(Sender: TObject);

var

  i, lig, col: Integer;

  ok: Boolean;

  s: string;

  sep: Char;

  F: TextFile;

  function GetInteger(var I: Integer; var Ch: Char): Boolean;

  var

    S: string;

    Fin: boolean;

  begin

    S := '';

    Read(F, Ch);

    Fin := (Ch = ';') or (Ch = Chr(13)) or (Ch = Chr(26));

    while not Fin do

    begin

      S := S + Ch;

      Read(F, Ch);

      Fin := (Ch = ';') or (Ch = Chr(13)) or (Ch = Chr(26));

    end ;

    S := Trim(S);

    result := TRUE ;

    if Length(S) = 0

    then

      I := 0

    else

      try

        I := StrToInt(S);

      except

        result := FALSE;

      end;

  end;

  function GetDouble(var D: Double; var Ch: Char): Boolean;

  var

    S: string;

    Fin: boolean;

  begin

    S := '';

    Read(F, Ch);

    Fin := (Ch = ';') or (Ch = Chr(13)) or (Ch = Chr(26));

    while not Fin do

    begin

      S := S + Ch;

      Read(F, Ch);

      Fin := (Ch = ';') or (Ch = Chr(13)) or (Ch = Chr(26));

    end ;

    S := Trim(S);

    result := TRUE;

    if Length(S) = 0

    then

      D := 0

    else

      try

        D := StrToFloat(S);

      except

        result := FALSE;

      end;

  end;

  function GetString(var S: string; var Ch: Char): Boolean;

  var

    Fin, Quoted: boolean;

  begin

    S := '';

    Read(F, Ch);

    Fin := (Ch = ';') or (Ch = Chr(13)) or (Ch = Chr(26));

    Quoted := (Ch = '"');

    if Quoted

    then

    begin

      Read(F, Ch);

      Fin := (Ch = Chr(26));

      while not Fin do

      begin

        if (Ch = '"')

        then

        begin

          Read (F, Ch);

          Fin := (Ch <> '"');

          Quoted := not ((Ch = ';') or (Ch = Chr(13)) or (Ch = Chr(26)));

        end;

        if not Fin

        then

        begin

          S := S + Ch;

          Read(F, Ch);

          Fin := (Ch = Chr(26));

        end;

      end;

    end

    else

      while not Fin do

      begin

        S := S + Ch;

        Read(F, Ch);

        Fin := (Ch = ';') or (Ch = Chr(13)) or (Ch = Chr(26));

      end;

    result := not Quoted;

  end;

// FormShow

begin

  ListMatiere := TList.Create;

  SetCurrentDir(ExtractFilePath(Application.ExeName));

  ODInraAfz.InitialDir := GetCurrentDir;

  ODInraAfz.FileName := ChangeFileExt(NFicMatInraAfz, '.csv');

{

  SGInraAfz.ColCount := LBInraAfz.Count;

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

    SGInraAfz.Cells[i, 0] := LBInraAfz.Items[i];

}

  SGInraAfz.Cells[0, 0] := 'N?';

  SGInraAfz.Cells[1, 0] := 'Nom';

  if ODInraAfz.Execute

  then

  begin

    AssignFile(F, ODInraAfz.FileName);

    Reset(F);

    if Eof(F)

    then // Le fichier est vide

    begin

      CloseFile(F);

      Exit;

    end;

    Readln(F, s); // Lecture de la ligne de titre

    if Eof(F)

    then // Il n'y a pas d'enregistrement

    begin

      CloseFile(F);

      Exit;

    end;

    lig := 1;

    col := 1;

    New(PMatiere);

    repeat

      ok := TRUE;

      case col of

        1: // Nom

        begin

          ok := GetString(s, sep);

          if ok then PMatiere.Nom := Trim(s);

        end;

        2: // Commentaire

        begin

          ok := GetString(s, sep);

          if ok then PMatiere.Memo := s;

        end ;

        3: ok := GetInteger(PMatiere.Typ, sep);

        4: ok := GetDouble(PMatiere.CC.MS, sep);

        5: ok := GetDouble(PMatiere.CC.MM, sep);

        6: ok := GetDouble(PMatiere.CC.MO, sep);

        7: ok := GetDouble(PMatiere.CC.Lip, sep);

        8: ok := GetDouble(PMatiere.CC.MAT, sep);

        9: ok := GetDouble(PMatiere.CC.Amidon, sep);

        10: ok := GetDouble(PMatiere.CC.Sucres, sep);

        11: ok := GetDouble(PMatiere.CC.dMO_T, sep);

        12: ok := GetDouble(PMatiere.CC.dMO_C, sep);

        13: ok := GetDouble(PMatiere.CC.dLip_T, sep);

        14: ok := GetDouble(PMatiere.CC.dLip_C, sep);

        15: ok := GetDouble(PMatiere.CC.dMAT_T, sep);

        16: ok := GetDouble(PMatiere.CC.dMAT_C, sep);

        17: ok := GetDouble(PMatiere.CC.EB, sep);

        18: ok := GetDouble(PMatiere.CC.ED_T, sep);

        19: ok := GetDouble(PMatiere.CC.ED_C, sep);

        20: ok := GetDouble(PMatiere.CC.EM_T, sep);

        21: ok := GetDouble(PMatiere.CC.EM_C, sep);

        22: ok := GetDouble(PMatiere.CC.EN_T, sep);

        23: ok := GetDouble(PMatiere.CC.EN_C, sep);

        24: ok := GetDouble(PMatiere.CC.Ca, sep);

        25: ok := GetDouble(PMatiere.CC.P, sep);

        26: ok := GetDouble(PMatiere.CC.Na, sep);

        27: ok := GetDouble(PMatiere.CC.K, sep);

        28: ok := GetDouble(PMatiere.CC.Mg, sep);

        29: ok := GetDouble(PMatiere.CC.Cl, sep);

        30: ok := GetDouble(PMatiere.CC.S, sep);

        31: ok := GetDouble(PMatiere.CC.Cu, sep);

        32: ok := GetDouble(PMatiere.CC.Zn, sep);

        33: ok := GetDouble(PMatiere.CC.Mn, sep);

        34: ok := GetDouble(PMatiere.CC.Fe, sep);

        35: ok := GetDouble(PMatiere.CC.Se, sep);

        36: ok := GetDouble(PMatiere.CC.Co, sep);

        37: ok := GetDouble(PMatiere.CC.Mb, sep);

        38: ok := GetDouble(PMatiere.CC.I, sep);

        39: ok := GetDouble(PMatiere.CC.PdigG, sep);

        40: ok := GetDouble(PMatiere.CC.PdigF, sep);

        41: ok := GetDouble(PMatiere.CC.Phytase, sep);

        42: ok := GetDouble(PMatiere.CC.ActPhytE, sep);

        43: ok := GetDouble(PMatiere.CC.ActPhytM, sep);

        44: ok := GetDouble(PMatiere.CC.C6C8C10, sep);

        45: ok := GetDouble(PMatiere.CC.C12_0, sep);

        46: ok := GetDouble(PMatiere.CC.C14_0, sep);

        47: ok := GetDouble(PMatiere.CC.C16_0, sep);

        48: ok := GetDouble(PMatiere.CC.C16_1, sep);

        49: ok := GetDouble(PMatiere.CC.C18_0, sep);

        50: ok := GetDouble(PMatiere.CC.C18_1, sep);

        51: ok := GetDouble(PMatiere.CC.C18_2, sep);

        52: ok := GetDouble(PMatiere.CC.C18_3, sep);

        53: ok := GetDouble(PMatiere.CC.C18_4, sep);

        54: ok := GetDouble(PMatiere.CC.C20_0, sep);

        55: ok := GetDouble(PMatiere.CC.C20_1, sep);

        56: ok := GetDouble(PMatiere.CC.C20_4, sep);

        57: ok := GetDouble(PMatiere.CC.C20_5, sep);

        58: ok := GetDouble(PMatiere.CC.C22_0, sep);

        59: ok := GetDouble(PMatiere.CC.C22_1, sep);

        60: ok := GetDouble(PMatiere.CC.C22_5, sep);

        61: ok := GetDouble(PMatiere.CC.C22_6, sep);

        62: ok := GetDouble(PMatiere.CC.C24_0, sep);

        63: ok := GetDouble(PMatiere.CC.AGsLip, sep);

        64: ok := GetDouble(PMatiere.CC.CB, sep);

        65: ok := GetDouble(PMatiere.CC.dCB_T, sep);

        66: ok := GetDouble(PMatiere.CC.dCB_C, sep);

        67: ok := GetDouble(PMatiere.CC.Residu, sep);

        68: ok := GetDouble(PMatiere.CC.dResidu_T, sep);

        69: ok := GetDouble(PMatiere.CC.dResidu_C, sep);

        70: ok := GetDouble(PMatiere.CC.NDF, sep);

        71: ok := GetDouble(PMatiere.CC.ADF, sep);

        72: ok := GetDouble(PMatiere.CC.ADL, sep);

        73: ok := GetDouble(PMatiere.CC.Parois, sep);

        74..85: ok := GetDouble(PMatiere.AAtotal[col - 73], sep);

        86..98: ok := GetDouble(PMatiere.CUDAA[col - 86], sep);

      end;

      if not ok then Break;

      if (col = 98) or ((col = 1) and (Length(PMatiere.Nom) = 0))

      then // Dernier champs ou ligne vide

        ok := (sep = Chr(13)) or (sep = Chr(26))

      else

        ok := (sep = ';');

      if not ok then Break;

      if sep = Chr(13) then Read(F, sep); // Chr (10)

      if col = 98

      then // Passage ? la ligne suivante

      begin

        PMatiere.AAtotal[0] := PMatiere.CC.MAT;

        ListMatiere.Add(PMatiere);

        PMatiere.Num := - ListMatiere.Count;

        New(PMatiere);

        Inc(lig);

        col := 1;

      end

      else

        if (col > 1) or (Length(PMatiere.Nom) > 0)

        then // Passage au champs suivant

          Inc(col);

    until sep = Chr(26); // Eof (f)

    Dispose(PMatiere);

    CloseFile(F);

    if not ok

    then // erreur de lecture

      MessageDlg(Format('Erreur ! (%d, %d)', [col, lig]), mtError, [mbOk], 0)

    else // affichage du tableau

    begin

      SGInraAfz.RowCount := ListMatiere.Count + 2;

      for i := 1 to ListMatiere.Count do

      begin

        PMatiere := ListMatiere.Items[i - 1];

        SGInraAfz.Cells[0, i] := IntToStr(PMatiere.Num);

        SGInraAfz.Cells[1, i] := PMatiere.Nom;

      end;

    end;

  end;

end;

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

var

  i: Integer;

  fic: file of RecMatiere;

begin

  if SGInraAfz.RowCount > 2

  then // Enregistrement(s) pr?sent(s)

    if MessageDlg('Enregistrer ?', mtWarning, [mbYes, mbNo], 0) = mrYes

    then // Sauvegarder

    begin

      AssignFile(fic, NFicMatInraAfz);

      Rewrite(fic);

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

      begin

        PMatiere := ListMatiere[i];

        Write(fic, PMatiere^);

      end ;

      CloseFile(fic);

    end;

  if ListMatiere.Count > 0

  then

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

    begin

      PMatiere := ListMatiere[i];

      Dispose(PMatiere);

    end;

  ListMatiere.Free;

end;

end.