Calendrier

' *******************************************************************
' Calendrier - D'apres un programme PANORAMIC de Jean-Claude
' *******************************************************************

' -------------------------------------------------------------------
' Constantes et variables globales
' -------------------------------------------------------------------

dim_widget fmMain
dim_widget alDate, btAnPrec, btMoisPrec, btMoisSuiv, btAnSuiv
dim_widget btJour(5,6), alJour(6)

dim jour$(7)     ' Noms des jours
dim mois$(12)    ' Noms des mois
dim njours%(12)  ' Nb de jours de chaque mois
dim feries$      ' Liste des jours feries
dim m%, a%       ' Mois, annee

' -------------------------------------------------------------------
' Donnees du programme
' -------------------------------------------------------------------

data "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche"

data "Janvier", 31, "Février", 28, "Mars", 31
data "Avril", 30, "Mai", 31, "Juin", 30, "Juillet", 31, "Août", 31
data "Septembre", 30, "Octobre", 31, "Novembre", 30, "Décembre", 31

' -------------------------------------------------------------------
' Creation de l'interface et lancement de l'application
' -------------------------------------------------------------------

Read_Data()
Create_GUI()

m = val(mid(fdate(), 4, 2))  ' Mois en cours
a = val(mid(fdate(), 7))     ' Annee en cours
feries = Jours_Feries(a)     ' Jours feries pour l'annee en cours

Display()                    ' Afficher le calendrier

start fmMain

' -------------------------------------------------------------------
' Sous-programme de lecture des donnees et creation de l'interface
' -------------------------------------------------------------------

sub Read_Data()

  dim i%

  for i = 1 to 7
    read jour(i)
  next i

  for i = 1 to 12
    read mois(i), njours(i)
  next i
end_sub

sub Create_GUI()

  dim i%

  widget fmMain, T_Form, 100, 100, 260, 285, "Calendrier"

  matwidget btJour(), T_Button, 12, 75, 25, 25, 10, 10, CLICK_Jour

  widget btAnPrec,   T_Button,   7, 10, 28, 25, "@<<", CLICK_Mois_Annee
  widget btMoisPrec, T_Button,  40, 10, 25, 25, "@<" , CLICK_Mois_Annee
  widget btMoisSuiv, T_Button, 195, 10, 25, 25, "@>" , CLICK_Mois_Annee
  widget btAnSuiv,   T_Button, 225, 10, 28, 25, "@>>", CLICK_Mois_Annee
  
  color_caption_fl btAnPrec,   FL_GREEN
  color_caption_fl btMoisPrec, FL_GREEN
  color_caption_fl btMoisSuiv, FL_GREEN
  color_caption_fl btAnSuiv,   FL_GREEN

  hint btAnPrec,   "Annee precedente"
  hint btMoisPrec, "Mois precedent"
  hint btMoisSuiv, "Mois suivant"
  hint btAnSuiv,   "Annee suivante"

  widget alDate, T_Alpha, 70, 10, 120, 25
  set_box_type alDate, FL_BORDER_BOX
  font_caption alDate, FL_TIMES_BOLD, 16
  color_caption_fl alDate, FL_DARK_GREEN

  rowwidget alJour(), T_Alpha, 12, 45, 25, 25

  for i = 0 to 6
    caption alJour(i), left(jour(i + 1), 2)
  next i
end_sub

' -------------------------------------------------------------------
' Sous-programmes utilitaires
' -------------------------------------------------------------------

function Paques$ (an%)
' Retourne la date de Paques d'une annee donnee (an)
' Exemple : Paques(2020) = "12/04"
' D'apres un programme en Python :
' http://python.jpvweb.com/python/mesrecettespython/doku.php?id=date_de_paques

  dim a%, b%, c%, d%, e%, f%, g%, h%, j%, k%, m%, t%

  a = an \ 100
  b = an mod 100
  t = 3 * (a + 25)
  c = t \ 4
  d = t mod 4
  e = (8 * (a + 11)) \ 25
  f = (5 * a + b) mod 19
  g = (19 * f + c - e) mod 30
  h = (f + 11 * g) \ 319
  t = 60 * (5 - d) + b
  j = t \ 4
  k = t mod 4
  m = (2 * j - k - g + h) mod 7
  t = g - h + m + 114
  m = t \ 31
  j = t mod 31 + 1

  return dec(j, "00") + "/" + dec(m, "00")
end_function

function JF3$ (an%)
' Calcule les dates des 3 jours feries : Lundi de Paques,
' Jeudi de l'Ascension et Lundi de Pentecote pour l'annee an
' Exemple : JF3(2020) = "13/04 21/05 01/06"

  dim n%, d$(3)

  d(0) = Paques(an) & "/" & an  ' Paques

  n = str_to_date(d(0))

  d(1) = fdate(n + 1)   ' Lundi de Paques
  d(2) = fdate(n + 39)  ' Jeudi de l'Ascension
  d(3) = fdate(n + 50)  ' Lundi de Pentecote

  return left(d(1), 5) + " " + left(d(2), 5) + " " + left(d(3), 5)
end_function

function Jours_Feries$ (an%)
' Retourne la liste des jours feries pour l'annee an

  return JF3(an) + " 01/01 01/05 08/05 14/07 15/08 01/11 11/11 25/12"
end_function

sub Calendrier (mois%, an%, jour1%, jour2%)
' Calcule le calendrier pour le mois et l'annee
' Les jours sont numerotes a partir du jour de la semaine
' correspondant au 1er du mois (1 = Lundi etc.)
' Exemple : Octobre 2020 ==> jour1 = 4 (Jeudi), jour2 = 4 + 31 - 1 = 34

  dim date1$, date2$

  date1 = "1/" & mois & "/" & an  ' 1er du mois
  jour1 = day_of_week(date1)      ' Jour du 1er du mois

  jour2 = jour1 + njours(mois) - 1

  if mois = 2 then
    date2 = "29/2/" & an                                ' 29 fevrier ?
    if str_to_date(date2) > 0 then jour2 = jour2 + 1  ' ==> Annee bissextile
  end_if
end_sub

sub Display()
' Affiche le calendrier pour le mois m et l'annee a

  dim i%, j%, k%, j1%, j2%, n%, date1$, col%

  Calendrier m, a, j1, j2

  k = 1
  for i = 0 to 5
    for j = 0 to 6
      if k < j1 or k > j2 then
        hide btJour(i,j)
      else
        n = k - j1 + 1
        caption btJour(i,j), str(n)
        date1 = dec(n, "00") + "/" + dec(m, "00")
        if instr(feries, date1) > 0 then col = FL_BLUE else col = FL_BLACK
        color_caption_fl btJour(i,j), col
        show btJour(i,j)
      end_if
      k = k + 1
    next j
  next i

  caption alDate, mois(m) & " " & a
end_sub

' -------------------------------------------------------------------
' Sous-programmes associes aux evenements
' -------------------------------------------------------------------

sub CLICK_Mois_Annee ()

  dim n%, a1%

  if widget_self(btAnPrec) then
    n = 1
  elseif widget_self(btMoisPrec) then
    n = 2
  elseif widget_self(btMoisSuiv) then
    n = 3
  else
    n = 4
  end_if

  select n
    case 1
      if a > 1583 then a1 = a - 1
    case 2
      if m = 1 then m = 12 : a1 = a - 1 else m = m - 1 : a1 = a
    case 3
      if m = 12 then m = 1 : a1 = a + 1 else m = m + 1 : a1 = a
    case 4
      if a < 4099 then a1 = a + 1
  end_select

  if a1 <> a then feries = Jours_Feries(a1) : a = a1

  Display()
end_sub

sub CLICK_Jour ()
' Choisit une date et ecrit le resultat sous la forme : Jeudi 01/10/2020

  dim i%, j%, jour1$, date1$

  for i = 0 to 5
    for j = 0 to 6
      if widget_self(btJour(i,j)) then
        get_caption btJour(i,j), jour1
        date1 = jour1 & "/" & m & "/" & a
      end if
    next j
  next i
  
  print jour(day_of_week(date1)) + " " + date1
end_sub