Unit Utilit;   {d‚clarations g‚n‚rales hors interface ‚cran clavier, adapt‚ de Amanan1}

{=============================================================================}

INTERFACE

USES Dos;

type
 BChai4      = string[4];
 BChai5      = string[5];
 BEnsemble   = set of byte;
 BPrecis1    = double;
 Bprecis2    = double;

const
 BJour_An    = 365;
 BLong       : array[1..12] of integer  =(31,28,31,30,31,30,31,31,30,31,30,31);
 BSMois      : array[1..12] of string[4]=('janv','fevr','mars','avri','mai ','juin',
                                        'juil','aout','sept','octo','nove','dece');
 BTresNegatif= -1e+20;
 BTresPositif= 1e+20;

var
 BNom          : string;
 BNom1         : string;
 BNom2         : string;
 BMauv         : boolean;
 BCode         : integer;
 BCode1        : integer;
 BCode2        : integer;
 BCode3        : integer;
 Ax            : integer;
 Ay            : integer;

procedure B_Datation (var Zou:text);
function  B_MaxExt(ZR1,ZR2:Extended):Extended;
function  B_MinExt(ZR1,ZR2:Extended):Extended;
function  B_Max (ZR1,ZR2:Bprecis2):Bprecis2;
function  B_Min (ZR1,ZR2:Bprecis2):Bprecis2;
function  B_MaxIn (ZI1,ZI2:integer):integer;
function  B_MinIn (ZI1,ZI2:integer):integer;
function  B_MaxLongInt (ZD1,ZD2:Longint):longint;
function  B_MinLongInt (ZD1,ZD2:longint):longint;
function  B_MaxDouble (ZD1,ZD2:Bprecis1) :Bprecis1;
function  B_MinDouble (ZD1,ZD2:Bprecis1) :Bprecis1;
function  B_Longmois (ZMois:integer):integer;
function  B_DateClaire (ZQuant:integer):BChai5; {date en clair … partir du quantieme}
function  B_Quantieme (Zjour,Zmois:integer):integer;
function  B_QuantiemeNonBiss(ZDate:longint):integer;
function  B_Tjour (ZAn,ZMois,ZJour:longint):longint;
function  B_Date (ZRang:longint):string;

{============================================================================}

IMPLEMENTATION


procedure B_Datation(var Zou:text);
 var XHeure,XMinute,XSeconde,XSec100,XAnnee,XMois,XJour,XJour_Semaine: word;
 begin
  getdate(XAnnee,XMois,XJour,XJour_Semaine);
  gettime(XHeure,XMinute,XSeconde,XSec100);
  writeln(Zou);
  writeln(Zou,'le  ',XJour,'-',XMois,'-',XAnnee,' a  ',XHeure,'H',XMinute,'mn',XSeconde,'''',XSec100,'''','''');
 end;

{----------------------------------------------------------------------------}

{----------------------------------------------------------------------------}
function  B_MaxExt(ZR1,ZR2:Extended):Extended;
 begin if ZR1>ZR2 then B_MaxExt:=ZR1 else B_MaxExt:=ZR2; end;

function  B_MinExt(ZR1,ZR2:Extended):Extended;
 begin if ZR1<ZR2 then B_MinExt:=ZR1 else  B_MinExt:=ZR2; end;

function  B_Max(ZR1,ZR2:Bprecis2):Bprecis2;
 begin if ZR1>ZR2 then B_Max:=ZR1 else B_Max:=ZR2; end;

function  B_Min(ZR1,ZR2:Bprecis2):Bprecis2;
 begin if ZR1<ZR2 then B_Min:=ZR1 else  B_Min:=ZR2; end;

function  B_MaxIn(ZI1,ZI2:integer):integer;
 begin if ZI1>ZI2 then B_Maxin:=ZI1 else  B_Maxin:=ZI2; end;

function  B_MinIn(ZI1,ZI2:integer):integer;
 begin if ZI1<ZI2 then B_MinIn:=ZI1 else  B_MinIn:=ZI2; end;

function  B_MaxLongInt(ZD1,ZD2:Longint):longint;
 begin if ZD2>ZD1 then B_MaxLongInt:=ZD2 else B_MaxLongInt:=ZD1; end;

function  B_MinLongInt(ZD1,ZD2:longint):longint;
 begin if ZD2<ZD1 then B_MinLongInt:=ZD2 else B_MinLongInt:=ZD1; end;

function  B_MaxDouble (ZD1,ZD2:Bprecis1) :Bprecis1;
 begin if ZD2>ZD1 then B_MaxDouble :=ZD2 else B_MaxDouble :=ZD1; end;

function  B_MinDouble (ZD1,ZD2:Bprecis1) :Bprecis1;
 begin if ZD2<ZD1 then B_MinDouble :=ZD2 else B_MinDouble :=ZD1; end;

{----------------------------------------------------------------------------}

function B_Longmois(ZMois:integer):integer;
{donne le nombre de jours du mois en ann‚e de 365 jours                     }
 var XL : integer;
 begin
  B_LongMois:=BLong[ZMois];
 end;

{----------------------------------------------------------------------------}

function B_DateClaire(ZQuant:integer):BChai5;
{---Calcul de la date en format jj.mm … partir du quantiŠme annuel, pour ---}
{---ann‚e bissextile ou non.                                             ---}
 var
  XS,Xi:integer;
  XC   :BChai5;
 begin
  XS:=0;Xi:=0;
  repeat
   Xi:=Xi+1; XS:=XS+B_LongMois(Xi);
  until XS>=ZQuant;
  str((ZQuant-XS+B_LongMois(Xi)+Xi/100):5:2,XC); if XC[1]=' ' then XC[1]:='0';
  B_DateClaire:=XC;
 end;

{----------------------------------------------------------------------------}

function B_Quantieme(Zjour,Zmois:integer): integer;
{--calcul du quantiŠme … partir du jour, du mois et de l'ann‚e, pour une --}
{--ann‚e bissextile ou non.                                              --}
 var Xi,XS:integer;
 begin
  Xs:=0;
  for Xi:=1 to ZMois-1 do Xs:=XS+B_LongMois(Xi);
  B_Quantieme:=XS+Zjour;
 end;

{----------------------------------------------------------------------------}

function B_QuantiemeNonBiss(ZDate:longint) : integer;
{--en fonction du nombre de jours ZDate ‚coul‚s depuis le 31/12/1599,   --}
{--calcule la date jj/mm/aaaa et donne le quantiŠme de jj/mm/2001, c'est--}
{--… dire pour le mˆme jour et le mˆme mois d'une ann‚e non bissextile  --}
 var
  XChaineDate: string;
  XJour      : integer;
  XMois      : integer;
  XCode      : integer;
 begin
  XChaineDate:=B_Date(ZDate);
  val(copy(XChaineDate,1,2),XJour,XCode);
  val(copy(XChaineDate,4,2),XMois,XCode);
  B_QuantiemeNonBiss:=B_Quantieme(XJour,XMois);
 end;

{----------------------------------------------------------------------------}

function B_Tjour(ZAn,ZMois,ZJour:longint):longint;
{calcul du nombre de jours ‚coul‚s depuis le 01/01/0000 (nombre = 1), … --}
{partir de l'ann‚e, du mois et du jour. le calcul est valable … partir  --}
{en ann‚e non bissextiles                                               --}
 const
  XN: array[1..12] of integer = (0,31,59,90,120,151,181,212,243,273,304,334);
 begin
  B_Tjour := XN[ZMois]+Zjour+ZAn*365;
 end;

{----------------------------------------------------------------------------}


function B_Date(ZRang:longint):string;
{--calcul de la date en clair … partir du nombre de jours ‚coul‚s depuis --}
{--le 31/12/1599 (nombre = 0).                                           --}
{--obsolŠte--calcul de la date en clair … partir du jour compt‚ depuis le 31/12/1899.}
{--obsolŠte--Le calcul est valable … partir de 1901.}

{--obsolŠte--corrig‚ 2000}

 var
  Xi,Xj,Xk    :integer;
  XDat        :Bprecis2;
  XS1,XS2,XS3 : string[4];
  XDuree      :longint;

{- - - - - - - - - - - - - - - - - - - - - - - -}

 function XNombjour(Zi:integer):integer;
  begin
   {if (Zi mod 4)=0 then XNombjour:=366}
   if ((Zi mod 4)=0) and (((Zi mod 100)<>0)or((Zi mod 400)=0)) then
    XNombjour:=366
   else XNombjour:=365;
  end;

{- - - - - - - - - - - - - - - - - - - - - - - -}

 begin
  {Xi:=1899;}
  Xi:=1599;
  XDuree:= 0;
  while XDuree< ZRang do
   begin
    Xi:=Xi+1; XDuree:=XDuree+XNombjour(Xi);
   end;
  XDuree:=XDuree-XNombjour(Xi);
  Xj:=0;
  while XDuree<ZRang do
   begin
    Xj:=Xj+1; XDuree:=XDuree+B_Longmois(Xj);
   end;
  XDuree:=XDuree-B_Longmois(Xj);
  Xk:=ZRang-XDuree;
  str(Xk,XS1);
  if Xk<10 then
   XS1:='0'+XS1;
  str(Xj,XS2);
  if Xj<10 then
   XS2:='0'+XS2;
  str(Xi:4,XS3);
  B_Date:=XS1+'/'+XS2+'/'+XS3;
 end;

{============================================================================}

BEGIN
END.