A voir également:
- Pascal
- Turbo pascal download - Télécharger - Édition & Programmation
- My pascal - Télécharger - Édition & Programmation
- Uses crt pascal - Forum Pascal
- Pascal veut modifier une photo mais c’est la visionneuse d’images qui l’ouvre. que doit-il choisir pour l’ouvrir avec son logiciel de traitement d’image ? - Forum Windows
- Dev-pascal - Télécharger - Édition & Programmation
3 réponses
KX
Messages postés
16668
Date d'inscription
samedi 31 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2023
3 005
19 janv. 2009 à 10:18
19 janv. 2009 à 10:18
unit CalendrierGregorien;
// Cette unité calcule les jours dans le calendrier grégorien
// La réforme de 1582 prévoyant des exceptions jusqu'en 1900, tous les calculs
// qui pourraient être fait avec des dates avant 1901 seront approximatifs
////////////////////////////////////////////////////////////////////////////////
interface
////////////////////////////////////////////////////////////////////////////////
type jour=record
j,m,a:integer;
end;
procedure Initialiser(var jma:jour); // au 01-01-1901
procedure ReadlnJour(var jma:jour); // format jj/mm/aaaa
procedure WriteJour(var jma:jour); // ex: "Mardi 01/01/1901"
procedure WritelnJour(var jma:jour);
function EstBissextile(a:integer):boolean;
function IndiceJour(jma:jour):integer; // le 01/01/0000 donne 1
function JourSemaine(n:integer):string; // ex: "Vendredi"
function RechercheJour(n:integer):jour; // recherche la date telle que
// IndiceJour(jj/mm/aaaa)=n
function EcartJours(jma1,jma2:jour):integer;// nombre de jours entre deux dates
function JourPlus(jma:jour;n:integer):jour; // rajoute n jours à la date jma
////////////////////////////////////////////////////////////////////////////////
implementation
////////////////////////////////////////////////////////////////////////////////
procedure Initialiser(var jma:jour);
begin
jma.j:=1; jma.m:=1; jma.a:=1901;
end;
procedure ReadlnJour(var jma:jour);
begin
writeln;
writeln('Entrez le jour, le mois, et l''annee');
write('Jour : '); readln(jma.j);
write('Mois : '); readln(jma.m);
write('Annee : '); readln(jma.a);
if jma.a<1901 // voir la note sur le calendrier grégorien (au début du code)
then writeln('Attention les calculs avec cette date seront approximatifs');
writeln;
end;
function EstBissextile(a:integer):boolean;
begin
result:=false;
if a mod 004=0 then result:=true;
if a mod 100=0 then result:=false;
if a mod 400=0 then result:=true;
end;
function IndiceJour(jma:jour):integer;
var b,r,t:integer;
begin
b:=1 // b est le nombre de 29 février dans les années précédentes
+(jma.a-1) div 4
-(jma.a-1) div 100
+(jma.a-1) div 400;
if EstBissextile(jma.a) // t est le nombre de 29 février dans l'année en cours
then t:=1
else t:=0;
jma.m:=((jma.m-1) mod 12)+1; // évite une erreur si jma.m<1 ou jma.m>12
case jma.m of // r est le nombre de jours écoulés dans l'année courante
// on compte le 29 février des années bissextiles à partir de mars
01: r:=000+jma.j;
02: r:=031+jma.j;
03: r:=059+jma.j+t;
04: r:=090+jma.j+t;
05: r:=120+jma.j+t;
06: r:=151+jma.j+t;
07: r:=181+jma.j+t;
08: r:=212+jma.j+t;
09: r:=243+jma.j+t;
10: r:=273+jma.j+t;
11: r:=304+jma.j+t;
12: r:=334+jma.j+t;
end;
result:=365*jma.a+b+r;
end;
function JourSemaine(n:integer):string;
begin
// pour le vendredi 01-01-1999 on a IndiceJour=730121 multiple de 7
case (n mod 7) of
0:result:='Vendredi';
1:result:='Samedi';
2:result:='Dimanche';
3:result:='Lundi';
4:result:='Mardi';
5:result:='Mercredi';
6:result:='Jeudi';
end;
end;
function RechercheJour(n:integer):jour;
var a,m,j,x:integer;
begin
x:=trunc(real(n)/365.2425);
// x est une approximation de l'année à 1 an près, on fait une recherche
// sur l'année d'avant et l'année d'après pour avoir un résultat correct
// de plus on cherche à l'envers pour éviter des absurdités
// par exemple on trouve "01 mai" avant de trouver "31 avril"
for a:=(x+1) downto (x-1) do
begin
result.a:=a;
for m:=12 downto 1 do
begin
result.m:=m;
for j:=31 downto 1 do
begin
result.j:=j;
if IndiceJour(result)=n then exit;
end;
end;
end;
writeln('Erreur avec RechercheJour(',n,')'); // résultat par défaut : 01/01/x-1
end;
procedure WriteJour(var jma:jour);
begin
write(JourSemaine(IndiceJour(jma)):8,' ');
if jma.j<10 then write('0');
write(jma.j,'/');
if jma.m<10 then write('0');
write(jma.m,'/',jma.a);
end;
procedure WritelnJour(var jma:jour);
begin
WriteJour(jma);
writeln;
end;
function EcartJours(jma1,jma2:jour):integer;
begin
result:=abs(IndiceJour(jma1)-IndiceJour(jma2));
end;
function JourPlus(jma:jour;n:integer):jour;
begin
result:=RechercheJour(IndiceJour(jma)+n)
end;
begin
end.
KX
Messages postés
16668
Date d'inscription
samedi 31 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2023
3 005
16 janv. 2009 à 09:40
16 janv. 2009 à 09:40
Je n'ai pas regardé la partie arithmétique du problème mais j'ai corrigé les erreurs en les commentant...
program date; // un seul m à program
var c,y,jour,mois,annee:integer; // il faut déclarer c et y
begin
writeln('donne une date : '); // le : à l'intérieur des guillemets
// il faut faire la lecture des paramètres
write('le jour : '); readln(jour);
write('le mois : '); readln(mois);
write('l''annee : '); readln(annee);
if mois>2 then
mois:=mois-2 // jamais de ; avant else
else
mois:=mois+10;
annee:=annee-1;
y:=annee mod 100;
c:=annee div 100;
jour:=(jour+(13*mois-1) div 5 +y+y div 4+c div 4+5*c)mod 7; // il manque un ;
writeln(jour); // Remarque : ici l'affichage est un entier, on pourrait faire :
case jour of
1:writeln('lundi');
2:writeln('mardi');
3:writeln('mercredi');
4:writeln('jeudi');
5:writeln('vendredi');
6:writeln('samedi');
7:writeln('dimanche');
end;
// le programme doit attendre que l'utilisateur ait fini de lire le résultat
writeln; write('Fin du programme. Appuyer sur Entree'); readln;
end.
KX
Messages postés
16668
Date d'inscription
samedi 31 mai 2008
Statut
Modérateur
Dernière intervention
17 mars 2023
3 005
16 janv. 2009 à 10:06
16 janv. 2009 à 10:06
En fait j'ai juste supposé pour corriger que ta formule "jour:=(jour+(13*mois-1) div 5 +y+y div 4+c div 4+5*c)mod 7;" était correcte et suffisante même si apparemment ce n'est pas le cas...
Ce programme je l'ai déjà fait (et je veux pas le refaire) alors je te le donnerais dès que je l'aurai retrouvé...
Ce programme je l'ai déjà fait (et je veux pas le refaire) alors je te le donnerais dès que je l'aurai retrouvé...
19 janv. 2009 à 13:09