Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
IN-WOP
VGEST
Commits
4e9527bf
Commit
4e9527bf
authored
Mar 24, 2021
by
Dorchies David
Browse files
feat: remove leap year hanfling
Fix
#8
parent
28021b02
Changes
7
Hide whitespace changes
Inline
Side-by-side
src/CALCULS1.PAS
View file @
4e9527bf
...
...
@@ -378,9 +378,9 @@ procedure C1_LectureObjectif;
begin
val
(
copy
(
XChai
,
6
,
length
(
XChai
)-
5
),
XQ
,
XCode
);
if
XCode
=
0
then
if
(
XMois
>
0
)
and
(
XMois
<
13
)
and
(
XJour
>
0
)
and
(
XJour
<=
B_longMois
(
2001
,
XMois
))
and
(
XQ
>=
0
)
then
if
(
XMois
>
0
)
and
(
XMois
<
13
)
and
(
XJour
>
0
)
and
(
XJour
<=
B_longMois
(
XMois
))
and
(
XQ
>=
0
)
then
begin
XNouvelleDate
:=
B_Quantieme
(
XJour
,
XMois
,
2001
);
XNouvelleDate
:=
B_Quantieme
(
XJour
,
XMois
);
if
XNouvelleDate
>
YDateObj
[
YNbQXobj
]
then
begin
YNbQXobj
:=
YNbQXobj
+
1
;
...
...
@@ -997,7 +997,7 @@ Procedure C1_QRefRes(ZChrono : boolean; ZType,ZRangLac:integer;
val
(
copy
(
ZChaiDate
,
1
,
2
),
XJour
,
Xcode
);
val
(
copy
(
ZChaiDate
,
4
,
2
),
XMois
,
Xcode
);
val
(
copy
(
Zchaidate
,
7
,
4
),
XAn
,
XCode
);
XQuantieme
:=
B_Quantieme
(
XJour
,
XMois
,
2001
);
XQuantieme
:=
B_Quantieme
(
XJour
,
XMois
);
if
(
XMois
=
2
)
and
(
XJour
=
29
)
then
Xquantieme
:=
XQuantieme
-
1
;
for
Xi
:=
0
to
1
do
...
...
src/CALCULS2.PAS
View file @
4e9527bf
...
...
@@ -263,7 +263,7 @@ PROCEDURE C2_ISOFREQ (ZDateDebutFichier, ZDateDebut, ZDateFin:longint;
begin
{--BOUCLE SUR LES JOURS DU MOIS (en anne non bissextile)--}
for
XJour
:=
1
to
B_LongMois
(
2001
,
XMois
)
do
for
XJour
:=
1
to
B_LongMois
(
XMois
)
do
begin
{--calcul pour le jour courant, de la premire et de la dernire--}
...
...
src/CALCULS3.PAS
View file @
4e9527bf
...
...
@@ -60,7 +60,7 @@ procedure Ici_Calcul_Quantile_QMN(Zfreq: double);
begin
{--BOUCLE SUR LES JOURS DU MOIS (en anne non bissextile)--}
for
XJour
:=
1
to
B_LongMois
(
2001
,
XMois
)
do
for
XJour
:=
1
to
B_LongMois
(
XMois
)
do
begin
XQuant
:=
XQuant
+
1
;
...
...
src/INTERFAS.PAS
View file @
4e9527bf
...
...
@@ -304,7 +304,7 @@ procedure A_Saisidate(var Zjour,Zmois,Zan:integer; var ZDada:string; ZDadamin,ZD
val
(
copy
(
ZDada
,
1
,
2
),
Zjour
,
Bcode1
);
val
(
copy
(
ZDada
,
4
,
2
),
Zmois
,
Bcode2
);
val
(
copy
(
ZDada
,
7
,
4
),
Zan
,
Bcode3
);
XBon
:=((
Bcode1
=
0
)
and
(
Bcode2
=
0
)
and
(
Bcode3
=
0
)
and
(
Zmois
>
0
)
and
(
Zmois
<
13
)
and
(
Zjour
>
0
)
and
(
Zjour
<=
B_longmois
(
ZAn
,
ZMois
))
and
(
Zjour
>
0
)
and
(
Zjour
<=
B_longmois
(
ZMois
))
and
((
Zjour
+
100
*
ZMois
+
10000.0
*
ZAn
)<=
XMatouvu
)
and
((
Zjour
+
100
*
ZMois
+
10000.0
*
ZAn
)>=
XMinizup
))
or
(
ARangTouchSpecial
<>
0
);
if
not
XBon
then
...
...
src/PARAM.PAS
View file @
4e9527bf
...
...
@@ -135,7 +135,7 @@ procedure P_DatesLuesSurFichier;
if
(
YCode
=
0
)
and
(
YMois
[
0
]>
0
)
and
(
Ymois
[
0
]<
13
)
then
begin
val
(
copy
(
YDat1
,
1
,
2
),
YJour
[
0
],
YCode
);
if
(
YCode
=
0
)
and
(
YJour
[
0
]>
0
)
and
(
YJour
[
0
]<=
B_LongMois
(
YAn
,
YMois
[
0
]))
then
if
(
YCode
=
0
)
and
(
YJour
[
0
]>
0
)
and
(
YJour
[
0
]<=
B_LongMois
(
YMois
[
0
]))
then
begin
YDateDebut
:=
B_maxlongInt
(
YmeilleurDebut
,
B_minlongInt
(
B_TJour
(
YAn
,
YMois
[
0
],
YJour
[
0
]),
YMeilleurFin
-
3
*
365
));
end
;
...
...
@@ -148,7 +148,7 @@ procedure P_DatesLuesSurFichier;
if
(
YCode
=
0
)
and
(
YMois
[
0
]>
0
)
and
(
Ymois
[
0
]<
13
)
then
begin
val
(
copy
(
YDat2
,
1
,
2
),
YJour
[
0
],
YCode
);
if
(
YCode
=
0
)
and
(
YJour
[
0
]>
0
)
and
(
YJour
[
0
]<=
B_LongMois
(
YAn
,
YMois
[
0
]))
then
if
(
YCode
=
0
)
and
(
YJour
[
0
]>
0
)
and
(
YJour
[
0
]<=
B_LongMois
(
YMois
[
0
]))
then
YDateFin
:=
B_minlongInt
(
B_maxlongInt
(
YDateDebut
+
3
*
365
,
B_TJour
(
YAn
,
Ymois
[
0
],
YJour
[
0
])),
YmeilleurFin
);
end
;
end
;
...
...
src/UTILIT.PAS
View file @
4e9527bf
...
...
@@ -45,9 +45,9 @@ 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
(
ZAn
,
ZMois
:
integer
):
integer
;
function
B_Longmois
(
ZMois
:
integer
):
integer
;
function
B_DateClaire
(
ZAnnee
,
ZQuant
:
integer
):
BChai5
;
{date en clair partir du quantieme}
function
B_Quantieme
(
Zjour
,
Zmois
,
ZAnnee
:
integer
):
integer
;
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
;
...
...
@@ -101,20 +101,14 @@ function B_MinDouble (ZD1,ZD2:Bprecis1) :Bprecis1;
{----------------------------------------------------------------------------}
function
B_Longmois
(
ZAn
,
ZMois
:
integer
):
integer
;
function
B_Longmois
(
ZMois
:
integer
):
integer
;
{donne le nombre de jours du mois Mois de l'annee An, en tenant compte pour }
{fvrier du caractre bissextile ou non de l'anne. Une anne est bissextile}
{si elle est multiple de 4 et non divisible par 100, ou bien si elle est }
{multiple de 400. }
var
XL
:
integer
;
begin
XL
:=
BLong
[
ZMois
];
{if (ZMois=2) and ((ZAn mod 4) = 0) then XL:=XL+1;}
if
(
ZMois
=
2
)
and
((
Zan
mod
4
)
=
0
)
and
(((
Zan
mod
100
)
<>
0
)
or
((
Zan
mod
400
)
=
0
))
then
XL
:=
XL
+
1
;
B_LongMois
:=
XL
;
B_LongMois
:=
BLong
[
ZMois
];
end
;
{----------------------------------------------------------------------------}
...
...
@@ -128,21 +122,21 @@ function B_DateClaire(ZAnnee,ZQuant:integer):BChai5;
begin
XS
:=
0
;
Xi
:=
0
;
repeat
Xi
:=
Xi
+
1
;
XS
:=
XS
+
B_LongMois
(
Zannee
,
Xi
);
Xi
:=
Xi
+
1
;
XS
:=
XS
+
B_LongMois
(
Xi
);
until
XS
>=
ZQuant
;
str
((
ZQuant
-
XS
+
B_LongMois
(
ZAnnee
,
Xi
)+
Xi
/
100
):
5
:
2
,
XC
);
if
XC
[
1
]=
' '
then
XC
[
1
]:=
'0'
;
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
,
ZAnnee
:
integer
):
integer
;
function
B_Quantieme
(
Zjour
,
Zmois
:
integer
):
integer
;
{--calcul du quantime partir du jour, du mois et de l'anne, pour une --}
{--anne bissextile ou non. --}
var
Xi
,
XS
:
integer
;
begin
Xs
:=
0
;
for
Xi
:=
1
to
ZMois
-
1
do
Xs
:=
XS
+
B_LongMois
(
ZAnnee
,
Xi
);
for
Xi
:=
1
to
ZMois
-
1
do
Xs
:=
XS
+
B_LongMois
(
Xi
);
B_Quantieme
:=
XS
+
Zjour
;
end
;
...
...
@@ -161,7 +155,7 @@ function B_QuantiemeNonBiss(ZDate:longint) : integer;
XChaineDate
:=
B_Date
(
ZDate
);
val
(
copy
(
XChaineDate
,
1
,
2
),
XJour
,
XCode
);
val
(
copy
(
XChaineDate
,
4
,
2
),
XMois
,
XCode
);
B_QuantiemeNonBiss
:=
B_Quantieme
(
XJour
,
XMois
,
2001
);
B_QuantiemeNonBiss
:=
B_Quantieme
(
XJour
,
XMois
);
end
;
{----------------------------------------------------------------------------}
...
...
@@ -233,9 +227,9 @@ function B_Date(ZRang:longint):string;
Xj
:=
0
;
while
XDuree
<
ZRang
do
begin
Xj
:=
Xj
+
1
;
XDuree
:=
XDuree
+
B_Longmois
(
Xi
,
Xj
);
Xj
:=
Xj
+
1
;
XDuree
:=
XDuree
+
B_Longmois
(
Xj
);
end
;
XDuree
:=
XDuree
-
B_Longmois
(
Xi
,
Xj
);
XDuree
:=
XDuree
-
B_Longmois
(
Xj
);
Xk
:=
ZRang
-
XDuree
;
str
(
Xk
,
XS1
);
if
Xk
<
10
then
...
...
src/VGEST.PAS
View file @
4e9527bf
...
...
@@ -630,7 +630,7 @@ BEGIN
YJJ_MM_AAAA
[
0
]:=
B_Date
(
YDateEnJour
[
0
]);
val
(
copy
(
YJJ_MM_AAAA
[
0
],
4
,
2
),
YMois
[
0
],
YCode
);
val
(
copy
(
YJJ_MM_AAAA
[
0
],
1
,
2
),
YJour
[
0
],
YCode
);
YQuantieme
:=
B_Quantieme
(
YJour
[
0
],
YMois
[
0
]
,
2001
);
YQuantieme
:=
B_Quantieme
(
YJour
[
0
],
YMois
[
0
]);
{--LECTURE DES DEBITS NATURELS pour l'indice YDelaimax--}
C1_LectureQavalPriseRestit
(
Ydelaimax
);
...
...
Dorchies David
@david.dorchies
mentioned in commit
14dc2c8b
·
Mar 26, 2021
mentioned in commit
14dc2c8b
mentioned in commit 14dc2c8bebe87ef220de4ab385ab23f9da6c2616
Toggle commit list
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment