Connaître tous les lundis de tous les mois d'une année

[Micoute]

Bonjour à tous,

si vous souhaitez savoir quand tombe un certain jour de la semaine (dimanche à samedi), ce programme le fait pour vous. Bien sûr, il peut être amélioré et je serais heureux d'avoir participé.
Ce programme utilise l'intervalle 1970-2037, tient compte de la 5ième semaine et est gratuit.

Code : Tout sélectionner

;Jours de semaine des mois d'une année donnée

Enumeration Mois
  #janvier = 1
  #fevrier
  #mars
  #avril
  #mai
  #juin
  #juillet
  #aout
  #septembre
  #octobre
  #novembre
  #decembre
EndEnumeration  

Global JourSemaine, JourSemaine$, NomJours$ = "dimanche lundi mardi mercredi jeudi vendredi samedi"

Procedure.b SiBissextile(Annee=-1)
  ; Retourne Vrai si l'année est une année bissextile (366 jours)
  ; S'il n'y a aucun argument, l'année en cours est utilisée
  ;   Dans le calendrier grégorien, l'année bissextile est
  ;   toute année divisible par 4, sauf
  ;   année du centenaire non divisible par 400
  ; L'année équinoxe de printemps est d'environ 365.242374 jours longs (et croissants)
  If Annee<=0
    Annee = Year(Date())
  EndIf ; Cette année
  If (Mod(Annee,4)=0 And Mod(Annee,100)<>0) Or (Mod(Annee,400)=0)
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.b JoursDansMois(Annee=-1, mois=-1)
  ; Retourne le nombre de jours dans le mois donné (28 .. 31)
  ; Si l'année est absente, l'année en cours est utilisée
  ; Si l'année est présente mais le mois est absent, février est utilisé
  ; Si l'année et le mois sont tous deux absents, le mois courant de l'année en cours est utilisé
  Protected Jours
  If Annee<=0
    Annee = Year(Date())
    If mois<=0: mois = Month(Date()): EndIf
  Else
    If mois<=0: mois = 2: EndIf
  EndIf
  If mois=2
    Jours = 28+SiBissextile(Annee)
  Else
    jours = 31-$A55>>mois&1
  EndIf
  ProcedureReturn jours
EndProcedure

Procedure.s TrouverPremierJourSemaine(Annee, Mois, Joursem)
  Protected Jour=1
  Protected DatePremierJourSemaine=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le premier JourSemaine
  While DayOfWeek(DatePremierJourSemaine)<>Joursem
    
    jour + 1
    DatePremierJourSemaine= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn FormatDate("%dd/%mm/%yyyy", DatePremierJourSemaine)
  
EndProcedure

Procedure.s TrouverDeuxiemeJourSemaine(Annee, Mois, Joursem)
  Protected Jour=8
  Protected DateDeuxiemeJourSemaine=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le deuxième JourSemaine
  While DayOfWeek(DateDeuxiemeJourSemaine)<>Joursem
    
    jour + 1
    DateDeuxiemeJourSemaine= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn FormatDate("%dd/%mm/%yyyy", DateDeuxiemeJourSemaine)
  
EndProcedure

Procedure.s TrouverTroisiemeJourSemaine(Annee, Mois, Joursem)
  Protected Jour=15
  Protected DateTroisiemeJourSemaine=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le Troisième JourSemaine
  While DayOfWeek(DateTroisiemeJourSemaine)<>Joursem
    
    jour + 1
    DateTroisiemeJourSemaine= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn FormatDate("%dd/%mm/%yyyy", DateTroisiemeJourSemaine)
  
EndProcedure

Procedure.s TrouverQuatriemeJourSemaine(Annee, Mois, Joursem)
  Protected Jour=22
  Protected DateQuatriemeJourSemaine=Date(Annee, Mois, Jour, 0, 0, 0)
  
  ;Cherche le Quatrième JourSemaine
  While DayOfWeek(DateQuatriemeJourSemaine)<>Joursem
    
    jour + 1
    DateQuatriemeJourSemaine= Date(Annee, mois, jour, 0, 0, 0)
  Wend
  
  ProcedureReturn FormatDate("%dd/%mm/%yyyy", DateQuatriemeJourSemaine)
  
EndProcedure

Procedure.s TrouverCinquiemeJourSemaine(Annee, Mois, Joursem)
  Protected Jour = JoursDansMois(Annee, Mois)
  Protected DateCinquiemeJourSemaine
  
  ;Chercher le CinquiemeJourSemaine
  DateCinquiemeJourSemaine = AddDate(ParseDate("%dd/%mm/%yyyy", TrouverQuatriemeJourSemaine(Annee, Mois, Joursem)), #PB_Date_Week, 1)
  If Val(Mid(FormatDate("%dd/%mm/%yyyy", DateCinquiemeJourSemaine), 4, 2)) = Mois
    ProcedureReturn FormatDate("%dd/%mm/%yyyy", DateCinquiemeJourSemaine)
  Else
    ProcedureReturn ""
  EndIf  
  
EndProcedure


CompilerIf #PB_Compiler_IsMainFile
  Question:
  JourSemaine = Val(InputRequester("Question","quel jour de semaine 0=dimanche, 6=samedi ?", "0"))
  
  If JourSemaine < 0 Or JourSemaine > 6
    Goto Question
  EndIf
  
  
  JourSemaine$ = StringField(NomJours$, JourSemaine + 1, " ")
  Question_2:
  Annee = Val(InputRequester("Du premier au dernier " + JourSemaine$, "Quelle année ? 1970-2037", Str(Year(Date()))))
  
  If annee < 1970 Or Annee > 2037
    Goto Question_2
  EndIf  
  
  Debug "Tous les " + JourSemaine$ + "s de " + Annee + #CRLF$
  
  For i = #janvier To #Decembre
    Global PremierJourSemaine.s = TrouverPremierJourSemaine(Annee, i, JourSemaine)
    Global DeuxiemeJourSemaine.s = TrouverDeuxiemeJourSemaine(Annee, i, JourSemaine)
    Global TroisiemeJourSemaine.s = TrouverTroisiemeJourSemaine(Annee, i, JourSemaine)
    Global QuatriemeJourSemaine.s = TrouverQuatriemeJourSemaine(Annee, i, JourSemaine)
    Global CinquiemeJourSemaine.s = TrouverCinquiemeJourSemaine(Annee, i, JourSemaine)
    Global texte$ = PremierJourSemaine  + " " + DeuxiemeJourSemaine + " " + TroisiemeJourSemaine + " " + QuatriemeJourSemaine + " " + CinquiemeJourSemaine
    
    Debug texte$
  Next i
  
CompilerEndIf

[Kwai chang caine]

J'ai cru que tu recherchais seulement les lundi....surement parce que d’après cloclo ils sont toujours au soleil
Ca marche ici, j'ai eu la flemme de sortir un calendrier, mais l'avenir nous diras
Merci du partage

[Zorro]

Ce code de MLD , permet de connaitre le jour de n'importe qu'elle date

meme antérieur a 1970 !!

pensez donc, le 14/07/1789 etait un Mardi !!

Code : Tout sélectionner

;======================================
; MLD le 20/12/2010                   =
; Détermination du jour de la semaine =
; pour une date quelconque            =
; selon l'algorithme de Mike Keith    =
; PB 4.51                             =
;======================================
Global Dim Jour.s(6)
Jour(0) = "Dimanche"
Jour(1) = "Lundi"
Jour(2) = "Mardi"
Jour(3) = "Mercredi"
Jour(4) = "jeudi"
Jour(5) = "Vendredi"
Jour(6) = "Samedi"

Procedure joursem(d,m,Y)
  xz = 0 : z = 0
  If m<3
    z = Y-1 : xz =0
  Else
    z = Y : xz = 2
  EndIf
  d = (((((23*m)/9) + d + 4 + Y + (z/4)) - (z/100) + (z/400)) - xz)%7
  ProcedureReturn  d
EndProcedure
Date$ = InputRequester("Saisie d'une date", "JJ/MM/AAAA", "14/07/1789")
MessageRequester("reponse",Jour(joursem(Val(StringField(Date$, 1, "/")),Val(StringField(Date$, 2, "/")),Val(StringField(Date$, 3, "/")))) + "  " + Date$ ,#PB_MessageRequester_Ok )
Dim Jour.s(0)
End

[Micoute]

Je ne me suis pas autant torturé que mon voisin MLD, mais ça prouve qu'il existe plusieurs chemins pour atteindre le résultat.

[falsam]

Il y en a certains je me demande à quoi ils se torturent l'esprit ^^