Une petite sub calendrier

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Bon, comme ça dort un peu par ici, voici une petite sub qui ne va pas réveiller grand'monde, mais ça meuble un peu...
Il s'agit d'afficher dans un Form à part un calendrier d'une année donnée, à un emplacement donné et avec des dimensions données.
Le calendrier est plutôt simplifié, il n'affiche que le quantième du mois et le jour de la semaine (Note pour Jicehel: pas la peine de me demander de rajouter les fêtes fixes ou mobiles, les phases de la lune, etc. c'est niet ! Very Happy

).
On peut changer d'année en avant ou en arrière.
Ça peut paraître un peu acrobatique avec les s/p intégrés, mais ça marche, apparemment.

Code:: DIM a%, x%, y%, w%, h%
a% = 2013: x% = 50: y% = 200: w% = 900: h% = 600
Calendrier(a%,x%,y%,w%,h%)
message clipboard_string_paste$: ' date cliquée dans le calendrier (ou rien)
' TERMINATE
END
' ==============================================================================
SUB Calendrier(a%,x%,y%,w%,h%)
' Calendrier simplifié de l'année a%, affiché en x%,y%, dimensions w%,h%
' Si une date est cliquée, elle sera rendue dans le clipboard sous la forme JJ/MM/AAAA
IF LABEL("Sorcal") = 0 THEN LABEL Sorcal
IF LABEL("Exitcal") = 0 THEN LABEL Exitcal
IF LABEL("Cautre") = 0 THEN LABEL Cautre
IF LABEL("Joursem") = 0 THEN LABEL Joursem
IF LABEL("Clicdat") = 0 THEN LABEL Clicdat
IF LABEL("Descal") = 0 THEN LABEL Descal
DIM_LOCAL fca%, wmc%, hjc%, ic%, jc%, xc%, yc%, nmc$(12), aac$, js_d, js%
DIM_LOCAL lmc%(12), jsc$, libc%
DATA "nmm","JANV","FÉVR","MARS","AVRI","MAI","JUIN","JUIL","AOÛT","SEPT","OCTO","NOVE","DÉCE"
DATA 31,28,31,30,31,30,31,31,30,31,30,31
DATA "DiLuMaMeJeVeSa"
RESTORE: READ aac$: WHILE aac$<>"nmm": READ aac$: END_WHILE
FOR ic% = 1 TO 12: READ nmc$(ic%): NEXT ic%
FOR ic% = 1 TO 12: READ lmc%(ic%): NEXT ic%: READ jsc$
fca%=1000: WHILE OBJECT_EXISTS(fca%) = 1: fca%=fca%+1000: END_WHILE
FORM fca%: TOP fca%,y%: LEFT fca%,x%: WIDTH fca%,w%: HEIGHT fca%,h%
BORDER_SMALL fca%: ON_CLOSE fca%,Exitcal
wmc% = INT((w%-16)/12): hjc% = INT((h%-34)/32)
hjc% = INT((h%-53)/32)
PICTURE fca%+1: PARENT fca%+1,fca%: FULL_SPACE fca%+1: HEIGHT fca%+1,hjc%*32+1
COLOR fca%+1,255,255,200: ON_CLICK fca%+1,Clicdat
BUTTON fca%+2: PARENT fca%+2,fca%: WIDTH fca%+2,wmc%*2: HEIGHT fca%+2,20
TOP fca%+2,hjc%*32+1: LEFT fca%+2,5*wmc%: CAPTION fca%+2,"Quitter": ON_CLICK fca%+2,Sorcal
COLOR fca%,128,255,255
BUTTON fca%+3: PARENT fca%+3,fca%: WIDTH fca%+3,40: HEIGHT fca%+3,20
TOP fca%+3,TOP(fca%+2): LEFT fca%+3,LEFT(fca%+2)-45: CAPTION fca%+3,"<"
BUTTON fca%+4: PARENT fca%+4,fca%: WIDTH fca%+4,40: HEIGHT fca%+4,20
TOP fca%+4,TOP(fca%+2): LEFT fca%+4,LEFT(fca%+2)+WIDTH(fca%+2)+5: CAPTION fca%+4,">"
FOR ic% = fca%+3 TO fca%+4: FONT_BOLD ic%: ON_CLICK ic%,Cautre: NEXT ic%
HEIGHT fca%,hjc%*32+55
PICTURE fca%+5: PARENT fca%+5,fca%: LEFT fca%+5,-1*(w%+50): WIDTH fca%+5,WIDTH(fca%+1)
HEIGHT fca%+5,HEIGHT(fca%+1): ' picture caché, pour mise en place des éléments
ALPHA fca%+6: PARENT fca%+6,fca%: TOP fca%+6,TOP(fca%+2)+3: WIDTH fca%+6,100
LEFT fca%+6,LEFT(fca%+4)+100: font_bold fca%+6: CAPTION fca%+6,"cliquer une date"

2D_TARGET_IS fca%+5: 2D_FILL_COLOR 255,255,200
PRINT_TARGET_IS fca%+5: FONT_NAME fca%+5,"Comic Sans MS"
ic% = 8: IF h% <=500 THEN ic% = 6
FONT_SIZE fca%+5,ic%
FOR ic% = wmc% TO w% STEP wmc%: 2D_LINE ic%,0,ic%,32*hjc%: NEXT ic%
FOR ic% = hjc% TO 32*hjc% STEP hjc%: 2D_LINE 0,ic%,12*wmc%,ic%: NEXT ic%
Descal:
CAPTION fca%, STRING$(20," ")+"- ANNÉE "+STR$(a%)+" -": lmc%(2) = 28
IF (FRAC(a%/4)=0 AND FRAC(a%/100)>0) OR FRAC(a%/400)=0 THEN lmc%(2)=29
libc% = 0
FOR ic% = 1 TO 12
xc% = (ic%-1)*wmc%+3: 2D_FILL_COLOR 255,255,128
2D_RECTANGLE xc%+3,-1,xc%+wmc%-2,hjc%+1
FONT_COLOR fca%+5,0,96,0: FONT_BOLD fca%+5: PRINT_LOCATE xc%,1: PRINT nmc$(ic%)
2D_FILL_COLOR 255,255,200
FONT_BOLD_OFF fca%+5: FONT_COLOR fca%+5,0,0,128
FOR jc% = 1 TO 31
yc% = jc%*hjc%+1 : GOSUB Joursem
IF js%=0
2D_FILL_COLOR 255,164,164: ' dimanche
ELSE
2D_FILL_COLOR 255,255,200
END_IF
2D_RECTANGLE xc%-3,yc%-1,xc%+wmc%-2,yc%+hjc%
PRINT_LOCATE xc%,yc%: PRINT MID$(jsc$,js%*2+1,2)+RIGHT$(" "+STR$(jc%),3)+" "
IF jc%>=lmc%(ic%)
IF ic%=2 AND jc%=28 AND lmc%(2)=28
2D_FILL_COLOR 255,255,200
yc%=29*hjc%+1: 2D_RECTANGLE xc%-3,yc%-1,xc%+wmc%-2,yc%+hjc%: ' nettoyage
END_IF
EXIT_FOR
END_IF
NEXT jc%
NEXT ic%
CLIPBOARD_COPY fca%+5: CLIPBOARD_PASTE fca%+1: ' recopie dans le picture visible
WHILE libc% = 0: PAUSE 300: END_WHILE: GOTO Exitcal
Sorcal:
libc% = 1
RETURN
Exitcal:
aac$ = CAPTION$(fca%+6): IF LEFT$(aac$,1)<>"c" THEN CLIPBOARD_STRING_COPY aac$
2D_TARGET_IS 0: PRINT_TARGET_IS 0: DELETE fca%: EXIT_SUB
Cautre:
IF NUMBER_CLICK = fca%+3
a% = a%-1
ELSE
a% = a%+1
END_IF
GOTO Descal
Joursem:
js_d = a%
IF ic%<3 THEN js_d = js_d-1
js_d=INT(23*ic%/9)+jc%+4+a%+INT(js_d/4)-INT(js_d/100)+INT(js_d/400)
IF ic%>=3 THEN js_d = js_d-2
js% = js_d-7*INT(js_d/7): ' jour de la semaine (0 dimanche à 6 samedi)
RETURN
Clicdat:
xc% = MOUSE_X_LEFT_DOWN(fca%+1): yc% = MOUSE_Y_LEFT_DOWN(fca%+1)
ic% = 1+INT(xc%/wmc%): jc% = INT(yc%/hjc%)
IF jc% = 0 OR jc% > lmc%(ic%) THEN RETURN
aac$ = RIGHT$("0"+STR$(jc%),2)+"/"+RIGHT$("0"+STR$(ic%),2)+"/"+STR$(a%)
COLOR fca%+6,255,255,128: FONT_BOLD fca%+6: CAPTION fca%+6,aac$
RETURN
END_SUB

edit: petite màj 23/8 14h35

Hello JL thirty five.
Voilà un bon mariage de SUB et de GOSUB qui a donné naissance à un utilitaire pratique !
Merci pour le code.

@tous
Pour la bonne structure du programme, personnellement je suis pour l’instruction END de la ligne 6, bien que son rôle soit occulté par l’instruction TERMINATE.
Qu’en pensez-vous ? Le débat est ouvert.

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Tu as bien sûr raison, ici le End n'a pas de sens derrière le Terminate. Celui-ci c'était juste pour les essais, normalement il n'existe pas ici, c'est un End. Mais c'était juste dans le code de test.

Merci papydall, au moins un qui suit ! et qui épluche le code, en plus, ça fait plaisir !

Normalement, on reste dans la Sub tant qu'on ne la quitte pas délibérément (bouton Quitter). Je me demande ce qui est préférable pour l'attente: PAUSE 300 comme j'ai mis, ou WAIT 300 ? l'effet est apparemment le même, mais...?

J'ai ajouté une image ci-dessus. On peut bien sûr mettre la police qu'on veut, c'est facile à changer.
Autre chose, il y a un effet assez désagréable de clignotement pendant l'écriture, je n'ai pas trop su comment faire pour l'éviter.

heu...j' étais juste parti me restaurer... Embarassed

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

C'est pas une excuse ! l'apéro encore, je veux bien... Cool

J' ai besoin de rester lucide pour suivre tout vos codes... Very Happy

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Puisque c'est comme ça, déjà une modif, là-haut !
Pour éviter le clignotement à l'écriture, je fais d'abord tout le travail dans un picture invisible, que je recopie à la fin dans le picture visible (copier/coller), ça va plus vite, et ça ne clignote plus (à peine, pendant la recopie), c'est quand même plus agréable à regarder.

pour Joursem, le gosub est d'un autre temps ...
une sub joursem est plus adapté à l'usage...
pour moi les gosub ne justifie plus guère que pour la gestion des événements et quelques cas particuliers peut être.

En tout cas merci pour ce nouveau calendrier et je ne te demanderais pas d'ajout puisque si on veut, on peut le faire à partir de tes calendriers précédents.

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Bonsoir Jicehel,
C'est vrai pour le gosub, j'avais d'abord mis ma sub Joursem, mais j'ai voulu avoir tout intégré dans une seule sub, ce qui est facile, et même si ce n'est pas très élégant, ça marche. Surtout que ce n'est que quelques lignes.

Mais bon, j'en conviens, ça se discute.

Ici les ajouts ne se justifient pas, c'est juste pour avoir un petit calendrier sous la main pour jeter un coup d'oeil à l'occasion, pas comme un programme qui ne ferait que calendrier, comme l'autre.

PS encore une 'tite mise à jour, j'avais oublié un Parent (quelle honte Embarassed

)

En fait si, je pense que je rajouterais un truc à ta sub: la gestion du retour avec dans une variable la valur du jour sur lequel on a cliqué. Genre pour prendre un rendez-vous. Le programme propose d'afficher le calendrier, l'utilisateur clique sur le jour et on referme le calendrier en gardant la date qu'il a choisi.

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Bon, c'est fait Jicehel, mais c'est bien pour te faire plaisir !
Alors la date éventuellement cliquée s'affiche en bas du calendrier (sous la forme JJ/MM/AAA), et est passée à l'appelant dans le clipboard.
J'ai aussi amélioré un peu la présentation, en surlignant bien les dimanches, on voit mieux les semaines, tiens je vais remettre une image.

OK, ok, presque parfait mais il manque un petit contrôle sur la date, on peut cliquer sur l'entête est on est alors le 0. Pareil, on peut être une date qui n'existe pas comme le 31 novembre ou le 30 février...

Je sais, je suis chi..t mais comme je sais que tu peux le faire ... Very Happy

et puis comme ça, on mettra directement cette sub sur le site comme contrôle tout prêt.

Avant que JL35 ne modifie son code pour la énième fois

JL35 a écrit:: Normalement, on reste dans la Sub tant qu'on ne la quitte pas délibérément (bouton Quitter). Je me demande ce qui est préférable pour l'attente: PAUSE 300 comme j'ai mis, ou WAIT 300 ? l'effet est apparemment le même, mais...?

Pourquoi ne pas éviter l’une et l’autre et faire par exemple :

Code:: WHILE "JL35" <> "PAPYDALL" : END_WHILE

J’ai modifié un peu le code ( le 1er avant toutes le modifications que tu as apportées) : Les lignes modifiées portent la remarque soit ‘Supprimé par Papydall’ soit ‘ Ajouté par Papydall’.
Le but n’est pas d’optimiser le code, mais le coder différemment !

Voici le code modifié et ça marche!

Code:: DIM a%, x%, y%, w%, h%
a% = 2013: x% = 50: y% = 200: w% = 640: h% = 600
Calendrier(a%,x%,y%,w%,h%)

END
' ==============================================================================
SUB Calendrier(a%,x%,y%,w%,h%)
' Calendrier simplifié de l'année a%, affiché en x%,y%, dimensions w%,h%
IF LABEL("Sorcal") = 0 THEN LABEL Sorcal
' IF LABEL("Exitcal") = 0 THEN LABEL Exitcal : < ------- Supprimé par Papydall
IF LABEL("Cautre") = 0 THEN LABEL Cautre
IF LABEL("Joursem") = 0 THEN LABEL Joursem
IF LABEL("Descal") = 0 THEN LABEL Descal
DIM_LOCAL fca%, wmc%, hjc%, ic%, jc%, xc%, yc%, nmc$(12), aac$, js_d, js%
DIM_LOCAL lmc%(12), jsc$ : ' , libc% <------------------ Supprimé par Papydall
hide 0 : ' <--------------------------------------------- Ajouté par Papydall
DATA "nmm","JANV","FÉVR","MARS","AVRI","MAI","JUIN","JUIL","AOÛT","SEPT","OCTO","NOVE","DÉCE"
DATA 31,28,31,30,31,30,31,31,30,31,30,31
DATA "DiLuMaMeJeVeSa"
READ aac$: WHILE aac$<>"nmm": READ aac$: END_WHILE
FOR ic% = 1 TO 12: READ nmc$(ic%): NEXT ic%
FOR ic% = 1 TO 12: READ lmc%(ic%): NEXT ic%: READ jsc$
fca%=1000: WHILE OBJECT_EXISTS(fca%) = 1: fca%=fca%+1000: END_WHILE
FORM fca%: TOP fca%,y%: LEFT fca%,x%: WIDTH fca%,w%: HEIGHT fca%,h%
BORDER_SMALL fca%:' ON_CLOSE fca%,Exitcal : < ------- Supprimé par Papydall
wmc% = INT((w%-16)/12): hjc% = INT((h%-34)/32)
hjc% = INT((h%-53)/32)
PICTURE fca%+1: PARENT fca%+1,fca%: FULL_SPACE fca%+1: HEIGHT fca%+1,hjc%*32+1
COLOR fca%+1,255,255,200
BUTTON fca%+2: PARENT fca%+2,fca%: WIDTH fca%+2,wmc%*2: HEIGHT fca%+2,20
TOP fca%+2,hjc%*32+1: LEFT fca%+2,5*wmc%: CAPTION fca%+2,"Quitter": ON_CLICK fca%+2,Sorcal
COLOR fca%,0,255,255
BUTTON fca%+3: PARENT fca%+3,fca%: WIDTH fca%+3,40: HEIGHT fca%+3,20
TOP fca%+3,TOP(fca%+2): LEFT fca%+3,LEFT(fca%+2)-45: CAPTION fca%+3,"<"
BUTTON fca%+4: PARENT fca%+4,fca%: WIDTH fca%+4,40: HEIGHT fca%+4,20
TOP fca%+4,TOP(fca%+2): LEFT fca%+4,LEFT(fca%+2)+WIDTH(fca%+2)+5: CAPTION fca%+4,">"
FOR ic% = fca%+3 TO fca%+4: FONT_BOLD ic%: ON_CLICK ic%,Cautre: NEXT ic%
HEIGHT fca%,hjc%*32+55
PICTURE fca%+5: PARENT fca%+5,fca%: LEFT fca%+5,-1*(w%+50): WIDTH fca%+5,WIDTH(fca%+1)
HEIGHT fca%+5,HEIGHT(fca%+1)

2D_TARGET_IS fca%+5: 2D_FILL_COLOR 255,255,200
PRINT_TARGET_IS fca%+5: FONT_NAME fca%+5,"Comic Sans MS"
ic% = 8: IF h% <=500 THEN ic% = 6
FONT_SIZE fca%+5,ic%
FOR ic% = wmc% TO w% STEP wmc%: 2D_LINE ic%,0,ic%,32*hjc%: NEXT ic%
FOR ic% = hjc% TO 32*hjc% STEP hjc%: 2D_LINE 0,ic%,12*wmc%,ic%: NEXT ic%
Descal:
CAPTION fca%, STRING$(20," ")+"- ANNÉE "+STR$(a%)+" -": lmc%(2) = 28
IF (FRAC(a%/4)=0 AND FRAC(a%/100)>0) OR FRAC(a%/400)=0 THEN lmc%(2)=29
' libc% = 0 : < ---------------------------------------- Supprimé par Papydall
FOR ic% = 1 TO 12
   xc% = (ic%-1)*wmc%+3
   FONT_COLOR fca%+5,0,96,0: FONT_BOLD fca%+5: PRINT_LOCATE xc%,1: PRINT nmc$(ic%)
   FONT_BOLD_OFF fca%+5
   FOR jc% = 1 TO 31
   yc% = jc%*hjc%+1
   GOSUB Joursem
   FONT_COLOR fca%+5,0,0,128: FONT_BOLD_OFF fca%+5
   IF js%=0 THEN FONT_COLOR fca%+5,128,0,0: FONT_BOLD fca%+5
   PRINT_LOCATE xc%,yc%: PRINT MID$(jsc$,js%*2+1,2)+RIGHT$(" "+STR$(jc%),3)+" "
   IF jc%>=lmc%(ic%)
   IF ic%=2 AND jc%=28 AND lmc%(2)=28
   yc%=29*hjc%+1: 2D_rectangle xc%-3,yc%-1,xc%+wmc%-2,yc%+hjc%
   END_IF
   EXIT_FOR
   END_IF
   NEXT jc%
NEXT ic%
CLIPBOARD_COPY fca%+5: CLIPBOARD_PASTE fca%+1: ' recopie dans le picture visible
' WHILE libc% = 0: pause 300: END_WHILE: GOTO Exitcal : < ------- Supprimé par Papydall
WHILE "JL35" <> "PAPYDALL" : end_while : ' <============== Ajouté par Papydall
Sorcal:
' libc% = 1 : <-------------------------------------- Supprimé par Papydall
   terminate : ' < ======================================= Ajouté par Papydall
RETURN
' Exitcal: < ------------------------------------------- Supprimé par Papydall
' 2D_TARGET_IS 0: PRINT_TARGET_IS 0: DELETE fca%: EXIT_SUB : < ------- Supprimé par Papydall
Cautre:
   IF NUMBER_CLICK = fca%+3
   a% = a%-1
   ELSE
   a% = a%+1
   END_IF
   GOTO Descal
Joursem:
   js_d = a%
   IF ic%<3 THEN js_d = js_d-1
   js_d=INT(23*ic%/9)+jc%+4+a%+INT(js_d/4)-INT(js_d/100)+INT(js_d/400)
   IF ic%>=3 THEN js_d = js_d-2
   js% = js_d-7*INT(js_d/7)
RETURN
END_SUB

Une sub très intéressante qui une fois bien au point
aura toute sa place sur le site...
cheers

Edit :
Et puis...zut! je la met sur le site d'ici un petit 1/4 d'heure... Very Happy

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

J'arrive...
@papydall
Je ne comprends pas bien tes modifs (faites sur la version antérieure, c'est pas facile à suivre...)
Je rappelle que ce n'est pas un programme en soi, c'est une sub, donc appelée par un programme principal dans lequel on doit retourner après exécution, donc je ne comprends pas le Hide 0 à l'intérieur de la sub et encore moins le Terminate, dans la sub !

Mon but était de garder la main dans la sub, jusqu'à un clic sur Quitter, et à ce moment-là de libérer toutes les ressources créées par la SUB (Delete fca%), pour pouvoir y refaire appel plus tard éventuellement, puis rendre la main au programme principal. C'est une Sub, complètement indépendante du programme principal, et qui doit créer ses propres ressources à l'entrée et les libérer en sortie.

Ta boucle:
WHILE "JL35" <> "PAPYDALL" : end_while ... c'est amusant...
mais il me semble qu'elle est infinie (on n'en sort jamais), donc elle va continuer à tourner en tâche de fond jusqu'à ce qu'on tue le programme, me trompe-je ?
(ou alors il faut s'arranger pour que JL35 devienne égal à PAPYDALL, mais ça c'est pas gagné... )

@Jicehel, tu as raison pour le contrôle sur la date cliquée, les contrôles sont inexistants, mais enfin l'utilisateur qui choisit une date n'est pas censé cliquer n'importe où, à la limite ça lui donnera une date farfelue mais il n'avait qu'à faire attention, ça lui apprendra !
Bon d'accord, un petit contrôle n'aurait pas été superflu...

13h53 Voilà, c'est fait pour le contrôle, c'était facile, une seule ligne à ajouter dans le s/p Clicdat.

ygeronimi, tu peux y aller !

Une erreur d' attention et voilà que
j' ai mis en téléchargement la sub modifié par Papydall
et pas l' original... Embarassed

Je modifie cela tout de suite.

Edit: C' est fait !

Perso, je vois cette sub comme un paliatif au "data time picker"...

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Ah bon, tu crois ? pourtant je ne l'ai pas faite dans cet esprit-là... la meilleure preuve c'est que je n'ai pas la moindre idée de ce qu'est le 'data time picker' ! Very Happy

c'est un truc pour piquer l'heure ? (ou piquer sa montre à quelqu'un ?)

Edit: 14h35, une petite mise à jour là-haut dans le code:
- manquait un Restore avant la lecture des datas (gênant si on rappelle la sub une deuxième fois)
- ligne 70 il fallait xc%-3 i/o xc%+3, pas très important (nettoyage de la case avant écriture).

» Petite (toute petite) Sub: Dir
» Calendrier
» Un calendrier Pop-Up en Panoramic
» Un Calendrier de plus
» calendrier clicable