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
