Gestion d'événements périodiques

Programmation d'applications complexes
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Gestion d'événements périodiques

Message par Micoute »

Bonjour à tous

aujourd'hui, je vous offre cette petite application qui permet de programmer des événements périodiques qui être peuvent annuels, mensuels, hebdomadaires, spécifiques ou personnels, par exemple tous les 20 de chaque mois.

Code : Tout sélectionner

Enumeration Fichiers
  #Fichier_Json
EndEnumeration

Enumeration Fenetres
  #Fenetre_Principale
EndEnumeration

Enumeration Gadgets
  #Cvs_principal
  #Txt_Alarmes
  #Txt_Nom
  #Txt_Date
  #Txt_Periode
  #Txt_Frequence
  #Txt_JourSpecifique
  #Txt_MoisSpecifique
  #Txt_JoursPerso
  
  #Str_Nom
  #Str_Date
  #Str_Frequence
  #Str_JourSpecifique
  #Str_MoisSpecifique
  #Str_JoursPerso
  
  #Cmb_Periode
  
  #Chk_AlarmeActive
  
  #Btn_Ajouter
  #Btn_Modifier
  #Btn_Supprimer
  #Btn_Quitter
  #Lst_EvenementPeriodique
EndEnumeration

Enumeration Polices
  #Police
EndEnumeration

; Déclaration des structures et des variables nécessaires
Structure EvenementPeriodique
  nom.s
  dateRdv.s
  periode.s
  frequence.i
  jourSpecifique.i
  moisSpecifique.i
  JoursPerso.i
  alarmeActive.i
EndStructure

Global.s Rep$ = GetPathPart(ProgramFilename()) : SetCurrentDirectory(Rep$)
Global NewList Lst_Evenements.evenementPeriodique()
Global Timer = 0
Global baseDeDonnees$ = GetCurrentDirectory() + "événements périodiques.json"
Global fichierDeConfiguration$ = GetCurrentDirectory() + "config.ini"
Global alarmes$ = "" ; Variable pour stocker les messages d'alarme
Global X.i = -1, Y.i = -1, Largeur.i = 490, Hauteur.i = 530

; Chargement des polices
LoadFont(#Police , "Arial Nova", 12, #PB_Font_Bold)
SetGadgetFont(#PB_Default, FontID(#Police))

Declare AjouterEvenementPeriodique(nom$, dateEvenement$, periode$, frequence, jourSpecifique, moisSpecifique, joursPerso, alarmeActive)
Declare VerifierExistenceEvenementPeriodique(nom$, dateEvenement$)
Declare VerifierAlarmes()
Declare ReactiverAlarmes()
Declare ChargerEvenements(baseDeDonnees$)
Declare AfficherListeEvenements()
Declare SauvegarderEvenements(baseDeDonnees$)
Declare ChargerListeListeEvenements()
Declare AjouterEvenement()
Declare ModifierEvenement(index)
Declare SupprimerEvenement(index)
Declare GestionEvenements()
Declare SauvegarderPositionEtTaille()
Declare ChargerPositionEtTaille()
Declare Programme_principal()
Declare FenetreFermer()
Declare Quitter()

; Modification de la fonction d'ajout d'événements pour inclure un indicateur d'alarme active
Procedure AjouterEvenementPeriodique(nom$, dateEvenement$, periode$, frequence, jourSpecifique, moisSpecifique, joursPerso, alarmeActive)
  AddElement(Lst_Evenements())
  Lst_Evenements()\nom = nom$
  Lst_Evenements()\dateRdv = dateEvenement$
  Lst_Evenements()\periode = periode$
  Lst_Evenements()\frequence = frequence
  Lst_Evenements()\jourSpecifique = jourSpecifique
  Lst_Evenements()\moisSpecifique = moisSpecifique
  Lst_Evenements()\JoursPerso = joursPerso
  Lst_Evenements()\alarmeActive = alarmeActive
EndProcedure

Procedure VerifierExistenceEvenementPeriodique(nom$, dateEvenement$)
  ForEach Lst_Evenements()
    If Lst_Evenements()\nom = nom$ And Lst_Evenements()\dateRdv = dateEvenement$
      ProcedureReturn #True
    EndIf
  Next
  ProcedureReturn #False
EndProcedure

; Fonction pour vérifier et déclencher les alarmes
Procedure VerifierAlarmes()
  alarmes$ = "" ; Nettoyer la variable avant d'ajouter de nouvelles alarmes

  DateActuelle = Date()
  jourActuel = Day(DateActuelle)
  moisActuel = Month(DateActuelle)
  anneeActuelle = Year(DateActuelle)
  jourSemaineActuel = DayOfWeek(DateActuelle)

  ForEach Lst_Evenements()
    DateRdv = ParseDate("%dd/%mm/%yyyy", Lst_Evenements()\dateRdv)
    joursEcoules = (DateActuelle - DateRdv) / 86400

    Select Lst_Evenements()\periode
      Case "annuel"
        If Day(DateRdv) = jourActuel And Month(DateRdv) = moisActuel And Lst_Evenements()\alarmeActive = 1
          alarmes$ + "Événement: " + Lst_Evenements()\nom + " (annuel)" + #LF$ ; Ajouter le message d'alarme
          Lst_Evenements()\alarmeActive = 0                                    ; Désactiver l'alarme après déclenchement
        EndIf

      Case "mensuel"
        If Day(DateRdv) = jourActuel And Lst_Evenements()\alarmeActive = 1
          alarmes$ + "Événement: " + Lst_Evenements()\nom + " (mensuel)" + #LF$ ; Ajouter le message d'alarme
          Lst_Evenements()\alarmeActive = 0                                     ; Désactiver l'alarme après déclenchement
        EndIf

      Case "hebdomadaire"
        If DayOfWeek(DateRdv) = jourSemaineActuel And Lst_Evenements()\alarmeActive = 1
          alarmes$ + "Événement: " + Lst_Evenements()\nom + " (hebdomadaire)" + #LF$ ; Ajouter le message d'alarme
          Lst_Evenements()\alarmeActive = 0                                          ; Désactiver l'alarme après déclenchement
        EndIf

      Case "specifique"
        If Day(DateActuelle) = Lst_Evenements()\jourSpecifique And Month(DateActuelle) = Lst_Evenements()\moisSpecifique
          If Lst_Evenements()\alarmeActive = 1
            alarmes$ + "Événement: " + Lst_Evenements()\nom + " (spécifique)" + #LF$ ; Ajouter le message d'alarme
            Lst_Evenements()\alarmeActive = 0                                        ; Désactiver l'alarme après déclenchement
          EndIf
        EndIf

      Case "perso"
        ; Vérifier que joursPerso n'est pas zéro avant de faire l'opération modulo
        If Lst_Evenements()\joursPerso > 0 And joursEcoules % Lst_Evenements()\joursPerso = 0 And Lst_Evenements()\alarmeActive = 1
          alarmes$ + "Événement: " + Lst_Evenements()\nom + " (tous les " + Str(Lst_Evenements()\joursPerso) + " jours)" + #LF$
          ; Ajouter le message d'alarme
          Lst_Evenements()\alarmeActive = 0 ; Désactiver l'alarme après déclenchement
        EndIf  
    EndSelect
  Next

  ; Mettre à jour le TextGadget avec les messages d'alarme
  SetGadgetText(#Txt_Alarmes, alarmes$)
EndProcedure
; Fonction pour réactiver les alarmes périodiques
Procedure ReactiverAlarmes()
  ForEach Lst_Evenements()
    If Lst_Evenements()\periode = "annuel" Or Lst_Evenements()\periode = "mensuel" Or Lst_Evenements()\periode = "hebdomadaire" Or Lst_Evenements()\periode = "specifique" Or Lst_Evenements()\periode = "perso"
      Lst_Evenements()\alarmeActive = 1
    EndIf
  Next
EndProcedure

Procedure ChargerEvenements(baseDeDonnees$)
  If ReadFile(#Fichier_Json, baseDeDonnees$)
    CloseFile(#Fichier_Json)
    
    LoadJSON(#Fichier_Json, baseDeDonnees$, #PB_JSON_NoCase)
    ExtractJSONList(JSONValue(#Fichier_Json), Lst_Evenements())
    Debug "Chargement du fichier JSON réussi"
  Else
    Debug "Erreur lors de la lecture du fichier JSON"
  EndIf
EndProcedure

Procedure SauvegarderEvenements(baseDeDonnees$)
  CreateJSON(#Fichier_Json)
  InsertJSONList(JSONValue(0), Lst_Evenements())
  
  If SaveJSON(#Fichier_Json, baseDeDonnees$, #PB_JSON_PrettyPrint)
    Debug "Fichier JSON sauvegardé avec succès"
  Else
    Debug "Erreur lors de la sauvegarde du fichier JSON"
  EndIf
  
  FreeJSON(#Fichier_Json)
EndProcedure

Procedure ChargerListeListeEvenements()
  ClearGadgetItems(#Lst_EvenementPeriodique)
  ForEach Lst_Evenements()
    AddGadgetItem(#Lst_EvenementPeriodique, -1, Lst_Evenements()\nom + " - " + Lst_Evenements()\dateRdv)
  Next
EndProcedure

Procedure AjouterEvenement()
  nom$ = GetGadgetText(#Str_Nom)
  dateEvenement$ = GetGadgetText(#Str_Date)
  periode$ = GetGadgetText(#Cmb_Periode)
  frequence = Val(GetGadgetText(#Str_Frequence))
  jourSpecifique = Val(GetGadgetText(#Str_JourSpecifique))
  moisSpecifique = Val(GetGadgetText(#Str_MoisSpecifique))
  joursPerso = Val(GetGadgetText(#Str_JoursPerso))
  alarmeActive = GetGadgetState(#Chk_AlarmeActive)
  
  If Not VerifierExistenceEvenementPeriodique(nom$, dateEvenement$)
    AjouterEvenementPeriodique(nom$, dateEvenement$, periode$, frequence, jourSpecifique, moisSpecifique, joursPerso, alarmeActive)
    SauvegarderEvenements(baseDeDonnees$)
    ChargerListeListeEvenements()
  Else
    MessageRequester("Information", "L'événement existe déjà.")
  EndIf  
EndProcedure

Procedure ModifierEvenement(index)
  If index >= 0 And index < ListSize(Lst_Evenements())
    SelectElement(Lst_Evenements(), index)
    Lst_Evenements()\nom = GetGadgetText(#Str_Nom)
    Lst_Evenements()\dateRdv = GetGadgetText(#Str_Date)
    Lst_Evenements()\periode = GetGadgetText(#Cmb_Periode)
    Lst_Evenements()\frequence = Val(GetGadgetText(#Str_Frequence))
    Lst_Evenements()\jourSpecifique = Val(GetGadgetText(#Str_JourSpecifique))
    Lst_Evenements()\moisSpecifique = Val(GetGadgetText(#Str_MoisSpecifique))
    Lst_Evenements()\JoursPerso = Val(GetGadgetText(#Str_JoursPerso))
    Lst_Evenements()\alarmeActive = GetGadgetState(#Chk_AlarmeActive)
    
    SauvegarderEvenements(baseDeDonnees$)
    ChargerListeListeEvenements()
  EndIf
EndProcedure

Procedure SupprimerEvenement(index)
  If index >= 0 And index < ListSize(Lst_Evenements())
    If MessageRequester("Confirmation", "Êtes-vous sûr de vouloir supprimer ce rendez-vous ? Cette action est irréversible.", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
      SelectElement(Lst_Evenements(), index)
      DeleteElement(Lst_Evenements())
      SauvegarderEvenements(baseDeDonnees$)
      ChargerListeListeEvenements()
    EndIf
  EndIf
EndProcedure

Procedure GestionEvenements()
  Repeat
    Event = WaitWindowEvent()
    
    Select Event
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #Btn_Ajouter
            AjouterEvenement()
            
          Case #Btn_Modifier
            index = GetGadgetState(#Lst_EvenementPeriodique)
            ModifierEvenement(index)
            
          Case #Btn_Supprimer
            index = GetGadgetState(#Lst_EvenementPeriodique)
            SupprimerEvenement(index)
            
          Case #Btn_Quitter
            CloseWindow(#fenetre_principale)
            End
            
          Case #Cvs_principal
          Select EventType()
            Case #PB_EventType_LeftButtonDown
              Btn_SourisPresse = 1:DecalageX = DesktopMouseX() - WindowX(#Fenetre_principale):DecalageY = DesktopMouseY() - WindowY(#Fenetre_principale)
            Case #PB_EventType_MouseMove
              If Btn_SourisPresse:ResizeWindow(#Fenetre_principale, DesktopMouseX() - DecalageX, DesktopMouseY() - DecalageY, #PB_Ignore, #PB_Ignore):EndIf  
            Case #PB_EventType_LeftButtonUp
              Btn_SourisPresse = 0
          EndSelect
          
          Case #Lst_EvenementPeriodique
            index = GetGadgetState(#Lst_EvenementPeriodique)
            If index >= 0 And index < ListSize(Lst_Evenements())
              SelectElement(Lst_Evenements(), index)
              SetGadgetText(#Str_Nom, Lst_Evenements()\nom)
              SetGadgetText(#Str_Date, Lst_Evenements()\dateRdv)
              SetGadgetText(#Cmb_Periode, Lst_Evenements()\periode)
              SetGadgetText(#Str_Frequence, Str(Lst_Evenements()\frequence))
              SetGadgetText(#Str_JourSpecifique, Str(Lst_Evenements()\jourSpecifique))
              SetGadgetText(#Str_MoisSpecifique, Str(Lst_Evenements()\moisSpecifique))
              SetGadgetText(#Str_JoursPerso, Str(Lst_Evenements()\JoursPerso))
              SetGadgetState(#Chk_AlarmeActive, Lst_Evenements()\alarmeActive)
            EndIf
            
        EndSelect
        
      Case #PB_Event_CloseWindow
        If EventWindow() = #fenetre_principale
          Break
        EndIf
    EndSelect
    
  ForEver
EndProcedure

Procedure SauvegarderPositionEtTaille()
  If CreateFile(0, fichierDeConfiguration$)
    WriteStringN(0, "X=" + Str(X))
    WriteStringN(0, "Y=" + Str(Y))
    WriteStringN(0, "Largeur=" + Str(Largeur))
    WriteStringN(0, "Hauteur=" + Str(Hauteur))
    CloseFile(0)
  Else
    MessageRequester("Erreur", "Impossible de créer le fichier de configuration.")
  EndIf
EndProcedure

Procedure ChargerPositionEtTaille()
  If FileSize(fichierDeConfiguration$) > 0
    If ReadFile(0, fichierDeConfiguration$)
      While Eof(0) = 0
        ligne$ = ReadString(0)
        If FindString(ligne$, "X=", 1) > 0
          X = Val(RemoveString(ligne$, "X="))
        ElseIf FindString(ligne$, "Y=", 1) > 0
          Y = Val(RemoveString(ligne$, "Y="))
        ElseIf FindString(ligne$, "Largeur=", 1) > 0
          Largeur = Val(RemoveString(ligne$, "Largeur="))
        ElseIf FindString(ligne$, "Hauteur=", 1) > 0
          Hauteur = Val(RemoveString(ligne$, "Hauteur="))
        EndIf
      Wend
      CloseFile(0)
    Else
      MessageRequester("Erreur", "Impossible de lire le fichier de configuration.")
    EndIf
  Else
    ; Valeurs par défaut si le fichier n'existe pas
    X = -1
    Y = -1
    Largeur = 490
    Hauteur = 530
  EndIf
EndProcedure

Procedure MonCallback(WindowID, Message, wParam, lParam)
  Select Message
    Case #WM_MOVE, #WM_SIZE
      ; Obtenir la position et la taille de la fenêtre
      X = WindowX(#Fenetre_Principale)
      Y = WindowY(#Fenetre_Principale)
      Largeur = WindowWidth(#Fenetre_Principale)
      Hauteur = WindowHeight(#Fenetre_Principale)
      
      ; Sauvegarder la position et la taille
      SauvegarderPositionEtTaille()
  EndSelect
  
  ; Appel de la procédure de rappel par défaut
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure Programme_principal()
  ChargerPositionEtTaille()
  
  If X = -1 Or Y = -1
    OpenWindow(#Fenetre_Principale, 0, 0, Largeur, Hauteur, "Gestion des événements périodiques", #PB_Window_ScreenCentered)
  Else
    OpenWindow(#Fenetre_Principale, X, Y, Largeur, Hauteur, "Gestion des événements périodiques", #PB_Window_BorderLess)
  EndIf
  
  CanvasGadget(#Cvs_principal, 0, 0, Largeur, Hauteur, #PB_Canvas_Container)
  
  ; Définir le rappel de la fenêtre
  SetWindowCallback(@MonCallback(), #Fenetre_Principale)

  TextGadget(#Txt_Alarmes, 10, 10, 580, 20, "")
  
  ListViewGadget(#Lst_EvenementPeriodique, 10, 40, 470, 240)
  
  TextGadget(#Txt_Nom, 10, 290, 90, 30, "Nom", #SS_CENTERIMAGE|#SS_RIGHT) : StringGadget(#Str_Nom, 110, 290, 120, 30, "")
  TextGadget(#Txt_Date, 10, 340, 90, 30, "Date", #SS_CENTERIMAGE|#SS_RIGHT) : StringGadget(#Str_Date, 110, 340, 120, 30, "")
  TextGadget(#Txt_Periode, 10, 390, 90, 30, "Période", #SS_CENTERIMAGE|#SS_RIGHT) : ComboBoxGadget(#Cmb_Periode, 110, 390, 120, 30)
  AddGadgetItem(#Cmb_Periode, -1, "annuel")
  AddGadgetItem(#Cmb_Periode, -1, "mensuel")
  AddGadgetItem(#Cmb_Periode, -1, "hebdomadaire")
  AddGadgetItem(#Cmb_Periode, -1, "spécifique")
  AddGadgetItem(#Cmb_Periode, -1, "perso")  
  TextGadget(#Txt_JoursPerso, 10, 440, 90, 30, "Jours perso", #SS_CENTERIMAGE|#SS_RIGHT) : StringGadget(#Str_JoursPerso, 110, 440, 120, 30, "")
  
  TextGadget(#Txt_Frequence, 280, 290, 140, 30, "Fréquence", #SS_CENTERIMAGE|#SS_RIGHT) : StringGadget(#Str_Frequence, 430, 290, 50, 30, "")
  TextGadget(#Txt_JourSpecifique, 280, 340, 140, 30, "Jour spécifique", #SS_CENTERIMAGE|#SS_RIGHT) : StringGadget(#Str_JourSpecifique, 430, 340, 50, 30, "")
  TextGadget(#Txt_MoisSpecifique, 280, 390, 140, 30, "Mois spécifique", #SS_CENTERIMAGE|#SS_RIGHT) : StringGadget(#Str_MoisSpecifique, 430, 390, 50, 30, "")
  
  CheckBoxGadget(#Chk_AlarmeActive, 340, 440, 200, 30, "    Alarme active")
  
  ButtonGadget(#Btn_Ajouter, 10, 490, 100, 30, "Ajouter")
  ButtonGadget(#Btn_Modifier, 132, 490, 100, 30, "Modifier")
  ButtonGadget(#Btn_Supprimer, 254, 490, 100, 30, "Supprimer")
  ButtonGadget(#Btn_Quitter, 380, 490, 100, 30, "Quitter")
  
  CloseGadgetList()
  
  GadgetToolTip(#Str_Nom, "Nom de l'évenement")
  GadgetToolTip(#Str_Date, "JJ/MM/AAAA")
  GadgetToolTip(#Cmb_Periode, "Période spécifique")
  GadgetToolTip(#Str_JoursPerso, "Jour")
  GadgetToolTip(#Str_Frequence, "Intervalle de temps")
  GadgetToolTip(#Str_JourSpecifique, "Jour du mois ou 0")
  GadgetToolTip(#Str_MoisSpecifique, "Mois ou 0")
  
  StartDrawing(CanvasOutput(#Cvs_principal))
  Box(0, 0, 490, 530, $3CB7FD)
  StopDrawing()
  
  SetWindowColor(#Fenetre_Principale, $3CB7FD)
  For i = #Txt_Alarmes To #Txt_JoursPerso
    SetGadgetColor(i, #PB_Gadget_BackColor, GetWindowColor(#Fenetre_Principale))
  Next i
  SetGadgetColor(#Lst_EvenementPeriodique, #PB_Gadget_BackColor, $C1E8FE)
  
  BindEvent(#PB_Event_CloseWindow, @FenetreFermer(), #Fenetre_Principale)
EndProcedure

Procedure FenetreFermer()
  ; Obtenir la position et la taille de la fenêtre avant de la fermer
  X = WindowX(#Fenetre_Principale)
  Y = WindowY(#Fenetre_Principale)
  Largeur = WindowWidth(#Fenetre_Principale)
  Hauteur = WindowHeight(#Fenetre_Principale)
  
  ; Sauvegarder la position et la taille
  SauvegarderPositionEtTaille()
  
  ; Fermer la fenêtre
  CloseWindow(#Fenetre_Principale)
  End
EndProcedure

Procedure Quitter()
  PostEvent(#PB_Event_CloseWindow, #Fenetre_Principale, #PB_Event_CloseWindow)
EndProcedure

; Lancer le programme principal
Programme_principal()

; Attacher le bouton Quitter à la procédure de fermeture de la fenêtre
BindGadgetEvent(#Btn_Quitter, @Quitter())

; Charger la liste de rendez-vous
ChargerEvenements(baseDeDonnees$)
ChargerListeListeEvenements()

VerifierAlarmes()

GestionEvenements()
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
Kwai chang caine
Messages : 6989
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Gestion d'événements périodiques

Message par Kwai chang caine »

Peut être utile, merci pour le partage 8)

Le checkBox est pas trop "jojo" avec un fond gris :|
Et pour le changer il faut utiliser des API et toute une armada de lignes de code :cry:
Perso pour contourner tout ce fatra de code et rester en code PB natif, je fais ça :

Code : Tout sélectionner

 ......
 #Txt_MoisSpecifique
  #Txt_JoursPerso
  #Txt_AlarmeActive

Code : Tout sélectionner

CheckBoxGadget(#Chk_AlarmeActive, 340, 440, 10, 10, "")
  TextGadget(#Txt_AlarmeActive, 360, 436, 130, 20, "Alarme active")

Code : Tout sélectionner

For i = #Txt_Alarmes To #Txt_AlarmeActive
    SetGadgetColor(i, #PB_Gadget_BackColor, GetWindowColor(#Fenetre_Principale))
  Next i
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Gestion d'événements périodiques

Message par Micoute »

Tu as raison Kwai chang caine, à partir du moment ou le code est posté sur le forum, chacun est libre de le transformer à sa guise.

Merci pour tes critiques que je trouve constructives.

Bonne journée.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Répondre