PureBasic

Bonjour à tous,
ayant envie de reprendre mes activités de geek et ayant largement le temps de cogiter, j'ai eut l'envie de reprendre un de mes anciens code et de l'optimiser davantage en le rendant capable de fonctionner sans librairie additionnelle et ayant malgré tout, les mêmes fonctionnalités.
Le fonctionnement est très simple : on a deux combos, un pour l'année et l'autre pour les jours de semaine, les années vont de l'année en cours, jusqu'en 2037, on a 20 ans pour voir venir.
On choisit une année, un jour de semaine et on valide et une nouvelle fenêtre, ou plutôt la même, mais redimensionnée et sans ses gadgets, s'ouvre avec tous les jours de tous les mois de l'année sélectionnée s'affichent et tout ça gratuitement

Code : Tout sélectionner

;Afficher tous les jours de semaine d'une année en choisissant son nom
;Auteur     : Micoute et la participation des forumeurs PB français
;Version PB : 5.60 x86 et x 64
;Date       : 3 juin 2017
;=====================================================================

Enumeration
  #Fenetre_principale
  #Txt_Annee
  #Annee
  #jours
  #valider
EndEnumeration

Global Dim jours.s(6), i, j
Global$ PremierJourSemaine, DeuxiemeJourSemaine, TroisiemeJourSemaine, QuatriemeJourSemaine, CinquiemeJourSemaine, Texte$

;Plan de l'application
Declare Programme_principal()
Declare Valider()
Declare Quitter()
Declare.s TrouverPremierJourSemaine(Annee, Mois, Joursem)
Declare.s TrouverDeuxiemeJourSemaine(Annee, Mois, Joursem)
Declare.s TrouverTroisiemeJourSemaine(Annee, Mois, Joursem)
Declare.s TrouverQuatriemeJourSemaine(Annee, Mois, Joursem)
Declare.s TrouverCinquiemeJourSemaine(Annee, Mois, Joursem)
Declare.b JoursDansMois(Annee=-1, mois=-1)

Programme_principal()

Procedure Programme_principal()
  Protected n
  
  ;Initialisation de la tables des jours
  jours(0) = "Dimanche"
  jours(1) = "Lundi"
  jours(2) = "Mardi"
  jours(3) = "Mercredi"
  jours(4) = "Jeudi"
  jours(5) = "Vendredi"
  jours(6) = "Samedi"
  
  OpenWindow(#Fenetre_principale, 0, 0, 400, 70, "Choisissez une année et un jour de semaine", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
  TextGadget(#Txt_Annee, 20, 20, 40, 22, "Année")
  
  ComboBoxGadget(#Annee, 70, 20, 50, 22)
  
  For n = Year(Date()) To 2037
    AddGadgetItem(#Annee, -1, Str(n))
  Next n
  SetGadgetState(#Annee, 0)
  
  ComboBoxGadget(#jours, 130, 20, 150, 22)
  
  For n = 0 To 6
    AddGadgetItem(#jours, -1, jours(n))
  Next
  SetGadgetState(#jours, 1)
  
  ButtonGadget(#valider, 290, 20, 80, 22, "Valider")
  
  ;Déclancheurs
  BindEvent(#PB_Event_CloseWindow, @Quitter())
  BindGadgetEvent(#valider, @Valider())
  
  Repeat : WaitWindowEvent() : ForEver
EndProcedure

Procedure Valider()
  Protected JourSemaine = GetGadgetState(#jours), Cnv, X = 10, Y = 0, Police, L = 830, H = 490, AnneeRet = Val(GetGadgetText(#Annee))
  
  If AnneeRet = 0
    AnneeRet = Year(Date())
  EndIf  
  
  Police = LoadFont(#PB_Any, "FontAwesome", 30)
  
  HideGadget(#jours, 1)
  HideGadget(#valider, 1)
  
  ResizeWindow(#Fenetre_principale, 545, 295, L, H)
  SetWindowTitle(#Fenetre_principale, "Vous avez sélectionner les " + GetGadgetText(#jours) + "s de l'année " + AnneeRet)
  Cnv = CanvasGadget(#PB_Any, 0, 0, L, H)
  
  StartDrawing(CanvasOutput(Cnv))
  DrawingFont(FontID(Police))
  
  For i = 1 To 12
    PremierJourSemaine = TrouverPremierJourSemaine(AnneeRet, i, JourSemaine)
    DeuxiemeJourSemaine = TrouverDeuxiemeJourSemaine(AnneeRet, i, JourSemaine)
    TroisiemeJourSemaine = TrouverTroisiemeJourSemaine(AnneeRet, i, JourSemaine)
    QuatriemeJourSemaine = TrouverQuatriemeJourSemaine(AnneeRet, i, JourSemaine)
    CinquiemeJourSemaine = TrouverCinquiemeJourSemaine(AnneeRet, i, JourSemaine)
    Texte$ = PremierJourSemaine  + " " + DeuxiemeJourSemaine + " " + TroisiemeJourSemaine + " " + QuatriemeJourSemaine + " " + CinquiemeJourSemaine
    
    DrawText(X, Y, texte$, $B40000, $FFFFFF)
    Y + TextHeight(" ")
    
  Next i
  
  StopDrawing()
  
EndProcedure

Procedure Quitter() 
  End
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
Macro Bissextile(Annee)
  Bool(((Not Year(Annee) % 4) And Year(Annee) % 100) Or (Not Year(Annee) % 400))
EndMacro
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 = -1
    Annee = Year(Date())
    If mois = -1
      mois = Month(Date())
    EndIf
  Else
    If mois<=0: mois = 2: EndIf
  EndIf
  
  If mois=2
    If Bissextile(Annee)
      Jours = 29
    Else
      Jours = 28
    EndIf  
  Else
    jours = 31-$A55>>mois&1
  EndIf
  
  NbjoursMois = Jours
  
  ProcedureReturn NbjoursMois
EndProcedure

@ Micoute

Sympa ton programme.
Bon courage avec les soucis de santé. La programmation te permet surement d'oublier un peu.
Amicalement ton voisin d'en face.
Michel

Merci à toi aussi, mon cher voisin d'en face et homonyme de prénom, c'est qu'il y a un moment que je ne programmais et ça influe sur la santé quand on ne s'occupe pas sainement le cerveau et dégâts de l'intérieur commençaient sérieusement à se voir de l'extérieur, mais le plus dur est derrière, maintenant qu'on a trouvé le traitement qui me convient et qui me permet de me sentir vivant, sachant que rien ne sera plus comme avant, je profite encore mieux du temps qui m'est donné.

ça fait plaisir à lire. Au plaisir de découvrir tes productions.

Heureux de voir que ta bonne machine à coder à repris du service, Micoute

Porte toi bien et ravis-nous de beau code

Merci les amis pour votre réconfort, faire de beaux codes c'est sûrement la chose que j'aimerais faire le mieux, mais à mon âge qui s'avance, les idées ne sont plus aussi bouillonnantes qu'il y a 30 ans.
Comme disait mon père : on ne peut pas être et avoir été.

Merci du partage

Toujours des caractères un peu trop grands

Kwai chang caine a écrit :Merci du partage
Toujours des caractères un peu trop grands

Mais de rien, c'est tout naturel. Pour les caractères, puisque tu possèdes le code, tu peux adapter les paramètres à tes exigences, ce programme est libre de droits.

PureBasic

Afficher tous les jours de semaine choisis d'une année

Afficher tous les jours de semaine choisis d'une année

Re: Afficher tous les jours de semaine choisis d'une année

Re: Afficher tous les jours de semaine choisis d'une année

Re: Afficher tous les jours de semaine choisis d'une année

Re: Afficher tous les jours de semaine choisis d'une année

Re: Afficher tous les jours de semaine choisis d'une année

Re: Afficher tous les jours de semaine choisis d'une année

Re: Afficher tous les jours de semaine choisis d'une année