unit regutil;

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
{$IFnDEF FPC}
  Windows,
{$ELSE}
  LCLIntf, LCLType, LMessages,
{$ENDIF}
  SysUtils, Classes, Dialogs, Mouse,
  laz2_DOM, laz2_XMLRead, laz2_XMLWrite, laz2_XMLUtils,
  Graphics, printers, controls, grids, clipBrd, forms,
  Math, StdCtrls, comctrls, constreg, maths, SysInfoCtrls;

var
  fichier : textFile;
  finFichierWin : boolean;
  autoIncrementation : boolean;
  ligneWin,userName : string;
  mesDocsDir : string;
  ModifFichier : boolean;
  TexteModele : TstringList;
  nomFichierIni : string;

// Les caractères au-delà de 7 bits sont différents selon l'encodage...
// £ encodé en UTF-8 donne (194)(163) ce qui, lu en latin-1, fait Â£.
// &                            (167)

const
        longNombre = 10;
        IntervalleSauvegarde = 1/(24*6); // 1 jour=1 donc 10 minutes
        HautGrapheTxt = 0.32; { Hauteur graphe avec texte }
        HautGrapheGr = 0.43; { Hauteur graphe seul }
        HautGraphePaysage = 0.90; { Hauteur graphe seul pleine page }
        MargeImprimante = 21;
        MargeImprimantePaysage = 30; // soit 1 cm
        PrecisionMin = 3;
        PrecisionMax = 15; // Precision double pour FloatToStrF
        PrecisionMaxIncert = 6; // Precision double pour FloatToStrF
        PrecisionFichier = 15;
        LongNom = 32;
        SymbReg : char = #163;
        SymbReg2 : char = '&';
        DetectUnicode = #194;

        UneHeure = 3600; // secondes
        UnJour = 24*UneHeure;
        UnMois = UnJour*365.25/12;
        QuartdHeure = 15*60;
        UneMinute = 60;

        UneHeureWin = 1/24; { 1 jour = 1.000 }
        QuartdHeureWin = 1/(24*4);
        UneMinuteWin = 1/(24*60);
        UneSecondeWin = 1/(24*60*60);
        UnMoisWin = 365.25/12;
        unAnWin = 365.25;

        WM_Reg_Maj = WM_USER + 0;
        WM_Reg_Calcul = WM_USER + 1;
        WM_Reg_Origine = WM_USER + 2;
        WM_Reg_Fichier = WM_USER + 3;
        WM_Reg_InitMagnum = WM_USER + 4;
        WM_Reg_Modele = WM_USER + 5;
        WM_Reg_Paint = WM_USER + 6;

{
    protected
    procedure WMRegMaj(var Message: TWMRegMAj); message WM_reg_Maj;

    procedure TMyComponent.WMRegMaj(var Message: TWMRegMaj);
    begin
       ...
      inherited;
    end;
}

        MajModele = 0; { modification de l'expresssion du modèle }
        MajGrandeur = 1; { modification de l'expression des grandeurs }
        MajValeur = 2;{ modification des valeurs expérimentales dans tableur }
        MajFichier = 3; { général après chargement de fichier ... }
        MajChangePage = 4; { changement de page }
        MajAjoutPage = 5; { ajout de page }
        MajSupprPage = 6; { suppression de page }
        MajVide = 7; { nettoyage }
        MajFFT = 8; { options Fenêtre et période }
        MajTri = 9; { modif de l'ordre }
        MajIncertitude = 12;
        MajPolice = 10;
        MajSuperposition = 13;
        MajNumeroMesure = 14;
        MajUnites = 15;
        MajValeurAcq = 16;{ modification des valeurs expérimentales par acquisition }
        MajLangue = 17;
        MajModeleGlb = 18;{ modification du modèle des paramètres }
        MajUnitesParam = 19;
        MajSupprPoints = 20;
        MajNom = 22; { Modif d'un nom }
        MajAjoutValeur = 23; { ajout d'un point en mode clavier }
        MajSelectPage = 24; { changement de sélection des pages }
        MajPreferences = 25; { préférences de couleurs ... }
        MajGroupePage = 26; { groupement de pages }
        MajOptionsGraphe = 27; { groupement de pages }
        MajValeurGr = 28;{ modification des valeurs expérimentales dans le graphe }
        MajSauvePage = 29; { avant de changer de page }
        MajValeurConst = 30;{ modification des valeurs des paramètres dans tableur }

        CalculCompile = 1;
        CalculRemplit = 2;
        CalculAjuste = 3;
        CalculModele = 4;

        alphaMin='α';//UnicodeChar($03B1);
        betaMin='β';//unicodeChar($03B2);
        gammaMin='γ';//unicodeChar($03B3);
        gammaMaj='Γ';//unicodeChar($0393);
        deltaMin='δ';//unicodeChar($03B4);
        deltaMaj= 'Δ';//unicodeChar($0394);
        chiMin='χ';//unicodeChar($03C7);
        epsilonMin='ε';//unicodeChar($03B5);
        upsilonMin='υ';//unicodeChar($03C5);
        iotaMin='ι';//unicodeChar($03B9);
        phiMin='φ';//unicodeChar($03C6);
        phiMaj='Φ';//unicodeChar($03A6);
        etaMin='η';//unicodeChar($03B7);
        lambdaMaj='Λ';//unicodeChar($039B);
        lambdaMin='λ';//unicodeChar($03BB);
        nuMin='ν';//unicodeChar($03BD);
        xiMaj='Ξ';//unicodeChar($039E);
        xiMin='ξ';//unicodeChar($03BE);
        piMin='π';//unicodeChar($03C0);
        piMaj='Π';//unicodeChar($03A0);
        thetaMaj='Θ';//unicodeChar($0398);
        thetaMin='θ';//unicodeChar($03B8);
        rhoMin='ρ';//unicodeChar($03C1);
        sigmaMin='σ';//unicodeChar($03C3);
        sigmaMaj='Σ';//unicodeChar($03A3);
        tauMin='τ';//unicodeChar($03C4);
        omegaMin='ω';//unicodeChar($03C9);
        omegaMaj='u';//nicodeChar($03A9);
        psiMin='ψ';//unicodeChar($03C8);
        psiMaj='Ξ';//unicodeChar($03A8);
        zetaMin='ζ';//unicodeChar($03B6);
        muMin='μ';//unicodeChar($03BC);
        kappaMin='κ';//unicodeChar($03BA);
        cdot ='⋅';//unicodeChar($22C5);
        pointMedian='·';//unicodeChar($00B7);
        puce ='∙';//unicodeChar($2219);
        SymbRegUnicode=unicodeChar(163);


        ChiffreExp : array[0..9] of string =
  ('⁰','ⁱ','²','³','⁴','⁵','⁶','⁷','⁸','⁹');
        // 2070,     , 2074, 2075, 2076, 2077,2078, 2079
        ChiffreInd : array[0..9] of string =
  ('⁰','ⁱ','²','³','⁴','⁵','⁶','⁷','⁸','⁹');
     //  2080, ... 2089
        supEgal = '≥';//unicodeChar($2265);
        infEgal = '≤';//unicodeChar($2264);

        RepereConst = 'Cte:';
        SeparateurConst =  '________________';

type
    Tincertitude = (iEllipse,iCroix,iRectangle);
    TAffIncertParam = (iType,i95,iBoth);
    EGetFloatError = class(Exception);
    EIncertitudeError = class(Exception);

    TgrapheClipBoard = (gcJpeg,gcBitmap,gcPng);
    TformeActive = (mainActif,grapheActif,statActif,texteActif,FFTactif);
    TnombreFormat = (fDefaut,fExponent,fFixed,fIngenieur,fBinary,fHexa,
       fLongueDuree,fDateTime,fDate,fTime,fDegreMinute);
    TligneRappel = (lrEquivalence,lrTangente,lrXdeY,lrReticule,lrX,lrY,lrPente);
    Tgraduation = (gLin,gLog,gInv,gdB);
    ChaineAzt = array[0..512] of char;
    vecteurNombre = array[0..16] of double;

    TWMRegMessage = record
       Msg: Uint;
       case Integer of
          0: (WParam: WParam;LParam: LParam;Result: LResult);
          1: (TypeMaJ: WParam;CodeMaj : LParam;ResultR: LResult);
    end;

    TPrinterRecord = record
        Cur: TPoint;
        MargeTexte : integer;
        Finish: TPoint;  { End of the printable area }
        Height: Integer; { Height of the current line }
        sauveOrientation : TprinterOrientation;
        PageH,PageW : integer;
    end;

        CoefUnite = (zero,yocto,zepto,atto,femto,pico,nano,micro,milli,
               nulle,kilo,mega,giga,tera,peta,exa,zetta,yotta,infini);
        TmodeAcquisition = (AcqClavier,AcqFichier,AcqCan,AcqClipBoard,
                            AcqSimulation,AcqCourbes);

   // TFileSearch: small class around FindFirst and FindNext to make the search easier
   TFileSearch = class (TComponent)
   private
      Opened: Boolean;
      Path: String;
      SearchRec: TSearchRec;
   public
      constructor Create (AOwner: TComponent); override;
      function FirstFile (SearchPath: string; FileKind: string): string;
      function NextFile: string;
      procedure Close;
      destructor Destroy; override;
   end;

const
        couleurCalc = clGrayText;
        crSupprArr = char(vk_back);
        crHaut = char(vk_up);
        crBas = char(vk_down);
        crGauche = char(vk_left);
        crDroite = char(vk_right);
        crHome = char(vk_home);
        crEnd = char(vk_end);
        crCR = #13;
        crLF = #10;
        crESC = #27;
        crTab = char(vk_tab);
        Separateur : tSysCharSet = [' ',crTab,',',';'];
        NomModeAcq : array[TmodeAcquisition] of string =
            ('CLAVIER','FICHIER','EXTERNE','PRESSE-PAPIER',
             'SIMULATION','COURBES');
        Majuscule   : tSysCharSet = ['A'..'Z'];
        Minuscule   : tSysCharSet = ['a'..'z'];
        Grecque = alphaMin+betaMin+gammaMin+gammaMaj+deltaMin+deltaMaj+
              epsilonMin+chiMin+zetaMin+etaMin+thetaMin+thetaMaj+kappaMin+
              lambdaMin+lambdaMaj+muMin+nuMin+xiMin+xiMaj+
              piMin+piMaj+rhoMin+sigmaMin+sigmaMaj+tauMin+
              phiMin+phiMaj+chiMin+psiMin+psiMaj+omegaMin+omegaMaj;
        LettreAccent = 'éèêëàâùïüô';

        Chiffre     : tSysCharSet = ['0'..'9'];
        ChiffreEtc : tSysCharSet = ['0'..'9','+','-','e','E','.'];
        ChiffreWin : tSysCharSet = ['0'..'9','+','-','e','E','.',','];
        CaracNombre : tSysCharSet = ['0'..'9','+','-','e','E','.',',','/',':'];
        CaracDateTime : tSysCharSet = ['0'..'9','/',':',' ',crSupprArr,crTab,crCR];
        CaracDate : tSysCharSet = ['0'..'9','/',crSupprArr,crTab,crCR];
        CaracTime : tSysCharSet = ['0'..'9',':',crSupprArr,crTab,crCR];
        CaracDegre : tSysCharSet = ['0'..'9','+','-',':',#158,'''','"',crSupprArr,crTab,crCR];
        CharGetFloat : tSysCharSet = ['0'..'9','+','-','e','E','.',',','*','/','^',
            'P','p','I','i','m','n','f','k','M','G','T',
            '(',')',crSupprArr,crTab,crCR];
        CharGetInt : tSysCharSet = ['0'..'9',crGauche,crDroite,crSupprArr,crTab,crCR];
        ChiffrePuiss = unicodeChar($2070)+unicodeChar($00B9)+unicodeChar($00B2)+
               unicodeChar($00B3)+unicodeChar($2074)+unicodeChar($2075)+unicodeChar($2076)+
               unicodeChar($2077)+unicodeChar($2078)+unicodeChar($2079);

        NChiffreSignif = 5;
        caracPrefixe = 'yzafpnmμkMGTPEZY';
        prefixeUnite : array[coefUnite] of string =
              ('0','y','z','a','f','p','n','μ','m',
               ' ','k','M','G','T','P','E','Z','Y','i');
        valUnite : array[coefUnite] of double =
              (1E-27,1E-24,1E-21,1E-18,1E-15,1E-12,1E-9,1E-6,1E-3,
               1,1E+3,1E+6,1E+9,1E+12,1E+15,1E+18,1E+21,1E+24,1E+27);
        expUnite : array[coefUnite] of string =
              ('E-27','E-24','E-21','E-18','E-15','E-12','E-9','E-6','E-3',
                '','E+3','E+6','E+9','E+12','E+15','E+18','E+21','E+24','E+27');
        puissanceUnite : array[coefUnite] of shortInt =
              (-27,-24,-21,-18,-15,-12,-9,-6,-3,
                0,+3,+6,+9,+12,+15,+18,+21,+24,+27);
        NomLigneRappel : array[TligneRappel] of string =
            ('Equivalences','Tangentes','Valeurs du modèle','Réticules','Delta X','Delta Y','Pente');

var
        fontName : string = 'DejaVu Sans';
        AffIncertParam : TAffIncertParam = i95;
        FontSizeMemo : integer = 12;
        grapheClip : TgrapheClipBoard;
        TexteGrapheSize : integer = 5;
        RappelTroisGraphes : boolean = true;
        CoeffEllipse : double = 1.0;
        ModeleFacteurQualite : boolean = true; // sinon facteur d'amortissement Q=1/2m
        ModeleDecibel : boolean = false;
        FichierTrie : boolean = false;
        DataTrieGlb : boolean = false;
        Recuit : boolean = false;
        recuitFaible : boolean = true;
        modeleCosinus : boolean = true;
        VisualisationAjustement : boolean = false;        

        GridPrint : boolean = false;
        StoechBecherGlb : integer = 1;
        StoechBuretteGlb : integer = 1;
        OrdreBruit : integer = 3;
        DataCanModifiable : boolean = false;
        withCoeffCorrel : boolean = true;
        withPvaleur : boolean = false;
        withBandeConfiance : boolean = false;
        avecModeleManuel : boolean = true;
        ajusteOrigine : boolean = false;
        PrecisionCorrel : integer = 5;
        LevenbergMarquardt : boolean = false;
        couleurIncertitude : Tcolor = clBlue;
        couleurNonExp : Tcolor = clGray;
        couleurExp : Tcolor = clBlack;
        ChercheUniteParam : boolean = true;
        avecTableau : boolean = true;
        uniteParenthese : boolean = false;
        TraceIncert : Tincertitude = iEllipse;
        ClavierAvecGraphe : boolean = true;
        modelePourCent : boolean = false;
        modeAcquisition : TModeAcquisition = AcqClavier;

Function OKReg(const strOk : string;const helpCtx : LongInt) : boolean;
Function OKformat(const strOk : string;args : array of const) : boolean;
Procedure afficheErreur(const strErreur : string;const HelpCtx : LongInt);
Procedure Validatedouble(Sender : Tedit;var z : double);
Function ToucheValidation(key : word) : boolean;
Procedure VerifKeyGetFloat(var key : char);
Procedure VerifKeyGetInt(var key : char);
Procedure TrimComplet(var S : string);
Procedure TrimAscii127(var S : string);
Function Pad(S : string;Len : integer) : string;
Function ConvertitChaine(nombre : string;var valeur : double) : boolean;
Procedure ConvertitPrefixe(var nombre : string);
Function FormatIncert(const nombre : double) : string;
Function FormatGeneral(const nombre : double;const Nchiffres : integer) : string;
Function FormatIngenieur(Nombre : double;PrecisionU : integer) : string;
Function FormatRadian(nombre : double) : string;
Function FormatReg(const nombre : double) : string;
Function FormatCourt(const nombre : double) : string;
Function FormatLongueDureeAxe(const nombre : double) : string;
Function ChainePrec(const prec : double) : string;
function litLigneWin : string;
function EnTeteRW3 : boolean;
function litBooleanWin : boolean;
procedure ecritChaineRW3(s : String);
procedure readLnNombreWin(var z : double);
procedure extraitNombre(const chaine : string;var valeur : vecteurNombre);
Function NbreLigneWin(const s : String) : LongInt;
Function PuissToStr(const puiss : integer) : string;
Function IsLigneComment(const ligneCourante : String) : boolean;
Function FloatToStrPoint(const valeur : double) : string;
Function StrToFloatWin(nombre : String) : double;
Function StrToFloatSex(degStr,minStr,secStr : string) : double;
Function EncodeDuree(duree : LongInt) : TdateTime;
Function DureeEcoulee(const InstantDebut : TdateTime) : double;
Function existeOption(opt : char;const defaut : boolean) : boolean;
Function CaracToChiffre(carac : char) : integer;
Function GetFloat(Nombre : string) : double;
Function GetFloatDate(Nombre : string;Aformat : TnombreFormat) : double;
Function LigneDeChiffres(const s : String) : boolean;
function HeightLinePrinter : Word;
Procedure ImprimerGrid(g : TstringGrid;var debut : integer);
Procedure VerifOrpheline(count : integer;var debut : integer);
Procedure DebutImpressionTexte(var haut : integer);
Function FinImpressionTexte : integer;
Procedure DebutImpressionGr(Orientation : TprinterOrientation;var bas : integer);
Procedure FinImpressionGr;
Procedure NewLine;
Procedure ImprimerLigne(const TextStr : String;var debut : integer);
function valeur125(valInt : integer;down : boolean) : integer;
function getNomCoord(nom : string) : string;
procedure AffecteStatusPanel(var Astatus : TstatusBar;i : integer;Atext : string);
procedure VideStatusPanel(var Astatus : TstatusBar;i : integer);
Procedure AddBackSlash(var aPath : String);
Function isCaracGrandeur(carac : char) : boolean;
Function isLettre(carac : char) : boolean;
function litColor(couleurDefaut : TColor) : Tcolor;
function TailleFichier(const nomFichier : string) : Int64;
procedure getCursorPos(var P : TPoint);
procedure setCursorPos(P : TPoint);

function writeStringXML(ANode : TDOMNOde;Nom,valeur : string) : TDOMNODE;
procedure writePageXML(ANode : TDOMNOde;p : integer);
procedure writeIndexXML(ANode : TDOMNOde;p : integer);
procedure writeNomXML(ANode : TDOMNOde;anom : string);
function writeIntegerXML(ANode : TDOMNOde;Nom : string;valeur : integer) : TDOMNOde;
function writeBoolXML(ANode : TDOMNOde;Nom : string;valeur : boolean) : TDOMNode;
procedure writeDateTimeXML(ANode : TDOMNOde;Nom : string;valeur : TDateTime);
function writeFloatXML(ANode : TDOMNOde;Nom : string;valeur : double) : TDOMNode;
function addChildXML(ANode : TDOMNOde;Nom : string) : TDOMNode;

Function GetIntegerXML(XMLNode : TDOMNOde) : integer;
function GetNodeAttributesAsString(XMLNode : TDOMNOde;genre: string):string;
Function GetIntegerAttribute(XMLNode : TDOMNOde;genre : string) : integer;
Function GetIndexXML(XMLNOde : TDOMNOde): integer;
Function GetNomXML(XMLNOde : TDOMNOde): string;
Function GetPageXML(XMLNOde : TDOMNOde): integer;
Function GetBoolXML(XMLNode : TDOMNOde) : boolean;
Function GetFloatXML(XMLNode : TDOMNOde) : double;

var
     precision : integer;
     erreurDetectee : boolean;
     avecOptionsXY : boolean;
     LigneRappelCourante : TligneRappel;
     LigneRappelTangente : TligneRappel;
     avecEllipse,avecChi2,ReticuleComplet,PermuteColRow : boolean;
     FontSizeImpr : integer;
     GraduationPi : boolean;
     LectureFichier,LecturePage : boolean;
     PrinterParam : TprinterRecord;
     XmlDoc: TXMLDocument;


implementation

Function GetIntegerXML(XMLNode : TDOMNOde) : integer;
var s : string;
begin
     s := XMLNode.NodeValue;
     result := StrToInt(s);
end;

  function GetNodeAttributesAsString(XMLNode : TDOMNOde;genre: string):string;
  var i: integer;
  begin
    Result:='';
    if XMLNode.HasAttributes then
      for i := 0 to XMLNode.Attributes.Length -1 do
        with XMLNode.Attributes[i] do
            if  (NodeName=genre) then begin
                 result := NodeValue;
                 break;
            end;
  end;

Function GetIntegerAttribute(XMLNode : TDOMNOde;genre : string) : integer;
var s : string;
begin
     try
     s := GetNodeAttributesAsString(XMLNode,genre);
     result := StrToInt(s);
     except
        result := 0;
     end;
end;

Function GetIndexXML(XMLNOde : TDOMNOde): integer;
begin
    result := GetIntegerAttribute(XMLNode,'Index')
end;

Function GetNomXML(XMLNOde : TDOMNOde): string;
begin
    result := GetNodeAttributesAsString(XMLNode,'Nom')
end;

Function GetPageXML(XMLNOde : TDOMNOde): integer;
begin
    result := GetIntegerAttribute(XMLNode,'Page')
end;

Function GetBoolXML(XMLNode : TDOMNOde) : boolean;
var s : string;
begin
     s := XMLNode.NodeValue;
     result := s<>'0';
end;

Function GetFloatXML(XMLNode : TDOMNOde) : double;
var s : string;
begin
     s := XMLNode.NodeValue;
     result := StrToFloatWin(s);
end;


function addChildXML(ANode : TDOMNOde;Nom : string) : TDOMNode;
var newNode : TDOMNode;
begin
   NewNode := XMLDoc.createElement(Nom);
//   newNode := XMLDoc.CreateTextNode(Nom);
   ANode.AppendChild(newNode);
   result := newNode;
end;

function writeStringXML(ANode : TDOMNOde;Nom,valeur : string) : TDOMNODE;
var newNode : TDOMNode;
begin
    newNode := AddChildXML(ANode,Nom);
    newNode.AppendChild(XMLDoc.CreateTextNode(valeur));
    result := newNode;
end;

function writeIntegerXML(ANode : TDOMNOde;Nom : string;valeur : integer) : TDOMNOde;
var newNode : TDOMNode;
begin
    newNode := AddChildXML(ANode,Nom);
    newNode.AppendChild(XMLDoc.CreateTextNode(intToStr(valeur)));
    result := NewNode;
end;

function writeBoolXML(ANode : TDOMNOde;Nom : string;valeur : boolean) : TDOMNode;
var newNode : TDOMNode;
begin
    newNode := AddChildXML(ANode,Nom);
    newNode.AppendChild(XMLDoc.CreateTextNode(intToStr(ord(valeur))));
    result := newNode;
end;

procedure writeDateTimeXML(ANode : TDOMNOde;Nom : string;valeur : TDateTime);
var newNode : TDomNode;
begin
    newNode := AddChildXML(ANODE,Nom);
    newNode.AppendChild(XMLDoc.CreateTextNode(DateTimeToStr(valeur)));
end;

function writeFloatXML(ANode : TDOMNOde;Nom : string;valeur : double) : TDOMNode;
var newNode : TDOMNode;
begin
    newNode := AddChildXML(ANOde,Nom);
    newNode.AppendChild(XMLDoc.CreateTextNode(FloatToStr(valeur)));
    result := newNode;
end;

procedure writePageXML(ANode : TDOMNOde;p : integer);
begin
   TDOMElement(ANode).SetAttribute('Page', intToStr(p));
end;

procedure writeIndexXML(ANode : TDOMNOde;p : integer);
begin
   TDOMElement(ANode).SetAttribute('Index',intToStr(p));
end;

procedure writeNomXML(ANode : TDOMNOde;Anom : string);
begin
   TDOMElement(ANode).SetAttribute('Nom',anom);
end;

var
     SuiteCaracGrandeur : TsysCharSet; // carac permis à l'interieur d'un nom de grandeur
     Lettres : TsysCharSet;

procedure getCursorPos(var P : TPoint);
begin
     P.X := getMouseX;
     P.Y := getMouseY;
end;

procedure setCursorPos(P : TPoint);
begin
     setMouseXY(P.X,P.Y);
end;

Function StrToFloatSex(degStr,minStr,secStr : string) : double;
var deg,minute,seconde,valeur : double;
    negatif : boolean;
begin
   negatif := degStr[1]='-';
   if negatif then delete(degStr,1,1);
   deg := StrToInt(degStr);
   minute := StrToInt(minStr);
   seconde := StrToFloatWin(secStr);
   valeur := deg+minute/60+seconde/3600;
   if negatif then valeur := -valeur;
   result := valeur;
end;

Procedure TrimComplet(var s : string);
var longueur,posCourant : integer;
begin
	longueur := Length(s);
	posCourant := 1;
	while (posCourant<=longueur) do
		if ord(s[posCourant])<=32
			then begin
			   Delete(s,posCourant,1);
			   dec(longueur);
			end
			else inc(posCourant);
end;

Procedure TrimAscii127(var s : string);
var longueur,posCourant : integer;
begin
  longueur := Length(s);
  posCourant := 1;
	while (posCourant<=longueur) do
		if ((s[posCourant]<=' ') or (s[posCourant]>'z'))
			then begin
			   Delete(s,posCourant,1);
			   dec(longueur);
			end
			else inc(posCourant);
end;

Function GetFloat(Nombre : string) : double;
Const
    MaxPile = 10;
    CaracCte : tSysCharSet = ['P','I','p','i'];
type
    IndicePile  = 1..MaxPile;
Var
    Pile : Array[IndicePile] of double;
    IndicePileCourant : 0..MaxPile;
    CaracCourant   : char;
    PointeurExp : integer;

Procedure suivant;
// Lit le prochain caractère et l'assigne à caracCourant
// Le caracCourant est toujours extrait avant appel d'un analyseur
begin
    inc(pointeurExp);
    if pointeurExp<=length(Nombre)
       then caracCourant := Nombre[pointeurExp]
       else caracCourant := #0;
end;

Procedure InitFonctor;
Begin
  pointeurExp := 0;
  indicePileCourant := 0;
  suivant;
end;

// Les procédures LireXXX extraient un XXX de la chaine Nombre à partir du pointeur courant

Function LireNombre : double;
    Var PointeurChiffre : integer;
        Valeur : double;
        NombreLoc : string;

    Procedure lireEntier;
    begin
       While charinset(caracCourant,chiffre) do suivant
    end;

    Begin
        PointeurChiffre := PointeurExp; // pointe le premier chiffre du nombre
        If charinset(caracCourant,['-','+']) then suivant; // saute le signe
        lireEntier;
        If caracCourant=FormatSettings.decimalSeparator // C'est un nombre décimal
           Then begin
              suivant; // on saute le .
              lireEntier
           end;
        If ( upcase(caracCourant) = 'E' ) // puissance de 10
           then begin
              suivant; // on saute le E
              if (caracCourant='+') or (caracCourant='-')  then suivant;
              lireEntier
           end
           else if pos(caracCourant,caracPrefixe)>0 then suivant; // coeff unité
        NombreLoc := copy(nombre,pointeurChiffre,pointeurExp-PointeurChiffre);
        if not ConvertitChaine(nombreLoc,valeur)
           then raise EGetFloatError.Create(erNombre);
        LireNombre := valeur;
   end; // lireNombre

Function LireIdEnt : string;
Var PointeurIdent : integer;
Begin
  PointeurIdent := pointeurExp;
  While charinset(caracCourant,CaracCte) do suivant;
  if (pointeurExp-pointeurIdent)>longNom then raise EGetFloatError.Create(erTropLong);
  LireIdent := copy(nombre,pointeurIdent,pointeurExp-pointeurIdent)
End;  // LireIdEnt

Procedure Depile(Var P : double);
Begin
  if indicePileCourant=0
    then raise EGetFloatError.Create(Erinterne)
    else begin
      P := Pile[indicePileCourant];
      dec(indicePileCourant);
   end;
End;

Procedure Empile(P : double);
Begin
  if indicePileCourant=MaxPile
    then raise EGetFloatError.Create(erTropcomplexe)
    else begin
      inc(indicePileCourant);
      Pile[indicePileCourant] := P;
   end;
End;

Function CalcOperateur(C : char;PG,PD : double) : double;
begin
   case C of
         '+'  : calcOperateur := PG+PD;
         '-'  : calcOperateur := PG-PD;
         '/'  : calcOperateur := PG/PD;
         '*'  : calcOperateur := PG*PD;
         '^'  : calcOperateur := Power(PG,PD);
         else CalcOperateur := 0;
   end;
end;

Procedure AnalyseExpression;Forward;

Procedure E; // E=(.Expression.)
Begin
  If caracCourant='('
    Then Begin
        suivant;
        AnalyseExpression;
        case caracCourant of
             ')'  : suivant;
             #0 : ; // fin => on ajoute ) manquante
             else raise EGetFloatError.Create('Erreur )');
        end;{case}
    End
    Else raise EGetFloatError.Create('Erreur (')
End;{E}

Procedure AnalyseElement; // Element = E/nombre
Var
  U : string;
Begin
  If charInSet(caracCourant,['P','p']) or (caracCourant=piMin) or (caracCourant=piMaj)
    Then Begin
        U := LireIdent;
        U := AnsiUpperCase(U);
        if (U=piMin) or (U='PI')or (U=piMaj)
           then Empile(pi)
           else raise EGetFloatError.Create('Erreur nombre')
    End {Then}
    Else If charinset(caracCourant,Chiffre+['-','+','.'])
        Then Empile(LireNombre)
        Else E
End; // analyseElement

Procedure AnalyseFacteur; // facteur = Element.^.element
Var  T1,T2 : double;
Begin
  AnalyseElement;
  While (caracCourant='^') do Begin
     suivant;
     AnalyseElement;
     depile(T2);
     depile(T1);
     Empile(CalcOperateur('^',T1,T2));
  End {while}
End; // AnalyseFacteur

Procedure AnalyseTerme; // terme = facteur.[* ou /].facteur
Var
  C        : Char;
  T1,T2    : double;
Begin
  AnalyseFacteur;
  While (caracCourant='*') or (caracCourant='/') do Begin
       C:=caracCourant;
       suivant;
       AnalyseFacteur;
       depile(T2);
       depile(T1);
       Empile(CalcOperateur(C,T1,T2));
    End {while}
End; // AnalyseTerme

Procedure AnalyseExpression;// Expression = [+ ou - ou rien].Terme.[+ ou -].terme
Var
  C      : Char;
  T1,T2  : double;
Begin
  If (caracCourant='+') or (caracCourant='-')
     Then Begin
        C:=caracCourant;
        suivant
     end
     Else C:='+';
  AnalyseTerme;
  If C='-' Then begin
         depile(T1);
         Empile(-T1)
  end;
  While (caracCourant='+') or (caracCourant='-') do Begin
      C:=caracCourant;
      suivant;
      AnalyseTerme;
      depile(T2);
      depile(T1);
      Empile(CalcOperateur(C,T1,T2));
  End {while}
End; // AnalyseExpression

procedure VerifExposant;
var i,j : integer;
    acarac : char;
begin
    i := 1;
    while (i<=length(nombre)) do begin
        acarac := nombre[i];
        if pos(acarac,chiffrePuiss)>0
            then begin
                 for j := 0 to 9 do
                 if acarac=ChiffreExp[j] then begin
                    if (i>2) and (nombre[i-2]='^')
                    then begin
                       nombre[i] := char(ord('0')+j);
                       inc(i);
                    end
                    else begin
                 //      nombre.Insert(i-1,'^');
                       nombre[i+1] := char(ord('0')+j);
                       inc(i,2);
                    end;
                    break;
                 end;
            end
            else inc(i);
    end;
end;

var posVirgule : integer;
    virgule : char;
Begin // getFloat
  trimComplet(Nombre);
  verifExposant;
  if nombre='' then raise EGetFloatError.Create('chaine vide');
  if FormatSettings.decimalSeparator='.' then virgule := ',' else virgule := '.';
  posVirgule := pos(virgule,nombre);
  while posVirgule>0 do begin
        Nombre[posVirgule] := FormatSettings.decimalSeparator;
        posVirgule := pos(virgule,nombre);
  end;
  InitFonctor;
  AnalyseExpression;
  if pred(pointeurExp)<>length(nombre) then
     raise EGetFloatError.Create('Erreur nombre');
  result := Pile[1];
end; // getFloat

Function StrLongueDureeToSecond(zz : string) : double;

function Extrait : integer;
var posSepar : integer;
begin
       posSepar := pos(':',zz);
       if posSepar=0
          then if zz=''
             then result := 0
             else begin
                result := strToInt(zz);
                zz := '';
             end
             else begin
                 result := strToInt(copy(zz,1,posSepar-1));
                 delete(zz,1,posSepar);
             end;   
end;

//  conversion d hh:mm:ss en secondes
var posJour,sec,min,hour,day : integer;
begin
    posJour := pos('j',zz);
    if posJour>0
       then begin
         try
         day := strToInt(copy(zz,1,posJour-1));
         except
         day := 0;
         end;
         delete(zz,1,posJour);
       end
       else day := 0;
    if (day=0) and (pos(':',zz)=0)
       then result := strToFloat(zz) // donnée en seconde
       else begin
          sec := 0;
          for min := 1 to length(zz) do
              if zz[min]=':' then inc(sec);
          if (day>0) or (sec>1)
             then begin
                hour := extrait;
                min := extrait;
                sec := extrait;
             end
             else begin
                min := extrait;
                sec := extrait;
                hour := 0;
             end;
          result := ((day*24+hour)*60+min)*60+sec;
      end;    
end;

Function GetFloatDate(Nombre : string;Aformat : TnombreFormat) : double;
var posSeconde,posMinute,i : integer;
    degre,minute,seconde : integer;
    z : string;
begin
  case Aformat of
     fDateTime : result := StrToDateTime(nombre);
     fDate : result := StrToDate(nombre);
     fTime : result := StrToTime(nombre);     
     fLongueDuree : result := StrLongueDureeToSecond(nombre);
     else begin
        posMinute := pos('''',nombre);
        posSeconde := pos('"',nombre);
        if posSeconde=0 then begin
           posSeconde := pos('''''',nombre);
           if posSeconde>0 then begin
              nombre[posSeconde] := '"';
              delete(nombre,posSeconde+1,1);
           end;
        end;
        if (posMinute>0) or (posSeconde>0)
             then begin
                  minute := 0;
                  seconde := 0;
                  degre := 0;
                  z := '';
                  i := 1;
                  while i<=length(nombre) do begin
                        try
                        case nombre[i] of
                             '0'..'9' : z := z+nombre[i];
                             '''' : begin
                                 minute := strToInt(z);
                                 z := '';
                              end;
                             '"' : begin
                                 seconde := strToInt(z);
                                 z := '';
                              end;
                        end;
                        except
                        end;
                        inc(i);
                  end;
                  if z<>'' then
                     if posMinute=0
                        then minute := strToInt(z)
                        else if posSeconde=0
                             then seconde := strToInt(z);
                  if degre<0
                    then result := degre-minute/60-seconde/60/60
                    else result := degre+minute/60+seconde/60/60;
              end // posDegre <> 0
              else result := getFloat(nombre);
     end { else }
  end;{ case }
end; // GetFloatDate

Function OKReg(const strOk : string;const helpCtx : LongInt) : boolean;
var SauveCursor : Tcursor;
begin
     SauveCursor := Screen.cursor;
     Screen.cursor := crDefault;
     result := MessageDlg(strOK,mtConfirmation,[mbYes,mbNo,mbHelp],HelpCtx) = idYes;
     Screen.cursor := SauveCursor;
// TMsgDlgType = ( mtWarning, mtError,  mtInformation,  mtConfirmation,  mtCustom);
// TMsgDlgBtn = (mbYes,mbNo,mbOK,mbCancel,mbAbort,mbRetry,mbIgnore,mbAll,mbNoToAll,mbYesToAll,mbHelp,mbClose);
end;

Function OKformat(const strOk : string;args : array of const) : boolean;
begin
     result := MessageDlg(format(strOK,args),mtConfirmation,[mbYes,mbNo,mbHelp],0)=idYes;
end;

Function StrToFloatWin(nombre : String) : double;
var posSeparator : integer;
begin
   if FormatSettings.decimalSeparator='.'
   then begin
      posSeparator := pos(',',nombre);
      if posSeparator>0
         then Nombre[posSeparator] := '.';
   end
   else begin
      posSeparator := pos('.',nombre);
      if posSeparator>0
         then Nombre[posSeparator] := ',';
   end;
   try
       result := strToFloat(nombre);
   except
       result := Nan
   end;
end;

Function FloatToStrPoint(const valeur : double) : string;
var posSeparator : integer;
begin
   if isNan(valeur) then result := ''
   else begin
   result := FloatToStr(valeur);
   if FormatSettings.decimalSeparator<>'.' then begin
      posSeparator := pos(FormatSettings.decimalSeparator,result);
      if posSeparator>0 then result[posSeparator] := '.';
   end;
   end;
end;

Function ConvertitChaine(nombre : string;var valeur : double) : boolean;
begin
   convertitChaine := false;
   TrimComplet(nombre);
   valeur := Nan;
   if Length(nombre)=0 then exit;
   case nombre[1] of
        'e','E' : nombre := '1'+nombre;
        '.',',' : begin
           nombre[1] := FormatSettings.decimalSeparator;
           nombre := '0'+nombre
        end;
        '0'..'9','+','-' : ;
        else exit;
   end;
   convertitChaine := true;
   convertitPrefixe(nombre);
   try
   valeur := StrToFloat(nombre);
   except
      convertitChaine := false;
   end;
end;

Procedure ConvertitPrefixe(var nombre : string);
var u : coefUnite;
    c : char;
begin
   c := nombre[length(nombre)];
   if pos(c,caracPrefixe)>0 then begin
      if c=muMin
         then u := micro
         else begin
         u := zero;
         repeat inc(u) until (c=prefixeUnite[u]);
      end;
      delete(nombre,length(nombre),1);
      nombre := nombre+expUnite[u];
   end;
end;

Function FormatIngenieur(Nombre : double;PrecisionU : integer) : string;

// ancien format Regressi
Function FormatErreur : string;
var i : integer;
begin
     result := '0.';
     for i := 1 to precisionU do result := result+'0';
end;

var
   tampon  : string;
   unite   : coefUnite;
   PuissanceDix : double;
   Longueur : integer;
   AbsNombre : double;
   negatif : boolean;
begin
     if isNan(Nombre) then begin
        result := '';
        exit;
     end;
     absNombre := abs(Nombre);
     if (absNombre>valUnite[zero]) and
        (absNombre<valUnite[infini])
        then begin
    negatif := nombre<0;
    try
    PuissanceDix := Dix(ceil(log10(absNombre))-precisionU);
    except
       result := FormatErreur;
       exit;
    end;
    AbsNombre := round(AbsNombre/PuissanceDix)*PuissanceDix;
    unite := nulle;
    while ( AbsNombre>=999 ) and (unite<infini) do begin
          AbsNombre := AbsNombre/1000;
          inc(unite)
    end; // abs(nombre)<1000 ou infini
    if unite=infini then begin
        result := FormatErreur;
        exit
    end;
    while ( AbsNombre<0.999 ) and (unite>zero) do begin
          AbsNombre := AbsNombre*1000;
          Dec(unite)
    end; // abs(nombre)>=1 ou zero
    if unite=zero then begin
        result := '0';
        exit
    end;
    longueur := succ(PrecisionU); // succ pour le point
    if AbsNombre<10
       then tampon := FloatToStrF(AbsNombre,ffGeneral,longueur,longueur-2)
// 2 = un chiffre avant la virgule + virgule
       else if AbsNombre<100
            then tampon := FloatToStrF(AbsNombre,ffGeneral,longueur,longueur-3)
// 3 =  deux chiffres avant la virgule + virgule
            else tampon := FloatToStrF(AbsNombre,ffGeneral,longueur,longueur-4);
// 4 =  trois chiffres avant la virgule + virgule
      if pos('NAN',tampon)<>0 then begin // Not a Number
             result := '';
             exit;
      end;
      while tampon[1]=' ' do delete(tampon,1,1);
      longueur := pos(FormatSettings.decimalSeparator,tampon);
      if longueur<=PrecisionU
         then tampon := copy(tampon,1,PrecisionU+1)
         else tampon := copy(tampon,1,PrecisionU);
   if negatif then tampon := '-' + tampon;
   if unite<>nulle then tampon := tampon+expUnite[unite];
   result := tampon;
   end
   else result := ''
end; // FormatIngenieur

Function FormatMilli(Nombre : double;PrecisionU : integer) : string;
var
   Longueur : integer;
   i : integer;
begin
     if isNan(Nombre) then result := ''
     else begin
     result := FormatGeneral(Nombre,PrecisionU);
     longueur := precisionU-length(result)+1;// +1=decimalSeparator
     if (longueur>0) and
          (pos(FormatSettings.decimalSeparator,result)>0) and
          (pos('E',result)<=0) then begin
           for i := 1 to longueur do
               result := result+'0';
     end;
     end;
end; // FormatMilli

Function FormatIncert(const nombre : double) : string;
var longueur,i,posE : integer;
    puiss : string;
begin
     result := FloatToStrF(nombre,ffFixed,2,18);
     posE := pos('E',result);
     longueur := length(result);
     if pos('E',result)>0 then begin
        puiss := copy(result,posE+1,longueur-posE);
        i := strToInt(puiss);
        puiss := pointMedian+'10'+puissToStr(i);
        result := copy(result,1,posE-1);
        longueur := length(result);
     end
     else puiss := '';
     i := 0;
     repeat inc(i);
     until charinset(result[i],['1'..'9']) or (i=longueur);
     if i<longueur then begin
        i := i+1; // on garde deux chiffres
        if Result[i]=formatSettings.DecimalSeparator
           then i := i+1;// on saute la virgule
     end;
     result := copy(result,1,i)+puiss;
end;

Function FormatGeneral(const Nombre : double;const Nchiffres : integer) : string;
var Nexp,posV,posE,i : integer;
    exposant : string;
begin
   if isNan(Nombre)
      then FormatGeneral := ''
      else begin
           result := FloatToStrF(nombre,ffGeneral,Nchiffres,2);
           posV := pos(FormatSettings.decimalSeparator,result);
           if posV=0
        then begin
           posE := pos('E',result);
           if posE>0
              then begin
                 exposant := copy(result,posE+1,length(result)-posE);
                 result := copy(result,1,posE-1);
                 Nexp := Nchiffres-posE+1;
              end
              else begin
                 exposant := '';
                 Nexp := Nchiffres-length(result);
              end;
           if Nexp>0 then begin
              result := result+FormatSettings.decimalSeparator;
              for i := 1 to Nexp do result := result+'0';
           end;
        end
        else begin
           posE := pos('E',result);
           if posE>0
              then begin
                 exposant := copy(result,posE+1,length(result)-posE);
                 result := copy(result,1,posE-1);
                 Nexp := Nchiffres-posE+2;
              end
              else begin
                 exposant := '';
                 Nexp := Nchiffres-length(result)+1;
              end;
           if result[1]='-' then begin
             inc(Nexp);
             if result[2]='0' then inc(Nexp);
           end
           else if result[1]='0' then inc(Nexp);
           for i := 1 to Nexp do result := result+'0';
        end;
     end;
     if exposant<>'' then begin
         Nexp := strToInt(exposant);
         result := result+pointMedian+'10'+puissToStr(Nexp);
     end;
end; // FormatGeneral

Function FormatRadian(Nombre : double) : string;
var num,denom : integer;
    strNum,strDenom : string;
begin
   if nombre<0 then strNum := '-' else strNum := '';
   nombre := abs(nombre);
   AngleEnRadian(nombre);
   if nombre<pi/12
      then result := '0'
      else begin
          denom := 12;
          num := round(nombre*12/pi);
          if num mod 2 = 0 then begin
             num := num div 2;
             denom := denom div 2;
          end;
          if num mod 2 = 0 then begin
             num := num div 2;
             denom := denom div 2;
          end;
          if num mod 3 = 0 then begin
             num := num div 3;
             denom := denom div 3;
          end;
          if AngleEnDegre
             then result := StrNum+IntToStr(180*num div denom)
             else begin
                if denom=1 then strDenom := '' else strDenom := '/'+intToStr(Denom);
                if num<>1 then strNum := strNum + intToStr(Num);
                result := strNum+piMin+strDenom;
             end;
     end;
end; // FormatRadian

Function FormatReg(const Nombre : double) : string;
begin
       result := FormatMilli(Nombre,Precision)
end;

Function FormatCourt(const Nombre : double) : string;
begin
       result := FormatMilli(Nombre,PrecisionMin)
end;

Function ChainePrec(const Prec : double) : string;
begin
   if prec>=1
       then result := '???'
       else if prec>1e-3
          then result := FloatToStrF(prec*100,ffGeneral,1,0)+' %'
          else result := '<0,1%';
    result := ' '+result;
end;

function TailleFichier(const nomFichier : string) : Int64;
var sr: TSearchRec;
begin
      if findFirst(nomFichier,faAnyFile,Sr)= 0
      then begin
      try
      result := Int64(Sr.Size);
      finally
        sysutils.FindClose(Sr);
      end
      end
      else result := -1;
end;

Function NbreLigneWin(const s : String) : LongInt;
var fin : integer;
    StValeur : string;
begin
     fin := 2;
     while (s[fin]>='0') and
     	   (s[fin]<='9') do inc(fin);
     stValeur := copy(s,2,fin-2);
     try
     NbreLigneWin := StrToInt(stValeur)
     except
        on EConvertError do NbreLigneWin := 0
     end
end;

function litColor(couleurDefaut : Tcolor) : TColor;
var couleurStr : string;
    couleurInt : longWord;
begin
    try
    readln(fichier,couleurStr);
    couleurInt := round(strToFloat(couleurStr));
    couleurInt := couleurInt mod 16777216; // 2^24
    result := Tcolor(couleurInt);
    except
        result := couleurDefaut
    end;
end;


procedure afficheErreur(const strErreur : string;const HelpCtx : LongInt);
var  Boutons : TMsgDlgButtons;
     SauveCursor : Tcursor;
begin
     if HelpCtx=0
        then boutons := [mbOK]
        else boutons := [mbOK,mbHelp];
     SauveCursor := Screen.cursor;
     Screen.cursor := crDefault;
     MessageDlg(strErreur,mtError,boutons,HelpCtx);
     Screen.cursor := SauveCursor;
end;

Function PuissToStr(const puiss : integer) : string;
var dest : string;
    i : integer;
    numero : integer;
begin
      if puiss=0
         then dest := ''
         else dest := IntToStr(puiss);
      for i := 1 to length(dest) do
          case dest[i] of
               '0'..'9' : begin
                  numero := strToInt(dest[i]);
                  delete(dest,i,1);
                  insert(chiffreExp[numero],dest,i);
               end;
          end;
      PuissToStr := dest
end;

Function IsLigneComment(const ligneCourante : String) : boolean;
// ligne vide ou ligne de commentaire
var PosBlanc : integer;
begin
    posBlanc := 1;
    while (posBlanc<=length(ligneCourante)) and
          (ligneCourante[posBlanc]=' ') do inc(posBlanc);
    IsLigneComment :=
        (posBlanc>length(ligneCourante)) or
        charInSet(ligneCourante[posBlanc],['''',';'] )
end;

function EnTeteRW3 : boolean;
begin
   result := false;
   ligneWin := '';
   try
   readln(fichier,ligneWin);
   result := Pos('REGRESSI WINDOWS',ligneWin)>0;
   except
        FinFichierWin := true;
   end;
   finFichierWin := finFichierWin or eof(fichier);
end;

function litLigneWin : String;
begin
   try
   finFichierWin := finFichierWin or eof(fichier);
   if finFichierWin
      then ligneWin := ''
      else readln(fichier,ligneWin);
   result := ligneWin;
   except
       FinFichierWin := true;
       ligneWin := '';
       result := '';
   end;
end;

procedure readLnNombreWin(var z : double);
begin
    try
    readln(fichier,z);
    if not isNan(z) and (z=1e-26) then z := nan;
    except
        z := nan;
    end;
end;

function litBooleanWin : boolean;
begin
   litLigneWin;
   litBooleanWin := (length(ligneWin)>0) and (ligneWin[1]<>'0')
end;

Function ToucheValidation(key : word) : boolean;
begin
    ToucheValidation := key in [vk_tab,vk_left,vk_right,vk_down,vk_up,vk_return]
end;

Procedure VerifKeyGetFloat(var key : char);
begin
     if charinset(key,[',','.'])
        then key := FormatSettings.decimalSeparator
        else if not charinset(key,CharGetFloat) then key := #0
end;

Procedure VerifKeyGetInt(var key : char);
begin
     if not charinset(key,CharGetInt) then key := #0
end;

Procedure Validatedouble(Sender : Tedit;var z : double);
begin
     try
         z := StrToFloatWin(sender.text)
     except
         sender.text := FloatToStr(z);
         raise EGetFloatError.Create(erNombre)
     end;
end;

function PadChar(S : String;Len : integer;Achar : char) : String;
// Return a string right-padded to length len with Achar
var i,Slen : integer;
begin
   SLen := length(S); 
   if SLen>=Len
      then result := copy(S,1,Len)
      else begin
         result := S;
         for i := Slen+1 to len do
             result := result + Achar;
      end;
end;

function Pad(S : string;Len : integer) : string;
// Return a string right-padded to length len with ' '
begin
     result := PadChar(S,len,' ')
end;

Function EncodeDuree(duree : LongInt) : TdateTime;
var h,m,s,ms : word;
begin
    h := duree div 3600;
    duree := duree-h*3600;
    m := duree div 60;
    duree := duree-m*60;
    s := duree;
    ms := 0;
    EncodeDuree := EncodeTime(h,m,s,ms);
end;

Function DureeEcoulee(const InstantDebut : TdateTime) : double;
var h,m,s,ms : word;
begin
      decodeTime(time-instantDebut,h,m,s,ms);
      DureeEcoulee := h*3600.0+m*60.0+s*1.0+ms*0.001;
end;

Function existeOption(opt : char;const defaut : boolean) : boolean;
var str : String;
    i : integer;
begin
    result := defaut;
    for i := 1 to ParamCount do begin
       str := ParamStr(i);
       if (length(str)>1) and (str[1]='/') and (upcase(str[2])=opt) then begin
          if length(str)=2
             then result := true
             else result := (str[3]='+');
          exit;
       end;
     end;
end;

Function CaracToChiffre(carac : char) : integer;
var i : integer;
begin
      if charInSet(carac,chiffre)
         then result := ord(carac)-ord('0')
         else begin
            result := 0;
            for i := 0 to 9 do
                if carac=ChiffreExp[i] then begin
                   result := i;
                   break;
                end;
         end
end;

procedure NewPage;
begin with PrinterParam do begin
    Cur.X := MargeTexte;
    Cur.Y := MargeTexte;
    Printer.NewPage;
end end;

Procedure VerifOrpheline(count : integer;var debut : integer);
var hauteur : integer;
begin
    Hauteur := succ(count)*HeightLinePrinter;
    if (debut+hauteur)>PrinterParam.PageH
        then begin
             Printer.NewPage;
             debut := 0;
             DebutImpressionTexte(debut);
        end
        else begin
             DebutImpressionTexte(debut);
             ImprimerLigne('',debut);
        end;
end;

function HeightLinePrinter : Word;
begin
    Result := abs(Printer.Canvas.Font.Height)
end;

// Start a new line on the current page, if no more lines left start a new page
procedure NewLine;
begin with printerParam do begin
    Cur.X := MargeTexte;
    if Height = 0
       then Inc(Cur.Y,HeightLinePrinter)
       else Inc(Cur.Y,Height);
    if Cur.Y > (Finish.Y - Height) then NewPage;
    Height := 0;
end end;

// Print a string to the printer without regard to special characters
procedure ImprimerTexte(const TextStr: string);
var L : integer;
begin with PrinterParam do begin
    L := Printer.Canvas.TextWidth(TextStr);
    Printer.Canvas.TextOut(Cur.X,Cur.Y,TextStr);
    Inc(Cur.X,L);
end end;

procedure ImprimerColonne(const TextStr: string;const largeurCol,NumCol : integer);
var XX : integer;
begin with PrinterParam do begin
    Cur.X := margeTexte+numCol*largeurCol;
    if GridPrint then begin
       XX := Cur.X+largeurCol-3; // ligne en fin de colonne
       Printer.Canvas.MoveTo(XX,Cur.Y-1);
       Printer.Canvas.LineTo(XX,Cur.Y+height-1);
    end;
    ImprimerTexte(textStr);
end end;

procedure ImprimerLigne(const TextStr : string;var debut : integer);
begin
    ImprimerTexte(textStr);
    debut := finImpressionTexte;
end;

Procedure DebutImpressionTexte(var haut : integer);
var limite : Trect;
begin with printerParam do begin
     limite := Printer.Canvas.ClipRect;
     with limite do begin
        PageW := right-left;
        PageH := bottom-top;
     end;
     if printer.Orientation=poPortrait
        then MargeTexte := PageW div MargeImprimante
        else MargeTexte := PageW div MargeImprimantePaysage;
     Finish.X := PageW-margeTexte;
     Finish.Y := PageH-margeTexte;
     Cur.X := MargeTexte;
     if haut<margeTexte then haut := MargeTexte;
     if haut>Finish.Y
       then NewPage
       else Cur.Y := haut;
     Height := 0;
     Printer.title := 'Regressi';
     Printer.Canvas.Font.Name := FontName;
     Printer.Canvas.Font.Size := FontSizeImpr;
     Printer.Canvas.Font.Color := clBlack;
     Printer.canvas.Brush.Style := bsClear;
end end;

Function FinImpressionTexte : integer;
begin
     NewLine;
     result := printerParam.Cur.Y
end;
                                                       
Procedure FinImpressionGr;
begin
     printer.endDoc;
     printer.orientation := printerParam.sauveOrientation
end;

Procedure DebutImpressionGr(Orientation : TprinterOrientation;var bas : integer);
begin
     printerParam.sauveOrientation := printer.orientation;
     printer.Orientation := Orientation;
     printer.title := 'Regressi';
     with printerParam do begin
        MargeTexte := PageW div MargeImprimante;
        Finish.X := PageW-margeTexte;
        Finish.Y := PageH-margeTexte;
        Cur.X := MargeTexte;
        Cur.Y := MargeTexte;
        Height := 0;
     end;
     Printer.Canvas.Font.Name := FontName;
     Printer.Canvas.Font.Size := FontSizeImpr;
     Printer.Canvas.Font.Color := clBlack;
     bas := 0;
     printer.beginDoc;
     ImprimerLigne(userName,bas);
end;

procedure ImprimerGrid(g : TstringGrid;var debut : integer);

var colMax,LargeurColonne,Longueur : integer;

procedure PrintPermute;
var r,c : integer;
    rdebut,rfin,bloc : integer;
    texte : string;
begin with G do begin
      if rowCount>64 then begin
          afficheErreur(erGrandTableau,0);
          exit;
      end;
      if GridPrint then with PrinterParam do begin
           Printer.Canvas.MoveTo(margeTexte,Cur.Y-1);
           Printer.Canvas.LineTo(Finish.X,Cur.Y-1);
      end;
      for bloc := 0 to rowCount div (colMax-1) do begin
          rdebut := bloc*(colMax-1)+2; // -1 = nom(unité)
          rfin := rdebut+(colMax-1);
          if rfin>rowCount then rfin := rowCount;
          for c := 0 to pred(colCount) do begin
             texte := cells[c,0];
             if cells[c,1]<>'' then texte := texte+'('+cells[c,1]+')';
             ImprimerColonne(texte,largeurColonne,0);
             for r := rdebut to pred(rfin) do
                 ImprimerColonne(cells[c,r],largeurColonne,(r-rdebut) + 1);
             newLine;
             if GridPrint then with PrinterParam do begin
                  Printer.Canvas.MoveTo(margeTexte,Cur.Y-1);
                  Printer.Canvas.LineTo(Finish.X,Cur.Y-1);
             end;
          end;
     end;
end end;

Procedure PrintNormal;
var r,c,colDebut,colFin,pas,XX,oldY : integer;
begin with G do begin
      colDebut := 0;
      if GridPrint then with PrinterParam do begin // ligne horizontale
           Printer.Canvas.MoveTo(margeTexte,Cur.Y-1);
           Printer.Canvas.LineTo(Finish.X,Cur.Y-1);
      end;
      pas := succ(rowCount div 64);
      repeat
         colFin := pred(ColCount);
         if (colFin-colDebut)>=colMax
            then colFin := colDebut+pred(colMax);
         oldY := 0; // pour le compilateur
         for r := 0 to pred(RowCount) do begin
             if (r<3) or (((r-2) mod pas)=0) then begin
                if GridPrint then begin // ligne verticale au début
                   XX := printerParam.Cur.X+largeurColonne-3;
                   Printer.Canvas.MoveTo(XX,printerParam.Cur.Y-1);
                   Printer.Canvas.LineTo(XX,printerParam.Cur.Y+printerParam.Height-1);
                end;
                for c := colDebut to colFin do
                    ImprimerColonne(cells[c,r],largeurColonne,c-colDebut);
                if r=0 then oldY := PrinterParam.Cur.Y-1;
                NewLine;
                if GridPrint then with PrinterParam do begin // ligne horizontale
                   if r=0 then begin
                      Printer.Canvas.MoveTo(margeTexte,oldY);
                      Printer.Canvas.LineTo(margeTexte+(colFin-colDebut+1)*largeurColonne,oldY);
                   end;
                   Printer.Canvas.MoveTo(margeTexte,cur.Y-1);
                   Printer.Canvas.LineTo(margeTexte+(colFin-colDebut+1)*largeurColonne,cur.Y-1);
                end;
             end;
         end;
         colDebut := colFin+1;
      until colDebut>pred(colCount);
end end;

begin with G do begin // ImprimerGrid
      Longueur := Precision+6; // blanc signe . Exx
      DebutImpressionTexte(debut);
      NewLine;
      LargeurColonne := Printer.Canvas.TextWidth(PadChar('',longueur,'A'));
      colMax := (PrinterParam.PageW-2*printerParam.MargeTexte) div largeurColonne;
      if permuteColRow and (rowCount>colCount)
         then printPermute
         else printNormal;
      NewLine;
      debut := FinImpressionTexte;
end end; // ImprimerGrid

Function LitBool : boolean;
var m : integer;
begin
      readln(fichier,m);
      result := boolean(m);
end;

Function FormatLongueDureeAxe(const nombre : double) : string;
var t : longInt;
    min,hour,day : integer;
begin
    result := '';
    t := round(nombre);
    day := t div UnJour;
    if day>0 then result := intToStr(day)+'j';
    t := t-day*UnJour;
    hour := t div UneHeure;
    if hour>0 then result := result+IntToStr(hour)+'h';
    if day=0 then begin
       t := t-hour*UneHeure;
       min := t div UneMinute;
       result := result+IntToStr(min);
    end;
end;

function valeur125(valInt : integer;down : boolean) : integer;
var mantisse,exposant,coeff : double;
    valeur : double;
begin
     if down
        then Valeur := ValInt/2.15
        else Valeur := ValInt*2.15;
     exposant := log10(valeur);
     coeff := Int(exposant);
     if (exposant<0) and (coeff<>exposant) then coeff := coeff-1;
     coeff := power(10,coeff);
     mantisse := Int(valeur/coeff);
     if mantisse>2 then if mantisse<6
           then mantisse := 5
           else mantisse := 10;
     result := round(mantisse*coeff);
end;

procedure AffecteStatusPanel(var Astatus : TstatusBar;i : integer;Atext : string);
begin with Astatus.panels[i] do begin
     text := ' '+Atext+' ';
     width := Length(text)*8;
end end;

procedure VideStatusPanel(var Astatus : TstatusBar;i : integer);
begin with Astatus.panels[i] do begin
     text := '';
     width := 16;
end end;

    function getNomCoord(nom : string) : string;
    begin
       if pos(RepereConst,nom)>0 then
          system.delete(nom,1,length(RepereConst));
       result := nom;
    end;

Procedure AddBackSlash(var aPath : String);
Begin
  If (aPath <> '') and
     (aPath[Length(aPath)] <> '\') Then
         aPath := aPath + '\';
End;

Function LigneDeChiffres(const s : String) : boolean;
var j : integer;
    AvecChiffres : boolean;
begin
    Result := false;
    AvecChiffres := false;
    for j := 1 to length(s) do
        if charinset(s[j],caracNombre) or
           ((pos(s[j],caracPrefixe)>0) and (j>1) and
           charinset(s[j-1],chiffre))
           then avecChiffres := true
           else if not charinset(s[j],separateur) then exit;
    result := avecChiffres;
end;

Function isLettre(carac : char) : boolean;
begin
    result := charInSet(carac,Lettres);
    if not result then result := pos(carac,grecque)>0;
end;

Function isCaracGrandeur(carac : char) : boolean;
begin
    result := isLettre(carac);
    if not result then result :=
         charInset(carac,SuiteCaracGrandeur);
end;

procedure ecritChaineRW3(s : String);
begin
    writeln(fichier,s);
end;

procedure extraitNombre(const chaine : string;var valeur : vecteurNombre);
var
  cars : TStringList;            // Define our string list variable
  i    : Integer;
begin
  // Define a string list object, and point our variable at it
  cars := TStringList.Create;
  // Now add some cars to our list - using the DelimitedText property
  // with overriden control variables
  cars.Delimiter := ' ';        // Each list item will be blank separated
//  cars.QuoteChar := '|';        // And each item will be quoted with |'s
  cars.DelimitedText := chaine;
  for i := 0 to cars.Count-1 do
      valeur[i] := strToInt(cars[i]);
  // Free up the list object
  cars.Free;
end;

constructor TFileSearch.Create (AOwner: TComponent);
begin
   inherited Create (AOwner);
   Opened := False;
end;

function TFileSearch.FirstFile (SearchPath: string; FileKind: String): String;
begin
   Result := '';
   if Opened then Close; // let's close any previous opened search
   if Length(SearchPath) > 0 then // let's add a trailing slash if required
      if SearchPath[length(SearchPath)] = '\'
         then Path := SearchPath
         else Path := SearchPath + '\'
   else Path := '.\';
   if FindFirst (Path + FileKind, faAnyFile, SearchRec) = 0 then begin
      Result := Path + SearchRec.Name;
      Opened := True;
   end;
end;

function TFileSearch.NextFile: String;
begin
   Result := '';
   if Opened then
      if FindNext (SearchRec) = 0
         then Result := Path + SearchRec.Name
         else Close;
end;

procedure TFileSearch.Close;
begin
   if Opened then begin
      SysUtils.FindClose (SearchRec);
      Opened := False;
   end;
end;

destructor TFileSearch.Destroy;
begin
   Close;
   inherited Destroy;
end;

Initialization
     mesDocsDir := GetUserDir;
     sysUtils.forceDirectories(MesDocsDir);
     AddBackSlash(mesDocsDir);
     nomFichierIni := mesDocsDir+'Regressi.ini';
     userName := WinInfo.userName;
     precision := 4;
     autoIncrementation := false;
     ReticuleComplet := true;
     LigneRappelCourante := lrEquivalence;
     LigneRappelTangente := lrEquivalence;     
     GraduationPi := false;
     Lettres := ['a'..'z','A'..'Z'];
     SuiteCaracGrandeur := ['''','%','"','0'..'9']; // '_' utilisé pour unité
     avecOptionsXY := true;

Finalization
   TexteModele.free;
end.

