calcul du premier jour ouvré d'un mois donné

[Micoute]

Bonjour à tous,

je vous offre ce petit bout de code permettant de calculer le premier jour ouvré d'un mois et d'une année donnés, je suis passé par une structure, mais il y a d'autres façons plus simples.

Code : Tout sélectionner

;Premier jour ouvré du mois
;par Micoute 23 mars 2021

EnableExplicit

Enumeration Fenetres
  #Fenetre_principale
EndEnumeration

Enumeration Gadgets
  #Txt_Enonce
  #Str_Annee
  #Cmb_Annees
  #Lst_Mois
  #Btn_Quitter
EndEnumeration

Enumeration Polices
  #Police
EndEnumeration

Structure sMois
  Nom.s
  Numero.i
EndStructure

Structure sJour
  Nom.s
  Numero.i
EndStructure  

Structure Jour_ouvre
  NomMois.s
  NomJour.s
  J.i
  M.i
  A.i
EndStructure

LoadFont(#Police, "Verdana", 12)
SetGadgetFont(#PB_Default, FontID(#Police))

Global Evenement, i, Jour_ouvre.Jour_ouvre, Jour, Mois, Annee, JourSem, DatePremierJourOuvre
Global Dim TabNomMois.sMois(12), Dim TabNomJours.sJour(6)

For i = 1 To 12
  TabNomMois(i)\Nom=StringField("janvier février mars avril mai juin juillet août septembre octobre novembre décembre",i," ")
  TabNomMois(i)\Numero=i
Next i

For i = 0 To 6
  TabNomJours(i)\Nom=StringField("dimanche lundi mardi mercredi jeudi vendredi samedi",i+1," ")
  TabNomJours(i)\Numero=i
Next i


Declare Programme_principal()
Declare Calcul_Dates()
Declare Quitter()
Declare.s Premier_Jour_ouvre(Annee, Mois)

Programme_principal()

Procedure Programme_principal()
  If OpenWindow(#Fenetre_principale, 0, 0, 400, 420, "Premiers jours ouvrés", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    TextGadget(#Txt_Enonce, 20, 20, 360, 20, "", #SS_CENTERIMAGE|#SS_CENTER)
    ListIconGadget(#Lst_Mois, 30, 60, 350, 270, "Date", 340, #LVS_NOCOLUMNHEADER)
    ComboBoxGadget(#Cmb_Annees, 140, 350, 100, 30)
    i = 2010
    While i <= 2037
      AddGadgetItem(#Cmb_Annees, -1, Str(i))
      i + 1
    Wend
    ;SetGadgetState(#Cmb_Annees, Year(Date())-2010)
    ButtonGadget(#Btn_Quitter, 140, 390, 100, 20, "Quitter")
    BindGadgetEvent(#Cmb_Annees, @Calcul_Dates())
    BindGadgetEvent(#Btn_Quitter, @Quitter())
    BindEvent(#PB_Event_CloseWindow, @Quitter())
    Repeat
      Evenement = WaitWindowEvent()
      Select Evenement          
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Btn_Quitter
          EndSelect
      EndSelect
    ForEver
  EndIf
EndProcedure

Procedure Calcul_Dates()
  ClearGadgetItems(#Lst_Mois)
  Annee = Val(GetGadgetText(#Cmb_Annees))
  SetGadgetText(#Txt_Enonce, "Premiers jours ouvrés en " + Annee)
  i = 1
  While i <= 12
    Premier_Jour_ouvre(Annee, i)
    AddGadgetItem(#Lst_Mois, i, Jour_ouvre\NomJour + " " + Jour_ouvre\J + " " +TabNomMois(i)\Nom + " " + Jour_ouvre\A)
    i + 1
  Wend
EndProcedure

Procedure Quitter()
  Select EventType()
    Case #PB_EventType_LeftClick
      CloseWindow(#Fenetre_principale)
      End
  EndSelect
EndProcedure

Procedure.s Premier_Jour_ouvre(Annee, Mois)
  Jour=1
  JourSem = DayOfWeek(Date(Annee, Mois, Jour, 0, 0, 0))
  Select Mois
    Case 1, 5, 11
      Select JourSem
        Case 0:Jour + 1:JourSem = 1      
        Case 1 To 4:Jour + 1:JourSem + 1
        Case 5:Jour + 3:JourSem = 1
        Case 6:Jour + 2:JourSem = 1
      EndSelect 
    Case 2 To 4, 6 To 10, 12
      Select JourSem
        Case 0:Jour + 1:JourSem = 1      
        Case 1 To 5:DatePremierJourOuvre=Date(Annee,Mois,Jour,0,0,0)
        Case 6:Jour + 2:JourSem = 1
      EndSelect 
  EndSelect  
  DatePremierJourOuvre=Date(Annee,Mois,Jour,0,0,0)
  
  Jour_ouvre\A = Annee
  Jour_ouvre\J = Day(Date(Annee, Mois, Jour, 0, 0, 0))
  Jour_ouvre\NomJour = TabNomJours(DayOfWeek(DatePremierJourOuvre))\Nom
  Jour_ouvre\M = Mois
  Jour_ouvre\NomMois = TabNomMois(Mois)\Nom
EndProcedure

[case]

ca marche bien

[Kwai chang caine]

Ca fonctionne au premier regard
Merci du partage

[Micoute]

C'est une affaire qui marche, alors j'ai bien fait de me faire dégoudronner les carotides.

[MLD]

Bonjour Micoute
Comme je te dit, il y a plus court. Comme dab tu te complique la tête.

Code : Tout sélectionner

;MLD le 25/03/2021
#Fenetre_principale = 1:#txt1 = 2:#list = 3:#combo = 4:#btstop = 5
LoadFont(10, "Verdana", 12)
SetGadgetFont(#PB_Default, FontID(10))

Procedure JMD(a,m,j);date avec jours et mois
Jour$ = "Dimanche,Lundi,Mardi,Mercredi,Jeudi,Vendredi,Samedi"
Mois$ = "Janvier,Février,Mars,Avril,Mais,Juin,Juillet,Aout,Septembre,Octobre,Novembre,Décenbre"   
J$= StringField(Jour$, DayOfWeek (Date(a,m,j, 0, 0, 0))+1, "," )
M$ = StringField(Mois$,Month(Date(a,m,j, 0, 0, 0)),",")
Date1$ = J$ +" " + " " + Str(j) + " " + M$+ " " + Str(a)
AddGadgetItem(3,-1,Date1$)
EndProcedure

Procedure cdate(a)
For x = 1 To 12
  j = 1
  If x = 1 Or x = 5 Or x =11
    j=j +1
  EndIf
  y = DayOfWeek(Date(a,x,j, 0, 0, 0))
  If y = 0 Or y = 6
    If y = 6
      j = j+2
    Else  
      j = j+1
    EndIf  
  EndIf
  jmd(a,x,j)
Next
EndProcedure

OpenWindow(1, 0, 0, 400, 420, "Premiers jours ouvrés", #PB_Window_ScreenCentered)
TextGadget(2, 20, 20, 360, 20, "", #SS_CENTERIMAGE|#SS_CENTER)
ListViewGadget(3, 30, 60, 350, 270)
ComboBoxGadget(4, 140, 350, 100, 30)
ButtonGadget(5, 140, 390, 100, 20, "Quitter")
For  i = 2010 To 2037
 AddGadgetItem(4, -1, Str(i))
 Next
Repeat
  Select WindowEvent()  
    Case #PB_Event_Gadget 
     Select EventGadget()  
      Case 4 ;combo
       ClearGadgetItems(3):SetGadgetText(2,"")  
       a = Val(GetGadgetText(4))
       SetGadgetText(2,"Premiers jours ouvrés en "+ Str(a))  
       cdate(a)
     Case 5;bt stop
      CloseWindow(1)
      End  
     EndSelect
  EndSelect 
ForEver

Un vieux réflexe les codes le plus court possible. (Ou un réflexe de vieux! hum)
a+
Michel

[Micoute]

Il n'y a pas photo, il est beaucoup plus petit pour le même travail. Bravo MLD