Gestion de la date avec jour de la semaine

DIM x% , jour% , mois% , annee% , m$(12) , nbj(12) , j$(7)

DATA Dimanche , Lundi , Mardi , Mercredi , jeudi , Vendredi , Samedi
DATA Janvier , 31 , Fevrier , 28 , Mars , 31 , Avril , 30 , Mai , 31 , Juin , 30 , Juillet , 31
DATA Aout , 31 , Septembre , 30 , Octobre , 31 , Novembre , 30 , Decembre , 31

LABEL affiche , valide , aujourdhui

PANEL 1 : PARENT 1,0 : TOP 1,0 : LEFT 1,0 : WIDTH 1,255 : HEIGHT 1,32 : COLOR 1,100,100,255
ALPHA 2 : PARENT 2,1 : TOP 2,5 : LEFT 2,5 : WIDTH 2,230 : HIDE 2 : HEIGHT 2,20 : FONT_SIZE 2,13 : ON_CLICK 2,valide
COMBO 3 : PARENT 3,1 : TOP 3,5 : LEFT 3,5 : WIDTH 3,35 : ON_CHANGE 3,affiche
COMBO 4 : PARENT 4,1 : TOP 4,5 : LEFT 4,42 : WIDTH 4,75 : ON_CHANGE 4,affiche
COMBO 5 : PARENT 5,1 : TOP 5,5 : LEFT 5,119 : WIDTH 5,50 : ON_CHANGE 5,affiche
BUTTON 6 : PARENT 6,1 : TOP 6,4 : LEFT 6,169 : WIDTH 6,25 : HEIGHT 6,23 : CAPTION 6,"Ok" : ON_CLICK 6,valide
BUTTON 7 : PARENT 7,1 : TOP 7,4 : LEFT 7,192 : WIDTH 7,60 : HEIGHT 7,23 : CAPTION 7,"Aujourd'hui" : ON_CLICK 7,aujourdhui

FOR x%=0 TO 6 : READ j$(x%) : NEXT x%
FOR x%=1 TO 12 : READ m$(x%) : ITEM_ADD 4,m$(x%) : READ nbj(x%) : NEXT x%
FOR x%=1900 TO 2050 : ITEM_ADD 5,STR$(x%) : NEXT x%
GOSUB aujourdhui

END

aujourdhui:
  jour%=LEFT$(DATE$,2) : mois%=MID$(DATE$,4,2) : annee%=RIGHT$(DATE$,4)
  TEXT 3,STR$(jour%) : TEXT 4,m$(mois%) : TEXT 5,STR$(annee%)
  GOSUB affiche
 
affiche:
  jour%=VAL(TEXT$(3)) : FOR x%=1 TO 12 : IF TEXT$(4)=m$(x%) : mois%=x% : END_IF : NEXT x% : annee%=VAL(TEXT$(5))
  IF MOD(annee%,400)=0 OR (MOD(annee%,4)=0 AND MOD(annee%,100)<>0) : nbj(2)=29 : ELSE : nbj(2)=28 : END_IF
  IF jour%>nbj(mois%) : jour%=nbj(mois%) : END_IF
  IF NUMBER_CHANGE<>3 THEN CLEAR 3 : FOR x%=1 TO nbj(mois%) : ITEM_ADD 3,STR$(x%) : NEXT x% : TEXT 3,STR$(jour%)
  x%=MOD((jour% + (annee%-INT((14-mois%)/12)) + INT((annee%-INT((14-mois%)/12))/4) - INT((annee%-INT((14-mois%)/12))/100) + INT((annee%-INT((14-mois%)/12))/400) + INT((31*(mois% + (12*INT((14-mois%)/12)) - 2))/12)),7)
  CAPTION 2,j$(x%)+" "+STR$(jour%)+" "+m$(mois%)+" "+STR$(annee%)
  LEFT 2,INT((230-TEXT_WIDTH(CAPTION$(2),2))/2)
RETURN

valide:
  IF SHOW(2)=1 : FONT_BOLD_OFF 2 : HIDE 2 : FOR x%=3 TO 7 : SHOW x% : NEXT x%
  ELSE : FONT_BOLD 2 : SHOW 2 : FOR x%=3 TO 7 : HIDE x% : NEXT x% : END_IF
RETURN

DIM x% , jour% , mois% , annee% , m$(12) , nbj(12) , j$(7)
DIM p_date%

DATA Dimanche , Lundi , Mardi , Mercredi , jeudi , Vendredi , Samedi
DATA Janvier , 31 , Fevrier , 28 , Mars , 31 , Avril , 30 , Mai , 31 , Juin , 30 , Juillet , 31
DATA Aout , 31 , Septembre , 30 , Octobre , 31 , Novembre , 30 , Decembre , 31

LABEL affiche , valide , aujourdhui

p_date% = 1
PANEL p_date%  : PARENT p_date%,0 : TOP p_date%,0 : LEFT p_date%,0 : WIDTH p_date%,255 : HEIGHT p_date%,32 : COLOR p_date%,100,100,255
ALPHA p_date%+1  : PARENT p_date%+1,p_date% : TOP p_date%+1,5 : LEFT p_date%+1,5 : WIDTH p_date%+1,230
HIDE  p_date%+1  : HEIGHT p_date%+1,20 : FONT_SIZE p_date%+1,13 : ON_CLICK p_date%+1,valide
COMBO p_date%+2  : PARENT p_date%+2,p_date% : TOP p_date%+2,5 : LEFT p_date%+2, 5  : WIDTH p_date%+2,35 : ON_CHANGE p_date%+2,affiche
COMBO p_date%+3  : PARENT p_date%+3,p_date% : TOP p_date%+3,5 : LEFT p_date%+3,42  : WIDTH p_date%+3,75 : ON_CHANGE p_date%+3,affiche
COMBO p_date%+4  : PARENT p_date%+4,p_date% : TOP p_date%+4,5 : LEFT p_date%+4,119 : WIDTH p_date%+4,50 : ON_CHANGE p_date%+4,affiche
BUTTON p_date%+5 : PARENT p_date%+5,p_date% : TOP p_date%+5,4 : LEFT p_date%+5,169 : WIDTH p_date%+5,25
HEIGHT p_date%+5,23 : CAPTION p_date%+5,"Ok" : ON_CLICK p_date%+5,valide
BUTTON p_date%+6 : PARENT p_date%+6,p_date% : TOP p_date%+6,4 : LEFT p_date%+6,192 : WIDTH p_date%+6,60
HEIGHT p_date%+6,23 : CAPTION p_date%+6,"Aujourd'hui" : ON_CLICK p_date%+6,aujourdhui

FOR x%=0 TO 6 : READ j$(x%) : NEXT x%
FOR x%=1 TO 12 : READ m$(x%) : ITEM_ADD p_date%+3,m$(x%) : READ nbj(x%) : NEXT x%
FOR x%=1930 TO 2100 : ITEM_ADD p_date%+4,STR$(x%) : NEXT x%
GOSUB aujourdhui

END

aujourdhui:
  jour%=VAL(LEFT$(DATE$,2)) : mois%=VAL(MID$(DATE$,4,2)) : annee%=VAL(RIGHT$(DATE$,4))
  TEXT p_date%+2,STR$(jour%) : TEXT p_date%+3,m$(mois%) : TEXT p_date%+4,STR$(annee%)
  GOSUB affiche

affiche:
  jour%=VAL(TEXT$(p_date%+2)) : FOR x%=1 TO 12 : IF TEXT$(p_date%+3)=m$(x%) : mois%=x% : END_IF : NEXT x% : annee%=VAL(TEXT$(p_date%+4))
  IF MOD(annee%,400)=0 OR (MOD(annee%,4)=0 AND MOD(annee%,100)<>0) : nbj(2)=29 : ELSE : nbj(2)=28 : END_IF
  IF jour%>nbj(mois%) THEN jour%=nbj(mois%)
  IF NUMBER_CHANGE<>p_date%+2 THEN CLEAR p_date%+2 : FOR x%=1 TO nbj(mois%) : ITEM_ADD p_date%+2,STR$(x%) : NEXT x% : TEXT p_date%+2,STR$(jour%)
  x%=MOD((jour% + (annee%-INT((14-mois%)/12)) + INT((annee%-INT((14-mois%)/12))/4) - INT((annee%-INT((14-mois%)/12))/100) + INT((annee%-INT((14-mois%)/12))/400) + INT((31*(mois% + (12*INT((14-mois%)/12)) - 2))/12)),7)
  CAPTION p_date%+1,j$(x%)+" "+STR$(jour%)+" "+m$(mois%)+" "+STR$(annee%)
  LEFT p_date%+1,INT((230-TEXT_WIDTH(CAPTION$(p_date%+1),p_date%+1))/2)
RETURN

valide:
  IF SHOW(p_date%+1)=1
      FONT_BOLD_OFF p_date%+1 : HIDE p_date%+1 : FOR x%=p_date%+2 TO p_date%+6 : SHOW p_date%+x% : NEXT x%
  ELSE
      FONT_BOLD p_date%+1 : SHOW p_date%+1 : FOR x%=p_date%+2 TO p_date%+6 : HIDE p_date%+x% : NEXT x%
  END_IF
RETURN

valide:
  IF SHOW(p_date%+1)=1
      FONT_BOLD_OFF p_date%+1 : HIDE p_date%+1 : FOR x%=p_date%+2 TO p_date%+6 : SHOW x% : NEXT x%
  ELSE
      FONT_BOLD p_date%+1 : SHOW p_date%+1 : FOR x%=p_date%+2 TO p_date%+6 : HIDE x% : NEXT x%
  END_IF
RETURN

DIM a% , x% , y% , j% , jour% , mois% , annee% , m$(12) , nbj(12) , j$(7)

DATA Dimanche , Lundi , Mardi , Mercredi , jeudi , Vendredi , Samedi
DATA Janvier , 31 , Fevrier , 28 , Mars , 31 , Avril , 30 , Mai , 31 , Juin , 30 , Juillet , 31
DATA Aout , 31 , Septembre , 30 , Octobre , 31 , Novembre , 30 , Decembre , 31

LABEL affiche , valide , aujourdhui , jour

PANEL 1 : PARENT 1,0 : TOP 1,0 : LEFT 1,0 : WIDTH 1,255 : HEIGHT 1,232 : COLOR 1,100,100,255
ALPHA 2 : PARENT 2,1 : TOP 2,5 : LEFT 2,5 : WIDTH 2,230 : HIDE 2 : HEIGHT 2,20 : FONT_SIZE 2,13 : ON_CLICK 2,valide
COMBO 3 : PARENT 3,1 : TOP 3,5 : LEFT 3,5 : WIDTH 3,35 : ON_CHANGE 3,affiche
COMBO 4 : PARENT 4,1 : TOP 4,5 : LEFT 4,42 : WIDTH 4,75 : ON_CHANGE 4,affiche
COMBO 5 : PARENT 5,1 : TOP 5,5 : LEFT 5,119 : WIDTH 5,50 : ON_CHANGE 5,affiche
BUTTON 6 : PARENT 6,1 : TOP 6,4 : LEFT 6,169 : WIDTH 6,25 : HEIGHT 6,23 : CAPTION 6,"Ok" : ON_CLICK 6,valide
BUTTON 7 : PARENT 7,1 : TOP 7,4 : LEFT 7,192 : WIDTH 7,60 : HEIGHT 7,23 : CAPTION 7,"Aujourd'hui" : ON_CLICK 7,aujourdhui

ALPHA 9 : PARENT 9,1 : TOP 9,30 : LEFT 9,5 : FONT_BOLD 9 : CAPTION 9," Lun    Mar    Mer  Jeu  Ven  Sam  Dim  "
a%=10 : FOR y%=1 TO 6 : FOR x%=1 TO 7
  PANEL a% : PARENT a%,1 : TOP a%,y%*30+18 : LEFT a%,x%*35-30 : WIDTH a%,35 : HEIGHT a%,30 : FONT_BOLD a% : COLOR a%,255,255,255 : ON_CLICK a%,jour : a%=a%+1
NEXT x% : NEXT y%

FOR a%=0 TO 6 : READ j$(a%) : NEXT a%
FOR a%=1 TO 12 : READ m$(a%) : ITEM_ADD 4,m$(a%) : READ nbj(a%) : NEXT a%
FOR a%=1900 TO 2050 : ITEM_ADD 5,STR$(a%) : NEXT a%
GOSUB aujourdhui : GOSUB valide

END

jour:
  IF CAPTION$(NUMBER_CLICK)<>"" THEN jour%=VAL(CAPTION$(NUMBER_CLICK)) : TEXT 3,STR$(jour%) : GOSUB affiche
RETURN

aujourdhui:
  jour%=LEFT$(DATE$,2) : mois%=MID$(DATE$,4,2) : annee%=RIGHT$(DATE$,4)
  TEXT 3,STR$(jour%) : TEXT 4,m$(mois%) : TEXT 5,STR$(annee%)
 
affiche:
  jour%=VAL(TEXT$(3)) : FOR x%=1 TO 12 : IF TEXT$(4)=m$(x%) : mois%=x% : END_IF : NEXT x% : annee%=VAL(TEXT$(5))
  IF MOD(annee%,400)=0 OR (MOD(annee%,4)=0 AND MOD(annee%,100)<>0) : nbj(2)=29 : ELSE : nbj(2)=28 : END_IF
  IF jour%>nbj(mois%) : jour%=nbj(mois%) : END_IF
  IF NUMBER_CHANGE<>3 THEN CLEAR 3 : FOR x%=1 TO nbj(mois%) : ITEM_ADD 3,STR$(x%) : NEXT x% : TEXT 3,STR$(jour%)
  j%=MOD((jour% + (annee%-INT((14-mois%)/12)) + INT((annee%-INT((14-mois%)/12))/4) - INT((annee%-INT((14-mois%)/12))/100) + INT((annee%-INT((14-mois%)/12))/400) + INT((31*(mois% + (12*INT((14-mois%)/12)) - 2))/12)),7)
  CAPTION 2,j$(j%)+" "+STR$(jour%)+" "+m$(mois%)+" "+STR$(annee%)
  LEFT 2,INT((230-TEXT_WIDTH(CAPTION$(2),2))/2)
  ' calendrier
  j%=MOD((1 + (annee%-INT((14-mois%)/12)) + INT((annee%-INT((14-mois%)/12))/4) - INT((annee%-INT((14-mois%)/12))/100) + INT((annee%-INT((14-mois%)/12))/400) + INT((31*(mois% + (12*INT((14-mois%)/12)) - 2))/12)),7)
  IF j%=0 THEN j%=7
  FOR a%=10 TO 51
      IF a%>=(j%+9) AND a%=<(j%+8+nbj(mois%)) : COLOR a%,255,255,255 : CAPTION a%,a%-j%-8
      ELSE : COLOR a%,220,220,220 : CAPTION a%,"" : END_IF
  NEXT a%
  COLOR j%+8+jour%,255,255,0
RETURN

valide:
  IF SHOW(2)=1
      FONT_BOLD_OFF 2 : HIDE 2 : HEIGHT 1,232 : FOR a%=3 TO 7 : SHOW a% : NEXT a%
  ELSE
      FONT_BOLD 2 : SHOW 2 : HEIGHT 1,32 : FOR a%=3 TO 7 : HIDE a% : NEXT a%
  END_IF
RETURN

 GOSUB aujourdhui : GOSUB valide

DATE2(DATE$) : PRINT DATE2$
END


data "Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi"
data "Janvier","Fevrier","Mars","Avril","Mai","Juin","Juillet","Aout","Septembre","Octobre","Novembre","Décembre"

' ------------------------------------------------------------------------------
' EXPLODE(S1,S2,liste)
' @info Retourne une liste de chaînes, chacune d'elle étant une sous-chaîne du paramètre S2 extraite en utilisant le séparateur S1
' @param S1 séparateur
' @param S2 Chaine de caractère
' @param Liste N° de la liste de retour
' @@@@
' ------------------------------------------------------------------------------
SUB EXPLODE(delimiter$,chaine$,liste%)
  WHILE INSTR(chaine$,delimiter$)<>0
    ITEM_ADD liste%,LEFT$(chaine$,INSTR(chaine$,delimiter$)-1)
    chaine$=RIGHT$(chaine$,LEN(chaine$)-INSTR(chaine$,delimiter$))
  END_WHILE
  ITEM_ADD liste%,chaine$
END_SUB

' ------------------------------------------------------------------------------
' DATE2(D$)
' @info    Calcule le jour d'une date
' @param   D$ format de la date "JJ/MM/AAAA"
' @retour  Variable globale DATE2$
' ------------------------------------------------------------------------------
SUB DATE2(dat$)
  DIM_LOCAL a$,i,lst%,day,month,year:lst%=1
  DIM_LOCAL d$(7),m$(12)
  IF VARIABLE("DATE2$")=0 THEN DIM DATE2$
  lst% = NUMBER_OBJECTS + 1: DLIST lst%
  FOR i=0 TO 6:READ d$(i):NEXT i : FOR i=0 TO 11:READ m$(i):NEXT i
  EXPLODE("/",dat$,lst%)
  day=VAL(ITEM_READ$(lst%,1)): month=VAL(ITEM_READ$(lst%,2)):year=VAL(ITEM_READ$(lst%,3))
  i = year : if month < 3 then i = i - 1
  i = int((23*month)/9)+day+4+year+int(i/4)-int(i/100)+int(i/400)
  if month >= 3 then i = i - 2
  i = i - (int(i/7)*7)
  Date2$= d$(i)+" "+STR$(day)+" "+m$(month-1)+" "+STR$(year)
  DELETE lst%
  FREE i:FREE day:FREE month:FREE year:FREE lst%:FREE d$:FREE m$
END_SUB

DIM a$: a$="Hello "
PRINT a$;
TEST()
PRINT world$
END

SUB TEST()
  DIM_LOCAL world$
  world$="everybody"
  FREE world$
END_SUB

rem ============================================================================
rem      Un texte 3D dans un SCENE3D
rem ============================================================================
dim i         : ' variable compteur
full_space 0  : ' Plein écran
scene3d 1     : ' créer un objet SCENE3D pour visualiser un monde 3D, cet objet est désigné par le numéro 1
full_space 1  : ' L'objet SCENE3D occupe tout l'espace
color 1,0,0,0 : ' Couleur noire de font de l'objet 1 (c-à-d SCENE3D)

3D_text 1,"Salut Nardo26" : ' on crée un texte 3D dans le SCENE3D déjà crée
3d_color 1,255,0,255 : ' Couleur de l'objet 3D désigné par son N° 1 (c-à-d le texte en 3D)
for i = 0 to 360 : 3d_x_rotate 1,i : wait 10 : next i : ' Rotation de l'objet 3D (c'est le texte 3D) autour de son axe X
for i = 0 to 360 : 3d_y_rotate 1,i : wait 10 : next i : ' Rotation de l'objet 3D (c'est le texte 3D) autour de son axe Y
for i = 0 to 360 : 3d_z_rotate 1,i : wait 10 : next i : ' Rotation de l'objet 3D (c'est le texte 3D) autour de son axe Z
3d_z_rotate 1,25 : 3d_color 1,255,255,255
for i = 1 to 5 step .1   : 3d_x_scale 1,i :wait 100 : next i : ' Modification de l'échelle de l'objet 3D (c'est le texte 3D) le lond de son axe x par le coefficient i
for i = 5 to .1 step -.1 : 3d_x_scale 1,i :wait 100 : next i
3d_x_scale 1,1 :   3d_color 1,0,0,255
for i = 1 to 5 step .1   : 3d_y_scale 1,i :wait 100 : next i : ' Modification de l'échelle de l'objet 3D (c'est le texte 3D) le lond de son axe y par le coefficient i
for i = 5 to .1 step -.1 : 3d_y_scale 1,i :wait 100 : next i
3d_y_scale 1,1  : 3d_color 1,255,0,0
for i = 1 to 15 step .1   : 3d_z_scale 1,i :wait 10 : next i : ' Modification de l'échelle de l'objet 3D (c'est le texte 3D) le lond de son axe z par le coefficient i
for i = 15 to .1 step -.1 : 3d_z_scale 1,i :wait 10 : next i
3D_text_change 1,"Salut Nardo26 <CLICK> pour arrêter"  : ' Modification du texte qui est visualisé par l'objet 3D
repeat  : ' Boucle
     3d_color 1,rnd(255),rnd(255),rnd(255) : ' Modification de la couleur (aléatoire) de l'objet 3D
     3d_y_scale 1,5 : wait 1000 : 3d_y_scale 1,1 : wait 1000
until scancode <> 0 : ' On sort de la boucle par un click souris ou par un appui sur une touche du clavier
3D_text_change 1,"C'est simple PANORAMIC,non?" : ' Modification du texte qui est visualisé par l'objet 3D
3d_x_rotate 1,20 : wait 3000  : ' Rotation du texte selon l'axe X et attente de 3000 ms (soit 3 secondes)
3d_x_rotate 1,45 : 3D_text_change 1,"*** Terminé ***. Au revoir !" : wait 3000

terminate  : ' arrête définitivement l'exécution du programme et libère la mémoire. Tous les objets sont détruits. Le programme n'existe plus en mémoire.