Discussion :

[Roland Chastain]

Bonjour !

Je souhaite partager avec vous un petit programme que j'ai fait aujourd'hui, une application console qui produit un simple calendrier au format texte.

Si j'ai le temps, j'ajouterai des options.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.