Calcul des jours fériés francais.

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Répondre
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Calcul des jours fériés francais.

Message par Flype »

J'en avais besoin pour le travail,
voici un lot de fonctions pour gérer les jours fériés.

En fait c'est très simple, la plupart sont des dates fixes/prédéfinies,
sauf pour le calcul de Pâques qui lui est compliqué et il existe plusieurs algorithmes pour çà.
A savoir que le calcul de la Pentecôte et de l'Ascension dépendent de Pâques.

Cela permet par exemple de calculer les jours de travail ouvrables / non ouvrables.

Code : Tout sélectionner

;####################################################### flype, 24-mai-2007.
;### Algorithmes de calcul des jours fériés français ### 
;####################################################### 

EnableExplicit

Enumeration 0 ;{
  #PAQUES_DELAMBRE
  #PAQUES_GAUSS
  #PAQUES_MALLEN
  #PAQUES_OUDIN
  #PAQUES_REINTS
EndEnumeration ;}
Enumeration 0 ;{
  #JOUR_DIMANCHE
  #JOUR_LUNDI
  #JOUR_MARDI
  #JOUR_MERCREDI
  #JOUR_JEUDI
  #JOUR_VENDREDI
  #JOUR_SAMEDI
  #JOUR_NOUVELAN
  #JOUR_PAQUES
  #JOUR_PAQUESLUNDI
  #JOUR_FETEDUTRAVAIL
  #JOUR_VICTOIRE1945
  #JOUR_PENTECOTE
  #JOUR_PENTECOTELUNDI
  #JOUR_ASCENSION
  #JOUR_FETENATIONALE
  #JOUR_ASSOMPTION
  #JOUR_TOUSSAINT
  #JOUR_ARMISTICE
  #JOUR_NOEL
EndEnumeration ;}

Procedure.s StrDate(mask.s, date.l) 
  
  mask = ReplaceString(mask, "%dddd", StringField("Dimanche,Lundi,Mardi,Mercredi,Jeudi,Vendredi,Samedi", DayOfWeek(date) + 1, ","))
  mask = ReplaceString(mask, "%ddd",  StringField("Dim.,Lun.,Mar.,Mer.,Jeu.,Ven.,Sam.", DayOfWeek(date) + 1, ","))
  mask = ReplaceString(mask, "%mmmm", StringField("Janvier,Février,Mars,Avril,Mai,Juin,Juillet,Août,Septembre,Octobre,Novembre,Décembre", Month(date), ","))
  mask = ReplaceString(mask, "%mmm",  StringField("Janv.,Févr.,Mars,Avr.,Mai,Juin,Juil.,Août,Sept.,Oct.,Nov.,Déc.", Month(date), ","))
  
  ProcedureReturn FormatDate(mask, date)
  
EndProcedure

Procedure.l Paques_Delambre(annee.l) ; private
  
  ;/ http://www.chez.com/cosmos2000/Vendredi13/DelambreAlgorithme.html
  
  Protected a, b, c, d, e
  
  a = ( annee % 19 )
  b = ( annee / 100 )
  c = ( annee % 100 )
  d = ( ( 19 * a + b - ( b / 4 ) - ( ( b - ( ( b + 8 ) / 25 ) + 1 ) / 3 ) + 15 ) % 30 )
  e = ( ( 32 + 2 * ( b % 4 ) + 2 * ( c / 4 ) - d - ( c % 4 ) ) % 7 )
  
  ProcedureReturn ( 22 + d + e - 7 * ( ( a + 11 * d + 22 * e ) / 451 ) )
  
EndProcedure
Procedure.l Paques_Gauss(annee.l) ; private 
  
  ;/ http://www.chez.com/cosmos2000/Vendredi13/GaussAlgorithme.html
  
  Protected a, b, c, d, e, f, m, n
  
  a = ( annee / 100 )
  b = ( a - a / 4 )
  c = ( 8 * a + 13 ) / 25 
  m = ( 15 + b - c ) % 30 
  n = ( 4 + b ) % 7 
  a = ( annee % 19 )
  b = ( annee % 4 )
  c = ( annee % 7 )
  d = ( 19 * a + m ) % 30
  e = ( 2 * b + 4 * c + 6 * d + n ) % 7
  f = ( 22 + d + e ) 
  If ( f = 57 ) Or ( ( f = 56 ) And ( e = 6 ) And ( a > 10 ) ) : f - 7 : EndIf
  
  ProcedureReturn f
  
EndProcedure
Procedure.l Paques_Mallen(annee.l) ; private 
  
  ;/ http://www.chez.com/cosmos2000/Vendredi13/MallenMethode.html
  
  Protected a, b, c, d, e, f, g, h
  
  a = ( annee % 19 )
  b = ( annee / 100 )
  c = ( annee % 100 )
  d = ( 202 + ( b - 15 ) / 2 - 11 * a )
  If ( b > 26 ) : d - 1 : EndIf
  If ( b > 38 ) : d - 1 : EndIf
  Select b : Case 21, 24, 25, 33, 36, 37 : d - 1 : EndSelect
  d % 30
  If ( d = 29 ) Or ( ( d = 28 ) And ( a > 10 ) ) : d - 1 : EndIf
  e = ( d + 21 )
  f = ( ( e - 19 ) % 7 )
  g = ( ( 40 - b ) % 4 )
	h = ( ( c + c / 4 ) % 7 )
  If ( g = 3 ) : g + 1 : EndIf
  If ( g > 1 ) : g + 1 : EndIf
  
  ProcedureReturn ( e + ( 20 - f - g - h ) % 7 + 1 )
  
EndProcedure
Procedure.l Paques_Oudin(annee.l) ; private 
  
  ;/ http://www.chez.com/cosmos2000/Vendredi13/OudinTonderingAlgorithme.html
  
  Protected a, b, c, d, e, f, g, h, i, j
  
  a = ( annee % 19) 
  b = ( annee / 100 )
  c = ( b - b / 4 )
  d = ( ( 8 * b + 13 ) / 25 )
  e = ( ( c - d + ( 19 * a ) + 15 ) % 30 ) 
  f = ( e / 28 )
  g = ( 29 / ( e + 1 ) )
  h = ( ( 21 - a ) / 11 )
  i = ( e - f * ( 1 - f * g * h ) )
  j = ( ( annee + annee / 4 + i + 2 - c ) % 7 )
  
  ProcedureReturn ( 28 + i - j )
  
EndProcedure
Procedure.l Paques_Reints(annee.l) ; private 
  
  ;/ http://www.chez.com/cosmos2000/Vendredi13/ReintsAlgorithme.html
  
  Protected a, b, c, d, e
  
  a = ( annee % 19 )
  b = ( annee / 100 )
  c = ( ( 3 * b - 5 ) / 4 )
  d = ( ( ( 12 + 11 * a + ( 8 * b + 13 ) / 25 - c ) % 30 + 30 ) % 30 )
  If ( d = 0 ) Or ( ( d = 1 ) And ( a > 10 ) ) : e = ( 56 - d ) : Else : e = ( 57 - d ) : EndIf
  
  ProcedureReturn ( e - ( e + ( 5 * annee ) / 4 - c ) % 7 )
  
EndProcedure

Procedure.l NouvelAn(annee.l = -1)
  
  If annee = -1
    annee = Year(Date())
  EndIf
  
  ProcedureReturn Date(annee, 1, 1, 0, 0, 0)
  
EndProcedure
Procedure.l Paques(annee.l = -1, algorithme.l = #PAQUES_DELAMBRE)
  
  Protected jour, mois = 3
  
  If annee = -1
    annee = Year(Date())
  EndIf
  
  Select algorithme
    Case #PAQUES_DELAMBRE: jour = Paques_Delambre(annee)
    Case #PAQUES_GAUSS:    jour = Paques_Gauss(annee)
    Case #PAQUES_MALLEN:   jour = Paques_Mallen(annee)
    Case #PAQUES_OUDIN:    jour = Paques_Oudin(annee)
    Case #PAQUES_REINTS:   jour = Paques_Reints(annee)
  EndSelect
  
  If jour 
    If jour > 31 
      jour - 31 : mois + 1 
    EndIf 
    ProcedureReturn Date(annee, mois, jour, 0, 0, 0) 
  EndIf 
  
EndProcedure
Procedure.l PaquesLundi(annee.l = -1)
  
  ProcedureReturn AddDate(Paques(annee), #PB_Date_Day, 1)
  
EndProcedure 
Procedure.l FeteDuTravail(annee.l = -1)
  
  If annee = -1
    annee = Year(Date())
  EndIf
  
  ProcedureReturn Date(annee, 5, 1, 0, 0, 0)
  
EndProcedure
Procedure.l Victoire1945(annee.l = -1)
  
  If annee = -1
    annee = Year(Date())
  EndIf
  
  ProcedureReturn Date(annee, 5, 8, 0, 0, 0)
  
EndProcedure
Procedure.l Pentecote(annee.l = -1)
  
  ProcedureReturn AddDate(Paques(annee), #PB_Date_Week, 7)
  
EndProcedure
Procedure.l PentecoteLundi(annee.l = -1)
  
  ProcedureReturn AddDate(Pentecote(annee), #PB_Date_Day, 1)
  
EndProcedure
Procedure.l Ascension(annee.l = -1)
  
  ProcedureReturn AddDate(Pentecote(annee), #PB_Date_Day, -10)
  
EndProcedure
Procedure.l FeteNationale(annee.l = -1)
  
  If annee = -1
    annee = Year(Date())
  EndIf
  
  ProcedureReturn Date(annee, 7, 14, 0, 0, 0)
  
EndProcedure
Procedure.l Assomption(annee.l = -1)
  
  If annee = -1
    annee = Year(Date())
  EndIf
  
  ProcedureReturn Date(annee, 8, 15, 0, 0, 0)
  
EndProcedure
Procedure.l Toussaint(annee.l = -1)
  
  If annee = -1
    annee = Year(Date())
  EndIf
  
  ProcedureReturn Date(annee, 11, 1, 0, 0, 0)
  
EndProcedure
Procedure.l Armistice(annee.l = -1)
  
  If annee = -1
    annee = Year(Date())
  EndIf
  
  ProcedureReturn Date(annee, 11, 11, 0, 0, 0)
  
EndProcedure
Procedure.l Noel(annee.l = -1)
  
  If annee = -1
    annee = Year(Date())
  EndIf
  
  ProcedureReturn Date(annee, 12, 25, 0, 0, 0)
  
EndProcedure

Procedure.l Jour(date.l)
  
  Protected annee.l = Year(date)
  
  Select date
    Case NouvelAn(annee):       ProcedureReturn #JOUR_NOUVELAN
    Case Paques(annee):         ProcedureReturn #JOUR_PAQUES
    Case PaquesLundi(annee):    ProcedureReturn #JOUR_PAQUESLUNDI
    Case FeteDuTravail(annee):  ProcedureReturn #JOUR_FETEDUTRAVAIL
    Case Victoire1945(annee):   ProcedureReturn #JOUR_VICTOIRE1945
    Case Ascension(annee):      ProcedureReturn #JOUR_PENTECOTE
    Case Pentecote(annee):      ProcedureReturn #JOUR_PENTECOTELUNDI
    Case PentecoteLundi(annee): ProcedureReturn #JOUR_ASCENSION
    Case FeteNationale(annee):  ProcedureReturn #JOUR_FETENATIONALE
    Case Assomption(annee):     ProcedureReturn #JOUR_ASSOMPTION
    Case Toussaint(annee):      ProcedureReturn #JOUR_TOUSSAINT
    Case Armistice(annee):      ProcedureReturn #JOUR_ARMISTICE
    Case Noel(annee):           ProcedureReturn #JOUR_NOEL
  EndSelect
  
  ProcedureReturn DayOfWeek(date) 
  
EndProcedure

DisableExplicit

;###############################################
;### Test 1
;###############################################

mask.s = "%dddd %dd %mmmm %yyyy"

For annee = 1998 To 2010
  Debug "Nouvel An: "          + StrDate(mask, NouvelAn(annee))
  Debug "Pâques: "             + StrDate(mask, Paques(annee))
  Debug "Lundi de Paques: "    + StrDate(mask, PaquesLundi(annee))
  Debug "Fête Du Travail: "    + StrDate(mask, FeteDuTravail(annee))
  Debug "Victoire de 1945: "   + StrDate(mask, Victoire1945(annee))
  Debug "Ascension: "          + StrDate(mask, Ascension(annee))
  Debug "Pentecôte: "          + StrDate(mask, Pentecote(annee))
  Debug "Lundi de Pentecôte: " + StrDate(mask, PentecoteLundi(annee))
  Debug "Fête Nationale: "     + StrDate(mask, FeteNationale(annee))
  Debug "Assomption: "         + StrDate(mask, Assomption(annee))
  Debug "Toussaint: "          + StrDate(mask, Toussaint(annee))
  Debug "Armistice: "          + StrDate(mask, Armistice(annee))
  Debug "Noël: "               + StrDate(mask, Noel(annee))
  Debug "-"
Next

;###############################################
;### Test 2
;###############################################

mask.s = "%dd.%mm.%yyyy  ==>  "

For jour = 0 To 364
  
  date = AddDate(Date(2007, 1, 1, 0, 0, 0), #PB_Date_Day, jour)
  
  Select Jour(date)
    Case #JOUR_NOUVELAN:       JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_NOUVELAN"
    Case #JOUR_PAQUES:         JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_PAQUES"
    Case #JOUR_PAQUESLUNDI:    JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_PAQUESLUNDI"
    Case #JOUR_FETEDUTRAVAIL:  JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_FETEDUTRAVAIL"
    Case #JOUR_VICTOIRE1945:   JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_VICTOIRE1945"
    Case #JOUR_PENTECOTE:      JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_PENTECOTE"
    Case #JOUR_PENTECOTELUNDI: JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_PENTECOTELUNDI"
    Case #JOUR_ASCENSION:      JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_ASCENSION"
    Case #JOUR_FETENATIONALE:  JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_FETENATIONALE"
    Case #JOUR_ASSOMPTION:     JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_ASSOMPTION"
    Case #JOUR_TOUSSAINT:      JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_TOUSSAINT"
    Case #JOUR_ARMISTICE:      JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_ARMISTICE"
    Case #JOUR_NOEL:           JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_NOEL"
    Case #JOUR_DIMANCHE:       JourNonOuvre + 1 : Debug StrDate(mask, date) + " #JOUR_DIMANCHE"
    Default: JourOuvre + 1
  EndSelect
  
Next

Debug "Jours ouvrés: " + Str(JourOuvre)
Debug "Jours non ouvrés: " + Str(JourNonOuvre)

;###############################################
;### Fin
;###############################################
Haut
Avatar de l’utilisateur
Crystal Noir
Messages : 892
Inscription : mar. 27/janv./2004 10:07

Message par Crystal Noir »

Mais non ! tu fais le calcul de manière à ce que tous les jours soit fériés :D après tu présentes ton programme et le résultat au patron, j'vous promet les gars, vous récupérez à coup sur le lundi de pentecôte :lol:
Haut
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

comment çà ?
Haut
Avatar de l’utilisateur
Crystal Noir
Messages : 892
Inscription : mar. 27/janv./2004 10:07

Message par Crystal Noir »

C'est pas grave, c'était une plaisanterie :D
Haut
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

ouai je me doute bien... t'inquiètes... :wink:
Haut
Répondre

Revenir à « Trucs et astuces »