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
|
{ Calendrier. }
{.$DEFINE USETHLIST}
uses
SysUtils, Classes{$IFDEF USETHLIST}, ThList{$ENDIF};
const
NOM: array[1..12] of string = (
'Janvier',
'Février',
'Mars',
'Avril',
'Mai',
'Juin',
'Juillet',
'Août',
'Septembre',
'Octobre',
'Novembre',
'Décembre'
);
NOMSJOURS = ' Di Lu Ma Me Je Ve Sa';
function JourSemaine(const annee, mois, jour: word; const julien: boolean = FALSE): word;
{
Jour de la semaine pour une date donnée.
Le résultat est donné sous la forme d'un nombre entier de zéro à six, où zéro signifie dimanche.
https://www.tondering.dk/claus/cal/chrweek.php
}
var
a, y, m: word;
begin
a := (14 - mois) div 12;
y := annee - a;
m := mois + 12 * a - 2;
result := jour + y + y div 4 + 31 * m div 12;
if julien
then result := result + 5 { Pour une date du calendrier julien. }
else result := result - y div 100 + y div 400; { Pour une date du calendrier grégorien. }
result := result mod 7;
end;
function Bissextile(const annee: word): boolean;
begin
result := (annee mod 4 = 0) and ((annee mod 100 <> 0) or (annee mod 400 = 0));
end;
function NombreCaracteres(s: string): integer;
begin
s := {$IFDEF USETHLIST}ThList.RemoveAccent(s){$ELSE}Utf8ToAnsi(s){$ENDIF};
result := Length(s);
end;
function LigneTitre(const s: string; const n: integer): string;
var
i, j: integer;
begin
i := n - NombreCaracteres(s);
j := i div 2;
result := Concat(StringOfChar(' ', j), s, StringOfChar(' ', i - j));
end;
function Calendrier(const annee: word): TStringList;
var
nj: array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
procedure ConstruireListeMois(const mois: word; lst: TStrings);
var
jm: word;
s: string;
js: integer;
i: integer;
begin
lst.Append(LigneTitre(NOM[mois], 7 * 3));
lst.Append(NOMSJOURS);
js := JourSemaine(annee, mois, 1);
s := StringOfChar(' ', 3 * js);
for jm := 1 to nj[mois] do
s := Concat(s, Format('%3d', [jm]));
s := Concat(s, StringOfChar(' ', (42 - nj[mois] - js) * 3));
for i := 1 to 6 do
lst.Append(Copy(s, 7 * 3 * Pred(i) + 1, 7 * 3));
end;
var
listes: array [1..12] of TStringList;
i, j, k: integer;
s: string;
begin
if Bissextile(annee) then
Inc(nj[2]);
result := TStringList.Create;
for i := 1 to 12 do
begin
listes[i] := TStringList.Create;
ConstruireListeMois(i, listes[i]);
end;
result.Append('');
result.Append(LigneTitre(Format('Année %d', [annee]), 3 * (7 * 3 + 3)));
for i := 0 to 3 do
begin
result.Append('');
for j := 0 to 7 do
begin
s := '';
for k := 1 to 3 do
s := Concat(s, ' ', listes[k + i * 3][j]);
result.Append(s);
end;
end;
for i := 1 to 12 do
listes[i].Free;
end;
var
annee: word;
cal: TStringList;
begin
annee := StrToIntDef(ParamStr(1), CurrentYear);
cal := Calendrier(annee);
WriteLn(cal.Text);
cal.SaveToFile(Format('calendrier%d.txt', [annee]));
cal.Free;
end. |