PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

CalendrierCanvas

http://forums.purebasic.com/french/viewtopic.php?t=19525

Page 1 sur 1

CalendrierCanvas

Publié : mer. 08/avr./2026 14:10
par Micoute
Bonjour à tous,
j'avais besoin d'un calendrier où on pouvait coloré les dates et j'ai eus l'idée du CanvasGadget() qui permet de faire des interfaces utilisateur graphiques, alors j'en ai fait un module réutilisables et je vous le donne, on peut changer la taille du calendrier et la police s'ajuste automatiquement.

Amusez-vous bien..

Code : Tout sélectionner

;===========================================
; Module CalendrierCanvas
; Calendrier Canvas modulaire
;===========================================

DeclareModule CalendrierCanvas
  
  Declare Creer(id, x, y, l, h, dte = 0)
  Declare Dessiner(id,dte)
  Declare EvenementCalendrier(id)
  Declare DefinirDate(id, dte)
  Declare ObtenirDate(id)
  
EndDeclareModule


Module CalendrierCanvas
  
  Structure EtatCalendrier
    dte.q
  EndStructure
  
  Global NewMap Etat.EtatCalendrier()
  
  ;-------------------------------------------
  ; Procédure interne : dessin du calendrier
  ;-------------------------------------------
  
  Procedure Dessiner(id,dte)
    ;options
    Protected DebutSemaines=1 ; =Dimanche 1=Lundi [doit correspondre à la valeur définie dans DoCanvasCalendarEvent() !]
    Protected AfficherAutresMois=1 ; 1 = afficher les jours autres que ceux de ce mois ; 0 = ne pas afficher
    Protected PoliceChargee=20     ;  & PoliceChargee+1 ; La valeur de l'identifiant de police doit être supérieure à celle de tous les autres identifiants de police du programme !
                                   ;palette de couleurs
    Protected CouleurFond=$FFFFFF  ; couleur de fond du calendrier (blanc)
    Protected CouleurTitre=$D1B18D ; couleur de la case située sous le nom du mois (bleu)
    Protected CouleurBouton=$EBDECF; une nuance plus claire de CouleurTitre pour les boutons (le centre du bouton est de couleur CouleurTitre)
    Protected CouleurJourVide=$dddddd ; Couleur de la case du jour vide (grise)
    Protected CouleurJourSelectionne=$9999ff ; couleur de la case du jour sélectionné (rouge)
    Protected CouleurAujourdhui=$99ff99      ; Couleur de la case du jour (vert)
                                             ;
    Protected MontrerJour=1                  ; Réinitialisez ci-dessous selon la valeur par défaut 0 = date négative / 1 = date positive (ne modifiez pas cette valeur !)
    If Abs(dte)<2000
      MessageRequester("Dessin du calendrier...","date non valide "+Str(dte))
      ProcedureReturn 0
    ElseIf dte<-1 ; Ce sera le mois prochain (aucun jour n'est donc sélectionné)
      MontrerJour=0 : dte=Abs(dte)
    EndIf
    Protected Mois=Month(dte),Jour=Day(dte),annee=Year(dte)
    Protected MoisProchain,AnneeProchaine=annee,FinMoisProchain ; MoisProchain
    Protected l,h,bw,HauteurEntete,LargeurEntete,ArrondiAngle
    Protected LargeurCase,HauteurCase,EcartCase,HautCase
    Protected EcartMois,FinMois,Semaines
    Protected x,xw,y,incr,cnt,txt$ ; réutilisé
    Protected Dim NomMois.s(12)    ; Supprimez cette ligne si vous avez déjà défini un tableau global (4 lignes)
    For x=1 To 12
      NomMois(x)=Trim(Mid("        Janvier  Février  Mars     Avril    Mai      Juin     Juillet  Août     SeptembreOctobre  Novembre Décembre ",x*9,9))
    Next
    Protected Dim NomJours.s(7)
    For x=1+DebutSemaines To 7+DebutSemaines
      NomJours(x-DebutSemaines)=Mid("  DimLunMarMerJeuVenSamDim-",x*3,3)
    Next
    
    l=GadgetWidth(id)
    h=GadgetHeight(id)
    bw=2 ; largeur de la bordure par rapport au contour
         ;calculer la taille de l'en-tête
    HauteurEntete=h*0.15  ; Le titre représente environ 15 % de la hauteur totale du gadget
    LargeurEntete=l-(bw*6); largeur totale du gadget, hors bordures
    ArrondiAngle=30       ; degré d'arrondi des angles
                          ;Essayer de charger la bonne taille de police ?
    Select LargeurEntete*0.8 ; Environ 80 % de la surface du titre est disponible pour le texte (à vue de nez)
      Case 1 To 130          ;  J'ai utilisé Arial parce qu'elle rend bien en petite taille ; si vous changez de police, il faudra ajuster toutes les tailles !
        LoadFont(PoliceChargee,"Arial",12)
        LoadFont(PoliceChargee+1,"Arial",10)
      Case 1 To 200
        LoadFont(PoliceChargee,"Arial",14)
        LoadFont(PoliceChargee+1,"Arial",12)
      Default
        LoadFont(PoliceChargee,"Arial",18)
        LoadFont(PoliceChargee+1,"Arial",16)  
    EndSelect
    ;calculer les dimensions de la case
    EcartCase=bw*3 : LargeurCase=(l-(EcartCase+EcartCase))/7
    HautCase=h*0.3 ; Environ 30 % de la partie supérieure est occupée par le titre du mois et les noms des jours
                   ;trouver le nombre de jours dans un mois
    EcartMois=DayOfWeek(Date(annee,Mois,1,0,0,0))-DebutSemaines : If EcartMois<0 : EcartMois=6 : EndIf
    ;FinMois=MonthDays(Mois) ; À utiliser si vous avez déjà défini un tableau « dim » au niveau global
    FinMois=31
    While Date(annee,Mois,FinMois,0,0,0)=-1
      FinMois-1
    Wend
    If FinMois<28 : MessageRequester("FinMois=",Str(FinMois)) : EndIf ; vérification des erreurs
    If EcartMois+FinMois>35 : Semaines=6 : Else : Semaines=5 : EndIf  ; Combien y a-t-il de lignes de semaines ?
    MoisProchain=Mois-1 : If MoisProchain<1 : MoisProchain=12 : AnneeProchaine-1 : EndIf
    ;FinMoisProchain=MonthDays(MoisProchain) ; À utiliser si vous avez déjà défini un tableau global (supprimez les 5 lignes suivantes)
    FinMoisProchain=31 
    While Date(AnneeProchaine,MoisProchain,FinMoisProchain,0,0,0)=-1
      FinMoisProchain-1
    Wend
    If FinMoisProchain<28 : MessageRequester("FinMoisProchain=",Str(FinMoisProchain)) : EndIf ; vérification des erreurs
                                                                                              ;en fonction du nombre de semaines ; déterminer la hauteur de la case du jour
    HauteurCase=(h-HautCase-bw-bw)/Semaines
    StartDrawing(CanvasOutput(id))
    If GetWindowColor(GetActiveWindow())=-1
      DrawingMode(#PB_2DDrawing_AlphaChannel)
      Box(0,0,l,h,RGBA(0,0,0,0)) ; fond transparent
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      RoundBox(bw,bw,l-bw-bw,h-bw-bw,l/ArrondiAngle,h/ArrondiAngle,RGBA(Red(CouleurFond),Green(CouleurFond),Blue(CouleurFond),255))
      DrawingMode(#PB_2DDrawing_Default)
    Else
      Box(0,0,l,h,GetWindowColor(GetActiveWindow())) ; vide
      RoundBox(bw,bw,l-bw-bw,h-bw-bw,l/ArrondiAngle,h/ArrondiAngle,CouleurFond)
    EndIf
    ;boîte unie
    RoundBox(bw*3 , bw*3 , LargeurEntete , HauteurEntete , l/ArrondiAngle,h/ArrondiAngle,RGBA(Red(CouleurTitre),Green(CouleurTitre),Blue(CouleurTitre),255)) ; Titre de la case
                                                                                                                                                             ;flèche gauche
    x=(bw*3)+(LargeurEntete*0.1) : y=(bw*3)+(HauteurEntete/2)
    xw=HauteurEntete*0.2 ; rayon du cercle
    Circle(x,y,xw,CouleurBouton) ; une teinte plus claire
    incr=xw*0.6                  ; dessiner une flèche proportionnellement (incr = la largeur de la flèche correspond à la moitié de sa hauteur)
    x-(incr/2)                   ; y reste inchangé
    Line(x,y,incr,-incr,CouleurTitre)
    Line(x+incr,y-incr,1,incr*2,CouleurTitre)
    Line(x+incr,y+incr,-incr,-incr,CouleurTitre)
    FillArea( x+1,y,CouleurTitre,CouleurTitre)
    ;flèche droite
    x=(bw*3)+(LargeurEntete*0.9) ; y reste inchangé
    Circle(x,y,xw,CouleurBouton)
    x-(incr/2) : y=y
    Line(x,y-incr,1,incr+incr,CouleurTitre)
    Line(x,y+incr,incr,-incr,CouleurTitre)
    Line(x+incr,y,-incr,-incr,CouleurTitre)
    FillArea( x+1,y,CouleurTitre,CouleurTitre)
    ;cases en surbrillance
    DrawingMode(#PB_2DDrawing_Outlined)
    RoundBox(bw,bw,l-bw-bw,h-bw-bw,l/ArrondiAngle,h/ArrondiAngle,CouleurTitre)
    ; nom du mois
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawingFont(FontID(PoliceChargee))
    txt$=NomMois(Mois)+" "+Str(annee) ; texte complet de l'en-tête (par ex. Mois 2011)
    x=(l/2)-(TextWidth(txt$)/2) : y=(bw*3)+((HauteurEntete-TextHeight(txt$))/2)
    DrawText(x,y,txt$,0)
    
    ; texte du jour
    DrawingFont(FontID(PoliceChargee+1))
    y=(bw*2)+HauteurEntete+bw
    For x=0 To 6
      DrawText(EcartCase+(x*LargeurCase)+4,y,NomJours(x+1),0)
    Next
    ;placer dans des cases journalières
    cnt=7*Semaines
    For xw=1 To cnt ; 7*Semaines
      x=xw : While x>7 : x-7 : Wend
      x=EcartCase+((x-1)*LargeurCase)
      y=HautCase+(((xw-1)/7)*HauteurCase)
      If xw>EcartMois And xw<=EcartMois+FinMois
        If xw-EcartMois=Jour And MontrerJour
          Box(x,y,LargeurCase-1,HauteurCase-1,CouleurJourSelectionne)
        Else
          Box(x,y,LargeurCase-1,HauteurCase-1,CouleurJourVide)
        EndIf
        DrawText(x+2,y+2,Str(xw-EcartMois),0)
      Else
        If AfficherAutresMois
          If xw>EcartMois+FinMois
            DrawText(x+2,y+2,Str(xw-EcartMois-FinMois),$999999) ; texte grisé
          Else
            DrawText(x+2,y+2,Str(xw+FinMoisProchain-EcartMois),$999999)
          EndIf
        EndIf
      EndIf
      If xw-EcartMois=Day(Date()) And Mois=Month(Date()) And annee=Year(Date())
        If xw-EcartMois=Jour And MontrerJour
          Box(x,y,LargeurCase-1,HauteurCase-1,CouleurAujourdhui)
          Box(x+2,y+2,LargeurCase-5,HauteurCase-5,CouleurJourSelectionne)
        Else
          Box(x,y,LargeurCase-1,HauteurCase-1,CouleurAujourdhui)
        EndIf
        DrawText(x+2,y+2,Str(xw-EcartMois),0)
      EndIf
    Next
    StopDrawing()  
    ; conserver la date
    SetGadgetData(id,Date(annee,Mois,Jour,0,0,0))
  EndProcedure
  
  ;-------------------------------------------
  ; Creer()
  ;-------------------------------------------
  Procedure Creer(id, x, y, l, h, dte = 0)
    CanvasGadget(id, x, y, l, h)
    Etat(Str(id))\dte = dte
    Dessiner(id, dte)
  EndProcedure
  
  
  ;-------------------------------------------
  ; DefinirDate()
  ;-------------------------------------------
  Procedure DefinirDate(id, dte)
    Etat(Str(id))\dte = dte
    Dessiner(id, dte)
  EndProcedure
  
  
  ;-------------------------------------------
  ; ObtenirDate()
  ;-------------------------------------------
  Procedure ObtenirDate(id)
    ProcedureReturn Etat(Str(id))\dte
  EndProcedure
  
  
  ;-------------------------------------------
  ; EvenementCalendrier()
  ;-------------------------------------------
  Procedure EvenementCalendrier(id)
    Protected DebutSemaines=1 ; =Dimanche 1=Lundi [doit correspondre à la valeur définie dans Dessiner() !]
                              ; Appeler à nouveau EventType() pour connaître le type de clic (ou le transmettre à la procédure)
    Protected Mois=Month(GetGadgetData(id))
    Protected Jour=Day(GetGadgetData(id))
    Protected annee=Year(GetGadgetData(id))
    Protected l=GadgetWidth(id),h=GadgetHeight(id),bw=2
    Protected mx = GetGadgetAttribute(id, #PB_Canvas_MouseX)
    Protected my = GetGadgetAttribute(id, #PB_Canvas_MouseY)
    Protected dte ; quel jour correspond à la date de retour sélectionnée
    
    ;calculer les dimensions de la boîte
    Protected EcartCase=bw*3
    Protected LargeurCase=(l-(EcartCase+EcartCase))/7
    Protected HautCase=h*0.3 ; 30 % de la partie supérieure est réservée au texte du mois et aux noms des jours
                             ;calculer le nombre de jours dans un mois
    Protected EcartMois=DayOfWeek(Date(annee,Mois,1,0,0,0))-DebutSemaines : If EcartMois<0 : EcartMois=6 : EndIf
    ;Protected FinMois=MonthDays(Mois) ; À utiliser si vous avez déjà défini un tableau « dim » au niveau global
    Protected FinMois=31
    While Date(annee,Mois,FinMois,0,0,0)=-1 ; Trouver le nombre de jours dans un mois
      FinMois-1
    Wend
    If FinMois<28 : MessageRequester("",Str(FinMois)) : EndIf ; vérification des erreurs
    Protected Semaines                                        ;  calculer le nombre de semaines afin de déterminer la hauteur de la boîte
    If EcartMois+FinMois>35 : Semaines=6 : Else : Semaines=5 : EndIf ; combien de lignes de semaines
    Protected HauteurCase=(h-HautCase-bw-bw)/Semaines
    
    ;trouver le centre du cercle
    Protected HauteurEntete=h*0.15 ; 15%
    Protected LargeurEntete=l-(bw*6)
    Protected xw=HauteurEntete*0.2  ; rayon du cercle
    Protected y=(bw*3)+(HauteurEntete/2) ; l'un ou l'autre des centres des cercles
    Protected x                          ; l’autre centre du cercle
    
    If my<HautCase ; en haut de la page
      If my>y-xw And my<y+xw ; sur la rangée de boutons
        x=(bw*3)+(LargeurEntete*0.1)+1 ; bouton gauche centre+1
        If mx=>x-xw And mx<=x+xw
          Mois-1 : Jour=1
          If Mois<1 : Mois=12 : annee-1 : EndIf
          dte=Date(annee,Mois,Jour,0,0,0)
          Dessiner(id,-dte) ; date négative, donc aucun jour n'est sélectionné
        EndIf
        x=(bw*3)+(LargeurEntete*0.9)+1 ; bouton droit au centre + 1
        If mx=>x-xw And mx<=x+xw
          Mois+1 : Jour=1
          If Mois>12 : Mois=1 : annee+1 : EndIf
          dte=Date(annee,Mois,Jour,0,0,0)
          Dessiner(id,-dte) ; date négative, donc aucun jour n'est sélectionné
        EndIf
      EndIf
      dte=0 ; Aucun jour sélectionné
    Else    ; dans la partie inférieure (jours)
      x=((mx-EcartCase)/LargeurCase)+1
      y=(my-HautCase)/HauteurCase
      Jour=((y*7)+x)-EcartMois
      ;Debug Str(x)+" "+Str(y)+" "+Str(Jour)+" "+Str(Mois)+" "+Str(Annee)
      If Jour>0 And Jour<=FinMois
        dte=Date(annee,Mois,Jour,0,0,0)
        Dessiner(id,dte)
      Else
        dte=0 ; n'est pas un jour
      EndIf
    EndIf
    ProcedureReturn dte
  EndProcedure
  
EndModule

CompilerIf #PB_Compiler_IsMainFile
  
  UseModule CalendrierCanvas
  
  Enumeration fenetres
    #Fenetre
  EndEnumeration
  Enumeration Gadgets
    #Cvs
    #calendrier
  EndEnumeration
  Enumeration Polices
    #Police_Cvs
  EndEnumeration
  
  LoadFont(#Police_Cvs, "Verdana", 20)
  
  Define event, etype, id, dte
  
  Global NewMap CouleurProfession.i()
  
  CouleurProfession("Dentiste") = $66CCFF   ; bleu doux
  CouleurProfession("Cardiologue") = $FF6666; rouge atténué
  CouleurProfession("Kinésithérapeute") = $99CC66 ; vert tendre
  CouleurProfession("Ophtalmologue") = $9966CC    ; violet

  If OpenWindow(#Fenetre, 220, 50, 1500, 640, "Calendrier Canvas", #PB_Window_SystemMenu)
    
    ; --- LA LIGNE IMPORTANTE ---
    Creer(#calendrier, 10, 10, 730, 620, Date())
    CanvasGadget(#Cvs, 750, 10, 740, 620)
    
    Repeat
      event = WaitWindowEvent()
      
      Select event
          
        Case #PB_Event_Gadget
          id = EventGadget()
          etype = EventType()
          
          If id = #calendrier And etype = #PB_EventType_LeftButtonUp
            dte = EvenementCalendrier(id)
            If dte
              Debug "DATE : " + FormatDate("%dd/%mm/%yyyy", dte)
              ; --- DESSINER LA LISTE À DROITE ---
              profession$ = "Dentiste"
              couleur = CouleurProfession(profession$)
              StartDrawing(CanvasOutput(#Cvs))
              Box(0,0,740,620, $FFFFFF) ; fond blanc
              DrawingFont(FontID(#Police_Cvs))
              FrontColor($000000)
              BackColor($FFFFFF)
              Box(10,10,20,20,couleur)
              DrawText(40,10, profession$ + " à 17:00", $000000)
              StopDrawing()
            EndIf
          EndIf
          
      EndSelect
      
    Until event = #PB_Event_CloseWindow
    
  EndIf
  
CompilerEndIf

Re: CalendrierCanvas

Publié : mer. 08/avr./2026 14:25
par Ar-S
C'est plutôt propre bravo.
A l'époque, j'avais fait une grande interface. Mais plutôt que de mettre 1 grand canva de 800x600 j'avais fait plusieurs petits (un par bouton par exemple). Si encore une fois mes souvenirs sont bon, Fred avait validé cette pratique.
Note : Dans ton code, le CompilerIf #PB_Compiler_IsMainFile n'a pas vraiment lieu d'être si tu ne mets pas de condition.

Re: CalendrierCanvas

Publié : mer. 08/avr./2026 14:30
par SPH
Très bien Micoute !!

C'est beau et agréable :idea:

Re: CalendrierCanvas

Publié : mer. 08/avr./2026 15:25
par Micoute
Ar-S a écrit : mer. 08/avr./2026 14:25 Dans ton code, le CompilerIf #PB_Compiler_IsMainFile n'a pas vraiment lieu d'être si tu ne mets pas de condition.
C'était juste pour donner une petite idée pour montrer ce qu'on peut faire avec, le programme que j'ai fait est beaucoup plus vaste et plus précis.

Re: CalendrierCanvas

Publié : mer. 08/avr./2026 19:38
par Jacobus
Beau travail Micoute!
C'est une belle réussite que ton agenda en Canvas.

Re: CalendrierCanvas

Publié : mer. 08/avr./2026 20:35
par Kwai chang caine
Je sais pas si c'est une mode ou pas qui se trame, mais on a du CANVAS à tous les repas maintenant :lol:

Image

Bravo, il est super beau ton agenda, pour une première...c'est la bonne 8O
Et surtout oublie pas ton RDV au dentiste du 1er avril...à moins que ce soit un poisson :mrgreen:

Merci beaucoup du partage 8)

Re: CalendrierCanvas

Publié : jeu. 09/avr./2026 6:06
par Micoute
Bonjour à tous,

je vous mon programme qui ne peut vous servir puisque vous n'avez pas les bases de données, mais vous pourrez en avoir un aperçu.

Code : Tout sélectionner

;{ Directives du compilateur
EnableExplicit
;}
;{ Enumerations
Enumeration Fichiers
  #Fichier_Json
EndEnumeration

Enumeration Window
  #Fenetre_principale
EndEnumeration

Enumeration Gadgets  
  #Cvs
  #calendrier
  #Btn_Quitter
EndEnumeration

Enumeration Polices
  #Police_Cvs
EndEnumeration
;}
;{ Structures
Structure sRdv
  Qui.s             ;Qui a Rdv
  Quand.s           ;Quand
  Avec.s            ;Avec qui et où
  Heure.s           ;A quelle heure
  Complement.s      ;Détails utiles
  Date.i            ;date du Rdv
  Profession.s
EndStructure

Structure praticien_rdv
  Nom.s
  Prenom.s
  Profession.s
  Tel.s
  Adresse.s
  CodePostal.s
  Ville.s
EndStructure

Structure gestionPraticiens
  Civilite.s
  Nom.s
  Prenom.s
  Profession.s
  Tel.s
  Adresse.s
  CodePostal.s
  Ville.s
  Url.s
EndStructure
;}
;{ Fichiers inclus
XIncludeFile "D:\Programmation\Prg Perso\Include\Date2.pbi"
XIncludeFile "D:\Programmation\Prg Perso\M\Modules\CalendarCanvasGadget\CalendrierCanvas.pb"
UseModule CalendrierCanvas
;}
LoadFont(#Police_Cvs, "Verdana", 20)
;{ Variables et constantes
Global.s Rep$ = GetPathPart(ProgramFilename()) : SetCurrentDirectory(Rep$)
Global evenement, etype, id, dte, couleur, profession$, x, y
Global Fichier_Rdv_Praticiens.s = "D:\Programmation\Prg Perso\G\Gestion des rendez-vous\Gestion de prises de rendez-vous praticiens et patients\Donnees\GESRDV JSON V1.JSON"
Global FichierPraticiens.s = "D:\Programmation\Prg Perso\G\Gestion des rendez-vous\Gestion de prises de rendez-vous praticiens et patients\Donnees\praticiens.json"
Global fichier_Professions.s = "D:\Programmation\Prg Perso\G\Gestion des rendez-vous\Gestion de prises de rendez-vous praticiens et patients\Donnees\praticiens.json"
Global fichier_Couleurs.s = Rep$ + "couleurs_professions.json"
Global NewList RDV_Praticiens.sRdv(), NewList RendezVous.sRdv(), NewList Profession.gestionPraticiens()
Global NewMap CouleurProfession.i()
Global DecalageX, DecalageY, Btn_SourisPresse
;}
;{ Couleurs des professions 
CouleurProfession("Dentiste") = $66CCFF   ; bleu doux
CouleurProfession("Cardiologue") = $FF6666; rouge atténué
CouleurProfession("Kinésithérapeute") = $99CC66 ; vert tendre
CouleurProfession("Ophtalmologue") = $9966CC    ; violet
CouleurProfession("Podologue") = $FCA1A3        ; Bleu gauloises
CouleurProfession("Masseur kinésithérapeute") = $EFA0FC 
CouleurProfession("Médecin nucléaire") = $D700B3
;}
Macro TrierListeStruc(_NomListe_, _Options_, _Champ_Structure_)
  ; Cette macro simplifie l'utilisation de la fonction intégrée SortStructuredList().
  SortStructuredList(_NomListe_, _Options_, OffsetOf(_Champ_Structure_), TypeOf(_Champ_Structure_))
EndMacro

Macro AjouterElement(_NomListe_)
  LastElement(_NomListe_)
  AddElement(_NomListe_)
EndMacro
;}
Procedure Charger_Donnees()
  ;{ Chargement des rendez-vous des praticiens
  If LoadJSON(#Fichier_Json, Fichier_Rdv_Praticiens)
    ExtractJSONList(JSONValue(#Fichier_Json), RendezVous())
  Else
    MessageRequester("INFO", "Ouverture du fichier " + Fichier_Rdv_Praticiens + " Impossible !")
    End      
  EndIf
  ;}
  ;{ Assignation des données de la liste des rendez-vous des praticiens
  ForEach RendezVous()
    If RendezVous()\Date >= Year(Date())
      With RDV_Praticiens()
        AjouterElement(RDV_Praticiens())
        \Quand = RendezVous()\Quand
        \Qui = RendezVous()\Qui
        \Avec = RendezVous()\Avec
        \Heure = RendezVous()\Heure
        \Complement = RendezVous()\Complement
        \Date = RendezVous()\Date
        \Profession = RendezVous()\Profession
      EndIf
    EndWith
  Next
  ;}
  ;{ Tri des rendez-vous des praticiens
  TrierListeStruc(RDV_Praticiens(), #PB_Sort_Ascending, sRdv\Heure)
  TrierListeStruc(RDV_Praticiens(), #PB_Sort_Ascending, sRdv\Date)  ;}
EndProcedure
Procedure Charger_praticiens()
  If LoadJSON(#Fichier_Json, fichier_Professions)
    ExtractJSONList(JSONValue(#Fichier_Json), Profession())
  Else
    MessageRequester("INFO", "Ouverture du fichier " + fichier_Professions + " Impossible !")
    End
  EndIf 
EndProcedure
Procedure Charger_Couleurs()
  If FileSize(fichier_Couleurs) = -1
    ProcedureReturn 0
  Else  
    If LoadJSON(#Fichier_Json, fichier_Couleurs)
      ExtractJSONMap(JSONValue(#Fichier_Json), CouleurProfession())
    Else
      MessageRequester("INFO", "Ouverture du fichier " + fichier_Couleurs + " Impossible !")
      End
    EndIf
  EndIf
EndProcedure
Procedure Sauvegarder_Couleurs()
  If CreateJSON(#Fichier_Json)
    InsertJSONMap(JSONValue(#Fichier_Json), CouleurProfession())
    SaveJSON(#Fichier_Json, fichier_Couleurs, #PB_JSON_PrettyPrint)
  Else
    MessageRequester("INFO", "Sauvegarde du fichier " + fichier_Couleurs + " Impossible !")
    End
  EndIf  
EndProcedure
Procedure Quitter()
  Sauvegarder_Couleurs()
  CloseWindow(#Fenetre_principale)
  End 
EndProcedure
Procedure.i CouleurPourProfession(profession$)
  ; Si la couleur existe déjà → on la renvoie
  If FindMapElement(CouleurProfession(), profession$)
    ProcedureReturn CouleurProfession()
  EndIf
  
  ; Sinon → générer une couleur pastel
  Protected r = Random(155) + 100
  Protected g = Random(155) + 100
  Protected b = Random(155) + 100
  
  Protected couleur = RGB(r, g, b)
  
  ; Mémoriser la couleur pour les prochaines fois
  CouleurProfession(profession$) = couleur
  
  ProcedureReturn couleur
EndProcedure
Procedure Programme_principal()
  If OpenWindow(#Fenetre_principale, 00, 410, 1500, 640, "Calendrier RDV Praticiens", #PB_Window_BorderLess)
    SetWindowColor(#Fenetre_principale, $FF7373)
    Charger_Donnees()
    Charger_praticiens()
    Charger_Couleurs()
    ; --- LA LIGNE IMPORTANTE ---
    Creer(#calendrier, 10, 10, 730, 620, Date())
    CanvasGadget(#Cvs, 750, 10, 740, 620, #PB_Canvas_Container)
    ButtonGadget(#Btn_Quitter, 340, 570, 120, 40, "Quitter")
    CloseGadgetList()
    SetGadgetFont(#Btn_Quitter, FontID(#Police_Cvs))
    ; --- DESSIN INITIAL AVEC ARRONDI ---
    StartDrawing(CanvasOutput(#Cvs))
    DrawingMode(#PB_2DDrawing_Default)
    
    ; Effacer le fond avec la couleur de la fenêtre
    Box(0, 0, 740, 620, GetWindowColor(#Fenetre_principale))
    
    ; Ombre douce (optionnelle)
    ;RoundBox(4, 4, 740, 620, 20, 20, RGBA(0,0,0,30))
    
    ; Carte blanche arrondie
    RoundBox(0, 0, 740, 620, 20, 20, $FFFFFF)
    
    StopDrawing()
    
    Repeat
      evenement = WaitWindowEvent()
      
      Select evenement
          
        Case #PB_Event_Gadget
          id = EventGadget()
          etype = EventType()
          
          If id = #Cvs
            Select EventType()
              Case #PB_EventType_LeftButtonDown
                Btn_SourisPresse = #True
                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 = #False
            EndSelect
          EndIf
          
          If id = #calendrier And etype = #PB_EventType_LeftButtonUp
            dte = EvenementCalendrier(id)
            If dte
              ;Debug "DATE : " + FormatDate("%dd/%mm/%yyyy", dte)
              ; --- DESSINER LA LISTE À DROITE ---
              StartDrawing(CanvasOutput(#Cvs))
              DrawingMode(#PB_2DDrawing_Transparent)
              Box(0,0,740,620, GetWindowColor(#Fenetre_principale))
              RoundBox(0,0,740,620, 20, 20, $FFFFFF) ; fond blanc
              
              DrawingMode(#PB_2DDrawing_Default)
              DrawingFont(FontID(#Police_Cvs))
              FrontColor($000000)
              BackColor($FFFFFF)
              y = 10
              DrawText(10, y, "Événements du " + FormatDate("%dd/%mm/%yyyy", dte))
              y + TextHeight("X")
              
              ForEach RDV_Praticiens()
                If RDV_Praticiens()\Date = dte
                  
                  ; retrouver la profession à partir du nom
                  profession$ = RDV_Praticiens()\Profession
                  
                  ; couleur associée
                  couleur = CouleurProfession(RDV_Praticiens()\Profession)                  
                  
                  If couleur = 0
                    couleur = RGB(Random(155) + 100, Random(155) + 100, Random(155) + 100)
                    CouleurProfession(Profession$) = couleur
                  EndIf
                  
                  Box(10,y,20,20,couleur)
                  DrawText(40,y, RDV_Praticiens()\Avec + " à " + RDV_Praticiens()\Heure)
                  y + TextHeight("X")
                  
                  
                  FrontColor(couleur)
                  DrawText(10, y, "   " + RDV_Praticiens()\Profession)
                  FrontColor($000000)
                  y + TextHeight("X")
                EndIf
              Next  
            EndIf
            StopDrawing()
          EndIf  
          If id = #Btn_Quitter
            Quitter()
          EndIf 
        Case #PB_Event_CloseWindow
          Quitter()
      EndSelect      
    ForEver
  EndIf
EndProcedure  
Programme_principal()

Re: CalendrierCanvas

Publié : jeu. 09/avr./2026 16:11
par MetalOS
Pas mal Micoute, ca rend bien.

Re: CalendrierCanvas

Publié : jeu. 09/avr./2026 16:51
par Micoute
Merci MetalOS et tous les autres, moi j'aime ce qui est simple et beau.

Re: CalendrierCanvas

Publié : jeu. 09/avr./2026 18:14
par MetalOS
C'est le meilleur des résultats, simplicité et beauté.
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru