UTILIT.PAS 7.18 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245

Unit Utilit;   {dclarations gnrales hors interface cran clavier, adapt de Amanan1}

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

INTERFACE

USES Dos;

type
 AChai3      = string[3];
 AChai4      = string[4];
 AChai5      = string[5];
 AChai6      = string[6];
 AEnsemble   = set of byte;
 APrecis1    = double;
 Aprecis2    = double;

const
 ACent       = 100;
 AHAsec      : APrecis1 = -999;
 AQHorsBar   : APrecis1 = 998000.0;
 AHLacune    : APrecis1 = 9999;     {code des cotes en lacune }
 AJour_An    = 365;
 ALong       : array[1..12] of integer  =(31,28,31,30,31,30,31,31,30,31,30,31);
 Amaxanfin   = 2100;             {anne maximale pour fin des calculs }
 AMille      = 1e+3;
 AMillion    = 1e+6;
 Aminandeb   = 1901;             {anne minimale pour dbut de calcul }
 AMinou      : APrecis1 = 1999.1;
 ANomBarrage = 'nomstat';
 APlacune    : APrecis1 = 999000.0; {lacune de puissance      }
 AQlacune    : APrecis1 = 999000.0; {code des dbits en lacune}
 ASec_Jour   = 86400.0;  {nombre de secondes par jour}
 ASMois      : array[1..12] of string[4]=('janv','fevr','mars','avri','mai ','juin',
                                        'juil','aout','sept','octo','nove','dece');
 ATresNegatif= -1e+20;
 ATresPositif= 1e+20;

var
 ANom          : string;
 ANom1         : string;
 ANom2         : string;
 AMauv         : boolean;
 ACode         : integer;
 ACode1        : integer;
 ACode2        : integer;
 ACode3        : integer;
{
 ADelai        : integer;
 Ax            : integer;
 Ay            : integer;
}
 Alst          : text;
 AMumuch       : AChai3;

procedure ADatation (var Zou:text);
function  AMaxExt(ZR1,ZR2:Extended):Extended;
function  AMinExt(ZR1,ZR2:Extended):Extended;
function  AMax (ZR1,ZR2:Aprecis2):Aprecis2;
function  AMin (ZR1,ZR2:Aprecis2):Aprecis2;
function  AMaxIn (ZI1,ZI2:integer):integer;
function  AMinIn (ZI1,ZI2:integer):integer;
function  AMaxLongInt (ZD1,ZD2:Longint):longint;
function  AMinLongInt (ZD1,ZD2:longint):longint;
function  AMaxDouble (ZD1,ZD2:Aprecis1) :Aprecis1;
function  AMinDouble (ZD1,ZD2:Aprecis1) :Aprecis1;
function  ALongmois (ZAn,ZMois:integer):integer;
function  ADateClaire (ZAnnee,ZQuant:integer):AChai5; {date en clair  partir du quantieme}
function  AQuantieme (Zjour,Zmois,ZAnnee:integer):integer;
function  ATjour (ZAn,ZMois,ZJour:longint):longint;
function  ADate (ZRang:longint):string;
procedure AEfface (ZNomfi:string);

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

IMPLEMENTATION


procedure ADatation(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  AMaxExt(ZR1,ZR2:Extended):Extended;
 begin if ZR1>ZR2 then AMaxExt:=ZR1 else AMaxExt:=ZR2; end;

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

function  AMax(ZR1,ZR2:Aprecis2):Aprecis2;
 begin if ZR1>ZR2 then AMax:=ZR1 else AMax:=ZR2; end;

function  AMin(ZR1,ZR2:Aprecis2):Aprecis2;
 begin if ZR1<ZR2 then AMin:=ZR1 else  AMin:=ZR2; end;

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

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

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

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

function AMaxDouble (ZD1,ZD2:Aprecis1) :Aprecis1;
 begin if ZD2>ZD1 then AMaxDouble :=ZD2 else AMaxDouble :=ZD1; end;

function AMinDouble (ZD1,ZD2:Aprecis1) :Aprecis1;
 begin if ZD2<ZD1 then AMinDouble :=ZD2 else AMinDouble :=ZD1; end;

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

function ALongmois(ZAn,ZMois:integer):integer;
{donne le nombre de jours du mois Mois de l'annee An}
 var XL : integer;
 begin
  XL:=ALong[ZMois];
  if (ZMois=2) and ((ZAn mod 4) = 0) then XL:=XL+1;
  ALongMois:=XL;
 end;

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

function ADateClaire(ZAnnee,ZQuant:integer):AChai5;
{---Calcul de la date en format jj.mm,  partir du quantime annuel, pour ---}
{---une anne considre bissextile (mod 4 = 0) ou  non bissextile        ---}
 var
  XS,Xi:integer;
  XC   :AChai5;
 begin
  XS:=0;Xi:=0;
  repeat
   Xi:=Xi+1; XS:=XS+ALongMois(Zannee,Xi);
  until XS>=ZQuant;
  str((ZQuant-XS+ALongMois(ZAnnee,Xi)+Xi/100):5:2,XC); if XC[1]=' ' then XC[1]:='0';
  ADateClaire:=XC;
 end;

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

function AQuantieme(Zjour,Zmois,ZAnnee:integer): integer;
 var Xi,XS:integer;
 begin
  Xs:=0;
  for Xi:=1 to ZMois-1 do Xs:=XS+ALongMois(ZAnnee,Xi);
  AQuantieme:=XS+Zjour;
 end;

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

function ATjour(ZAn,ZMois,ZJour:longint):longint;
{Calcule le numero du jour compt depuis le 31/12/1899 (1er jour).
 An est entr en anne sur 4 chiffres. Le calcul est  valable de 1901  2099.
 Remarquer que 1900 n'est pas bissextile}
{corrig 2000}
 const
  XN: array[1..12] of integer = (0,31,59,90,120,151,181,212,243,273,304,334);
 var XDeb: longint;
 begin
  ZAn:=Zan-1900;
  XDeb:= XN[ZMois]+Zjour+1+ZAn*365+ ((ZAn-1) div 4);
  if ((ZAn mod 4) = 0) and (ZMois > 2) then XDeb:=XDeb+1;
  ATjour := XDeb;
 end;

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


function ADate(ZRang:longint):string;
{ calcul de la date en clair  partir du jour compt depuis le 31/12/1899.
 Le calcul est valable  partir de 1901.}

{corrig 2000}

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

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

 function XNombjour(Zi:integer):integer;
  begin
   if (Zi mod 4)=0 then XNombjour:=366
   else XNombjour:=365;
  end;

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

 begin
  Xi:=1899; 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+ALongmois(Xi,Xj);
   end;
  XDuree:=XDuree-ALongmois(Xi,Xj);
  Xk:=ZRang-XDuree;
{
  str(Xk:2,XS1);
  str(Xj:2,XS2);
  str(Xi:4,XS3);
}
  str(Xk,XS1);
  if Xk<10 then
   XS1:='0'+XS1;
  str(Xj,XS2);
  if Xj<10 then
   XS2:='0'+XS2;
  str(Xi:4,XS3);
  ADate:=XS1+'/'+XS2+'/'+XS3;
 end;

{----------------------------------------------------------------------------}
{---Effacement du fichier portant le nom Nomfi                            ---}

procedure AEfface(ZNomfi:string);
 var
  Xfix:file of boolean;
 begin
  assign(XFix,ZNomfi);
  {$i-}; rewrite(Xfix); {$i+};
  if ioresult=0 then begin close(XFix); erase(Xfix); end;
 end;

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

BEGIN
END.