Reminder

hide 0
dim ligne$
application_title "Reminder "
file_open_read 1,"c:\config\reminder.txt"
while file_eof(1) <> 1
   file_readln 1,ligne$
   if len(ligne$) < 30 then ligne$ = ligne$ + string$(30 - len(ligne$)  ," ")
   if left$(ligne$,5) = left$(date$,5) then message mid$(ligne$,12,100)
end_while
file_close 1
terminate

label ajout,sortie,modif,suppression,nettoyage
dim nouvelle_ligne$,date_temp$,date_$,i,j
application_title "Reminder "

Width 0,600 : height 0,400  :top 0,200  : left 0,300

edit 4  : left 4, 130 : top 4,60 : width 4, 300
alpha 103 : caption 103, "Mise à jour du calendrier de rappels" : left 103, 60 : top 103, 10  :font_name 103,"times new roman": font_size 103 , 20
alpha 104 : caption 104, "Evènement objet du rappel" : left 104, 150 : top 104, 90  :font_name 104,"times new roman": font_size 104 , 10
list 201 :top 201,150 : left 201, 320 : width 201, 250
button 500 : caption 500,"Ajouter"   :left 500 , 100 : top 500 , 150
button 501 : caption 501,"fin"       :left 501 , 100 : top 501 , 300
button 502 : caption 502,"Modifier"  :left 502 , 100 : top 502 , 200
button 503 : caption 503,"Supprimer" :left 503 , 100 : top 503 , 250
set_focus 4

on_click 500, ajout
on_click 501, sortie
on_click 502, modif
on_click 503, suppression
gosub nettoyage :            ' On commence par virer les évènements dont la date est dépassée

end

sub date_Ansi(date_a_convetir$)
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    retour_string$ = retour_string$ + mid$(date_a_convetir$,7,4)  +  mid$(date_a_convetir$,3,4) + mid$(date_a_convetir$,1,2)
end_sub

sub virer_slash_date(date_a_epouiller$)
    dim_local i%
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    for i% = 1 to len(date_a_epouiller$)
       if mid$(date_a_epouiller$,i%,1) <> "/" then retour_string$ = retour_string$ +  mid$(date_a_epouiller$,i%,1)
    next i%
end_sub

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","JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOÛT","SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
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,"Valider": 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,"Times new roman"
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%,10*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
height fca%,h%+22
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

sub ordonner(N%)               : ' Ordonne un list dlist combo ou memo si les
   dim_local i,a$,b$,c$        : ' items commencent par une date JJ/MM/AAAA
   for i = 1 to count(N%)      : ' selon la longueur de l'enr adapter le 50
      a$ = item_read$(N%,i)    : ' des mid$ (si le list etc.. commence par une date JJ/MM/AAAA
      b$ = left$(a$,10)
      date_ansi(b$)
      virer_slash_date(retour_string$)
      b$ = retour_string$
      b$ = b$ + mid$(a$,11,50)
      item_insert N%,i,b$
      item_delete N%,i+1
   next i
   sort N%
   for i = 1 to count(N%)
      a$ = item_read$(N%,i)
      b$ = left$(a$,8)
      c$ = right$(b$,2)+"/"+mid$(b$,5,2)+"/"+ left$(b$,4) + mid$(a$,9,50)
      item_insert N%,i,c$
      item_delete N%,i+1
   next i
end_sub

nettoyage:
dlist 200
file_load 200,"c:\config\reminder.txt"
i=1
while 1 = 1
   if i = count(200)+1 then exit_while
   date_temp$ = left$(item_read$(200,i),10)
   date_ansi(date_temp$)
   virer_slash_date(retour_string$)
   date_temp$ = retour_string$
   date_ansi(date$)
   virer_slash_date(retour_string$)
   if val(date_temp$) < val(retour_string$)+1
      item_delete 200,i
      i=i-1
   end_if
   i=i+1
end_while
ordonner(200)
file_save 200,"c:\config\reminder.txt"
delete 200
file_load 201,"c:\config\reminder.txt"
return

ajout:
if text$(4)=""
   message "Pas d'évènement ?"
   set_focus 4
   return
end_if
Calendrier(2015,1,1,900,600)
nouvelle_ligne$ = clipboard_string_paste$
date_ansi(nouvelle_ligne$)
virer_slash_date(retour_string$)
date_temp$ = retour_string$
date_ansi(date$)
virer_slash_date(retour_string$)
date_$ = retour_string$
if val(date_temp$) <= val(date_$)
   message "Date dépassée"
   return
end_if
nouvelle_ligne$=nouvelle_ligne$+" "+text$(4)
file_open_append 1,"c:\config\reminder.txt"
file_writeln 1,nouvelle_ligne$
file_close 1
file_load 201,"c:\config\reminder.txt"
ordonner(201)
text 4,""
set_focus 4
return


modif:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   nouvelle_ligne$ = message_input$("Modification de l'évènement", "" ,item_index$(201) )
   item_insert 201 ,item_index(201), nouvelle_ligne$
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                              : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 320 : width 201, 250
   file_load 201,"c:\config\reminder.txt"
return



suppression:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                               : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 320 : width 201, 250
   file_load 201,"c:\config\reminder.txt"
return

sortie:
terminate

label ajout,sortie,modif,suppression,nettoyage
dim nouvelle_ligne$,date_temp$,date_$,i,j
application_title "Reminder "

Width 0,600 : height 0,400  :top 0,200  : left 0,300

edit 4  : left 4, 130 : top 4,60 : width 4, 300
alpha 103 : caption 103, "Mise à jour du calendrier de rappels" : left 103, 60 : top 103, 10  :font_name 103,"times new roman": font_size 103 , 20
alpha 104 : caption 104, "Evènement objet du rappel" : left 104, 150 : top 104, 90  :font_name 104,"times new roman": font_size 104 , 10
list 201 :top 201,150 : left 201, 320 : width 201, 250
button 500 : caption 500,"Ajouter"   :left 500 , 100 : top 500 , 150
button 501 : caption 501,"fin"       :left 501 , 100 : top 501 , 300
button 502 : caption 502,"Modifier"  :left 502 , 100 : top 502 , 200
button 503 : caption 503,"Supprimer" :left 503 , 100 : top 503 , 250
set_focus 4

on_click 500, ajout
on_click 501, sortie
on_click 502, modif
on_click 503, suppression
gosub nettoyage :            ' On commence par virer les évènements dont la date est dépassée

end

sub date_Ansi(date_a_convetir$)
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    retour_string$ = retour_string$ + mid$(date_a_convetir$,7,4)  +  mid$(date_a_convetir$,3,4) + mid$(date_a_convetir$,1,2)
end_sub

sub virer_slash_date(date_a_epouiller$)
    dim_local i%
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    for i% = 1 to len(date_a_epouiller$)
       if mid$(date_a_epouiller$,i%,1) <> "/" then retour_string$ = retour_string$ +  mid$(date_a_epouiller$,i%,1)
    next i%
end_sub

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","JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOÛT","SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
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,"Valider": 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,"Times new roman"
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%,10*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
height fca%,h%+22
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

sub ordonner(N%)               : ' Ordonne un list dlist combo ou memo si les
   dim_local i,a$,b$,c$        : ' items commencent par une date JJ/MM/AAAA
   for i = 1 to count(N%)      : ' selon la longueur de l'enr adapter le 50
      a$ = item_read$(N%,i)    : ' des mid$ (si le list etc.. commence par une date JJ/MM/AAAA
      b$ = left$(a$,10)
      date_ansi(b$)
      virer_slash_date(retour_string$)
      b$ = retour_string$
      b$ = b$ + mid$(a$,11,50)
      item_insert N%,i,b$
      item_delete N%,i+1
   next i
   sort N%
   for i = 1 to count(N%)
      a$ = item_read$(N%,i)
      b$ = left$(a$,8)
      c$ = right$(b$,2)+"/"+mid$(b$,5,2)+"/"+ left$(b$,4) + mid$(a$,9,50)
      item_insert N%,i,c$
      item_delete N%,i+1
   next i
end_sub

nettoyage:
filebin_open_read 1,"c:\config\reminder.txt"        : ' On teste sile fichier est vide
if filebin_size(1) = 0
   filebin_close 1                                  : ' et on n'effectue pas le traitement
   file_load 201,"c:\config\reminder.txt"
   return                                           : ' (inutile dans ce cas) qui générait l'erreur
end_if
filebin_close 1
dlist 200
file_load 200,"c:\config\reminder.txt"
i=1
while 1 = 1
   if i = count(200)+1 then exit_while
   if item_read$(200,i) = "*"then end_while
   date_temp$ = left$(item_read$(200,i),10)
   date_ansi(date_temp$)
   virer_slash_date(retour_string$)
   date_temp$ = retour_string$
   date_ansi(date$)
   virer_slash_date(retour_string$)
   if val(date_temp$) < val(retour_string$)+1
      item_delete 200,i
      i=i-1
   end_if
   i=i+1
end_while
ordonner(200)
file_save 200,"c:\config\reminder.txt"
delete 200
file_load 201,"c:\config\reminder.txt"
return

ajout:
if text$(4)=""
   message "Pas d'évènement ?"
   set_focus 4
   return
end_if
Calendrier(2015,1,1,900,600)
nouvelle_ligne$ = clipboard_string_paste$
date_ansi(nouvelle_ligne$)
virer_slash_date(retour_string$)
date_temp$ = retour_string$
date_ansi(date$)
virer_slash_date(retour_string$)
date_$ = retour_string$
if val(date_temp$) <= val(date_$)
   message "Date dépassée"
   return
end_if
' Traitement de l'entrée de l'évènement
nouvelle_ligne$=nouvelle_ligne$+" "+text$(4)
file_open_append 1,"c:\config\reminder.txt"
file_writeln 1,nouvelle_ligne$
file_close 1
file_load 201,"c:\config\reminder.txt"
ordonner(201)
text 4,""
set_focus 4
return


modif:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   nouvelle_ligne$ = message_input$("Modification de l'évènement", "" ,item_index$(201) )
   item_insert 201 ,item_index(201), nouvelle_ligne$
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                              : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 320 : width 201, 250
   file_load 201,"c:\config\reminder.txt"
return



suppression:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                               : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 320 : width 201, 250
   file_load 201,"c:\config\reminder.txt"
return

sortie:
terminate

label ajout,sortie,modif,suppression,nettoyage
dim nouvelle_ligne$,date_temp$,date_$,i,j
application_title "Reminder "

Width 0,600 : height 0,400  :top 0,200  : left 0,300

edit 4  : left 4, 130 : top 4,60 : width 4, 300
alpha 103 : caption 103, "Mise à jour du calendrier de rappels" : left 103, 60 : top 103, 10  :font_name 103,"times new roman": font_size 103 , 20
alpha 104 : caption 104, "Evènement objet du rappel" : left 104, 150 : top 104, 90  :font_name 104,"times new roman": font_size 104 , 10
list 201 :top 201,150 : left 201, 320 : width 201, 250
button 500 : caption 500,"Ajouter"   :left 500 , 100 : top 500 , 150
button 501 : caption 501,"fin"       :left 501 , 100 : top 501 , 300
button 502 : caption 502,"Modifier"  :left 502 , 100 : top 502 , 200
button 503 : caption 503,"Supprimer" :left 503 , 100 : top 503 , 250
set_focus 4

on_click 500, ajout
on_click 501, sortie
on_click 502, modif
on_click 503, suppression

if file_exists("c:\config\reminder.txt")=1
   gosub nettoyage :            ' On commence par virer les évènements dont la date est dépassée
end_if

END
rem ============================================================================
sub date_Ansi(date_a_convetir$)
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    retour_string$ = retour_string$ + mid$(date_a_convetir$,7,4)  +  mid$(date_a_convetir$,3,4) + mid$(date_a_convetir$,1,2)
end_sub

sub virer_slash_date(date_a_epouiller$)
    dim_local i%
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    for i% = 1 to len(date_a_epouiller$)
       if mid$(date_a_epouiller$,i%,1) <> "/" then retour_string$ = retour_string$ +  mid$(date_a_epouiller$,i%,1)
    next i%
end_sub

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","JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOÛT","SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
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,"Valider": 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,"Times new roman"
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%,10*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
height fca%,h%+22
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

sub ordonner(N%)               : ' Ordonne un list dlist combo ou memo si les
   dim_local i,a$,b$,c$        : ' items commencent par une date JJ/MM/AAAA
   for i = 1 to count(N%)      : ' selon la longueur de l'enr adapter le 50
      a$ = item_read$(N%,i)    : ' des mid$ (si le list etc.. commence par une date JJ/MM/AAAA
      b$ = left$(a$,10)
      date_ansi(b$)
      virer_slash_date(retour_string$)
      b$ = retour_string$
      b$ = b$ + mid$(a$,11,50)
      item_insert N%,i,b$
      item_delete N%,i+1
   next i
   sort N%
   for i = 1 to count(N%)
      a$ = item_read$(N%,i)
      b$ = left$(a$,8)
      c$ = right$(b$,2)+"/"+mid$(b$,5,2)+"/"+ left$(b$,4) + mid$(a$,9,50)
      item_insert N%,i,c$
      item_delete N%,i+1
   next i
end_sub

nettoyage:
filebin_open_read 1,"c:\config\reminder.txt"        : ' On teste sile fichier est vide
if filebin_size(1) = 0
   filebin_close 1                                  : ' et on n'effectue pas le traitement
   file_load 201,"c:\config\reminder.txt"
   return                                           : ' (inutile dans ce cas) qui générait l'erreur
end_if
filebin_close 1
dlist 200
file_load 200,"c:\config\reminder.txt"
i=1
while 1 = 1
   if i = count(200)+1 then exit_while
   if item_read$(200,i) = "*"then end_while
   date_temp$ = left$(item_read$(200,i),10)
   date_ansi(date_temp$)
   virer_slash_date(retour_string$)
   date_temp$ = retour_string$
   date_ansi(date$)
   virer_slash_date(retour_string$)
   if val(date_temp$) < val(retour_string$)+1
      item_delete 200,i
      i=i-1
   end_if
   i=i+1
end_while
ordonner(200)
file_save 200,"c:\config\reminder.txt"
delete 200
file_load 201,"c:\config\reminder.txt"
return

ajout:
if text$(4)=""
   message "Pas d'évènement ?"
   set_focus 4
   return
end_if
Calendrier(2015,1,1,900,600)
nouvelle_ligne$ = clipboard_string_paste$
date_ansi(nouvelle_ligne$)
virer_slash_date(retour_string$)
date_temp$ = retour_string$
date_ansi(date$)
virer_slash_date(retour_string$)
date_$ = retour_string$
if val(date_temp$) <= val(date_$)
   message "Date dépassée"
   return
end_if
' Traitement de l'entrée de l'évènement
nouvelle_ligne$=nouvelle_ligne$+" "+text$(4)
file_open_append 1,"c:\config\reminder.txt"
file_writeln 1,nouvelle_ligne$
file_close 1
file_load 201,"c:\config\reminder.txt"
ordonner(201)
text 4,""
set_focus 4
return


modif:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   nouvelle_ligne$ = message_input$("Modification de l'évènement", "" ,item_index$(201) )
   item_insert 201 ,item_index(201), nouvelle_ligne$
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                              : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 320 : width 201, 250
   file_load 201,"c:\config\reminder.txt"
return



suppression:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                               : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 320 : width 201, 250
   file_load 201,"c:\config\reminder.txt"
return

sortie:
terminate

if file_exists("c:\config\reminder.txt")=1
   gosub nettoyage :            ' On commence par virer les évènements dont la date est dépassée
else
   file_open_write 1,"c:\config\reminder.txt"
end_if

label ajout,sortie,modif,suppression,nettoyage
dim nouvelle_ligne$,date_temp$,date_$,i,j
application_title "Reminder "

Width 0,600 : height 0,400  :top 0,200  : left 0,300

edit 4  : left 4, 130 : top 4,60 : width 4, 300
alpha 103 : caption 103, "Mise à jour du calendrier de rappels" : left 103, 60 : top 103, 10  :font_name 103,"times new roman": font_size 103 , 20
alpha 104 : caption 104, "Evènement objet du rappel" : left 104, 150 : top 104, 90  :font_name 104,"times new roman": font_size 104 , 10
list 201 :top 201,150 : left 201, 250 : width 201, 320
button 500 : caption 500,"Ajouter"   :left 500 , 100 : top 500 , 150
button 501 : caption 501,"fin"       :left 501 , 100 : top 501 , 300
button 502 : caption 502,"Modifier"  :left 502 , 100 : top 502 , 200
button 503 : caption 503,"Supprimer" :left 503 , 100 : top 503 , 250
set_focus 4

on_click 500, ajout
on_click 501, sortie
on_click 502, modif
on_click 503, suppression
if file_exists("c:\config\reminder.txt")=1
   gosub nettoyage :            ' On commence par virer les évènements dont la date est dépassée
else
   if dir_exists("c:\config")=0 then dir_make "c:\config"
   file_open_write 1,"c:\config\reminder.txt"
   file_close 1
end_if

end

sub date_Ansi(date_a_convetir$)
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    retour_string$ = retour_string$ + mid$(date_a_convetir$,7,4)  +  mid$(date_a_convetir$,3,4) + mid$(date_a_convetir$,1,2)
end_sub

sub virer_slash_date(date_a_epouiller$)
    dim_local i%
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    for i% = 1 to len(date_a_epouiller$)
       if mid$(date_a_epouiller$,i%,1) <> "/" then retour_string$ = retour_string$ +  mid$(date_a_epouiller$,i%,1)
    next i%
end_sub

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","JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOÛT","SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
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,"Valider": 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,"Times new roman"
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%,10*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
height fca%,h%+22
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

sub ordonner(N%)               : ' Ordonne un list dlist combo ou memo si les
   dim_local i,a$,b$,c$        : ' items commencent par une date JJ/MM/AAAA
   for i = 1 to count(N%)      : ' selon la longueur de l'enr adapter le 50
      a$ = item_read$(N%,i)    : ' des mid$ (si le list etc.. commence par une date JJ/MM/AAAA
      b$ = left$(a$,10)
      date_ansi(b$)
      virer_slash_date(retour_string$)
      b$ = retour_string$
      b$ = b$ + mid$(a$,11,50)
      item_insert N%,i,b$
      item_delete N%,i+1
   next i
   sort N%
   for i = 1 to count(N%)
      a$ = item_read$(N%,i)
      b$ = left$(a$,8)
      c$ = right$(b$,2)+"/"+mid$(b$,5,2)+"/"+ left$(b$,4) + mid$(a$,9,50)
      item_insert N%,i,c$
      item_delete N%,i+1
   next i
end_sub

nettoyage:
filebin_open_read 1,"c:\config\reminder.txt"        : ' On teste sile fichier est vide
if filebin_size(1) = 0
   filebin_close 1                                  : ' et on n'effectue pas le traitement
   file_load 201,"c:\config\reminder.txt"
   return                                           : ' (inutile dans ce cas) qui générait l'erreur
end_if
filebin_close 1
dlist 200
file_load 200,"c:\config\reminder.txt"
i=1
while 1 = 1
   if i = count(200)+1 then exit_while
   date_temp$ = left$(item_read$(200,i),10)
   date_ansi(date_temp$)
   virer_slash_date(retour_string$)
   date_temp$ = retour_string$
   date_ansi(date$)
   virer_slash_date(retour_string$)
   if val(date_temp$) < val(retour_string$)+1
      item_delete 200,i
      i=i-1
   end_if
   i=i+1
end_while
ordonner(200)
file_save 200,"c:\config\reminder.txt"
delete 200
file_load 201,"c:\config\reminder.txt"
return

ajout:
if text$(4)=""
   message "Pas d'évènement ?"
   set_focus 4
   return
end_if
Calendrier(2015,1,1,900,600)
nouvelle_ligne$ = clipboard_string_paste$
date_ansi(nouvelle_ligne$)
virer_slash_date(retour_string$)
date_temp$ = retour_string$
date_ansi(date$)
virer_slash_date(retour_string$)
date_$ = retour_string$
if val(date_temp$) <= val(date_$)
   message "Date dépassée"
   return
end_if
' Traitement de l'entrée de l'évènement
nouvelle_ligne$=nouvelle_ligne$+" "+text$(4)
file_open_append 1,"c:\config\reminder.txt"
file_writeln 1,nouvelle_ligne$
file_close 1
file_load 201,"c:\config\reminder.txt"
ordonner(201)
text 4,""
set_focus 4
return


modif:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   nouvelle_ligne$ = message_input$("Modification de l'évènement", "" ,item_index$(201) )
   item_insert 201 ,item_index(201), nouvelle_ligne$
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                              : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 320 : width 201, 250
   file_load 201,"c:\config\reminder.txt"
return



suppression:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                               : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 320 : width 201, 250
   file_load 201,"c:\config\reminder.txt"
return

sortie:
terminate

label ajout,sortie,modif,suppression,nettoyage
dim nouvelle_ligne$,date_temp$,date_$,i,j
application_title "Reminder "

Width 0,600 : height 0,400  :top 0,200  : left 0,300

edit 4  : left 4, 130 : top 4,60 : width 4, 300
alpha 103 : caption 103, "Mise à jour du calendrier de rappels" : left 103, 60 : top 103, 10  :font_name 103,"times new roman": font_size 103 , 20
alpha 104 : caption 104, "Evènement objet du rappel" : left 104, 150 : top 104, 90  :font_name 104,"times new roman": font_size 104 , 10
list 201 :top 201,150 : left 201, 250 : width 201, 320
button 500 : caption 500,"Ajouter"   :left 500 , 100 : top 500 , 150
button 501 : caption 501,"fin"       :left 501 , 100 : top 501 , 300
button 502 : caption 502,"Modifier"  :left 502 , 100 : top 502 , 200
button 503 : caption 503,"Supprimer" :left 503 , 100 : top 503 , 250
set_focus 4

on_click 500, ajout
on_click 501, sortie
on_click 502, modif
on_click 503, suppression
if file_exists("c:\config\reminder.txt")=1
   gosub nettoyage :            ' On commence par virer les évènements dont la date est dépassée
else
   if dir_exists("c:\config")=0 then dir_make "c:\config"
   file_open_write 1,"c:\config\reminder.txt"
   file_close 1
end_if

end

sub date_Ansi(date_a_convetir$)
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    retour_string$ = retour_string$ + mid$(date_a_convetir$,7,4)  +  mid$(date_a_convetir$,3,4) + mid$(date_a_convetir$,1,2)
end_sub

sub virer_slash_date(date_a_epouiller$)
    dim_local i%
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    for i% = 1 to len(date_a_epouiller$)
       if mid$(date_a_epouiller$,i%,1) <> "/" then retour_string$ = retour_string$ +  mid$(date_a_epouiller$,i%,1)
    next i%
end_sub

sub ordonner(N%)               : ' Ordonne un list dlist combo ou memo si les
   dim_local i,a$,b$,c$        : ' items commencent par une date JJ/MM/AAAA
   for i = 1 to count(N%)      : ' selon la longueur de l'enr adapter le 50
      a$ = item_read$(N%,i)    : ' des mid$ (si le list etc.. commence par une date JJ/MM/AAAA
      b$ = left$(a$,10)
      date_ansi(b$)
      virer_slash_date(retour_string$)
      b$ = retour_string$
      b$ = b$ + mid$(a$,11,50)
      item_insert N%,i,b$
      item_delete N%,i+1
   next i
   sort N%
   for i = 1 to count(N%)
      a$ = item_read$(N%,i)
      b$ = left$(a$,8)
      c$ = right$(b$,2)+"/"+mid$(b$,5,2)+"/"+ left$(b$,4) + mid$(a$,9,50)
      item_insert N%,i,c$
      item_delete N%,i+1
   next i
end_sub

nettoyage:
filebin_open_read 1,"c:\config\reminder.txt"        : ' On teste sile fichier est vide
if filebin_size(1) = 0
   filebin_close 1                                  : ' et on n'effectue pas le traitement
   file_load 201,"c:\config\reminder.txt"
   return                                           : ' (inutile dans ce cas) qui générait l'erreur
end_if
filebin_close 1
dlist 200
file_load 200,"c:\config\reminder.txt"
i=1
while 1 = 1
   if i = count(200)+1 then exit_while
   date_temp$ = left$(item_read$(200,i),10)
   date_ansi(date_temp$)
   virer_slash_date(retour_string$)
   date_temp$ = retour_string$
   date_ansi(date$)
   virer_slash_date(retour_string$)
   if val(date_temp$) < val(retour_string$)+1
      item_delete 200,i
      i=i-1
   end_if
   i=i+1
end_while
ordonner(200)
file_save 200,"c:\config\reminder.txt"
delete 200
file_load 201,"c:\config\reminder.txt"
return

ajout:
if text$(4)=""
   message "Pas d'évènement ?"
   set_focus 4
   return
end_if
execute_wait "c:\outils\Calendrier"
nouvelle_ligne$ = clipboard_string_paste$
date_ansi(nouvelle_ligne$)
virer_slash_date(retour_string$)
date_temp$ = retour_string$
date_ansi(date$)
virer_slash_date(retour_string$)
date_$ = retour_string$
if val(date_temp$) <= val(date_$)
   message "Date dépassée"
   return
end_if
' Traitement de l'entrée de l'évènement
nouvelle_ligne$=nouvelle_ligne$+" "+text$(4)
file_open_append 1,"c:\config\reminder.txt"
file_writeln 1,nouvelle_ligne$
file_close 1
file_load 201,"c:\config\reminder.txt"
ordonner(201)
text 4,""
set_focus 4
  clipboard_string_copy date$
return


modif:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   nouvelle_ligne$ = message_input$("Modification de l'évènement", "" ,item_index$(201) )
   item_insert 201 ,item_index(201), nouvelle_ligne$
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                              : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 250 : width 201, 320
   file_load 201,"c:\config\reminder.txt"
return



suppression:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                               : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 250 : width 201, 320
   file_load 201,"c:\config\reminder.txt"
return

sortie:
terminate

label fin
hide 0
DIM a%, x%, y%, w%, h%
a% = val( right$(date$,4))
x% = 10: y% = 10: w% = 1000: h% =720
Calendrier(a%,x%,y%,w%,h%)

goto fin     : ' Evite le schklong au terminate qui doit être placé à la FIN

' ==============================================================================
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","JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOÛT","SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
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,"Selectionnez une date"

2D_TARGET_IS fca%+5: 2D_FILL_COLOR 255,255,200
PRINT_TARGET_IS fca%+5: FONT_NAME fca%+5,"Times new roman"
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%,10*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
height fca%,h%+22
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
fin:
TERMINATE

label ajout,sortie,modif,suppression,nettoyage
dim nouvelle_ligne$,date_temp$,date_$,i,j
application_title "Reminder "

Width 0,600 : height 0,400  :top 0,200  : left 0,300

edit 4  : left 4, 130 : top 4,60 : width 4, 300
alpha 103 : caption 103, "Mise à jour du calendrier de rappels" : left 103, 60 : top 103, 10  :font_name 103,"times new roman": font_size 103 , 20
alpha 104 : caption 104, "Evènement objet du rappel" : left 104, 150 : top 104, 90  :font_name 104,"times new roman": font_size 104 , 10
list 201 :top 201,150 : left 201, 250 : width 201, 320
button 500 : caption 500,"Ajouter"   :left 500 , 100 : top 500 , 150
button 501 : caption 501,"fin"       :left 501 , 100 : top 501 , 300
button 502 : caption 502,"Modifier"  :left 502 , 100 : top 502 , 200
button 503 : caption 503,"Supprimer" :left 503 , 100 : top 503 , 250
set_focus 4

on_click 500, ajout
on_click 501, sortie
on_click 502, modif
on_click 503, suppression
if file_exists("c:\config\reminder.txt")=1
   gosub nettoyage :            ' On commence par virer les évènements dont la date est dépassée
else
   if dir_exists("c:\config")=0 then dir_make "c:\config"
   file_open_write 1,"c:\config\reminder.txt"
   file_close 1
end_if

end

sub date_Ansi(date_a_convetir$)
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    retour_string$ = retour_string$ + mid$(date_a_convetir$,7,4)  +  mid$(date_a_convetir$,3,4) + mid$(date_a_convetir$,1,2)
end_sub

sub virer_slash_date(date_a_epouiller$)
    dim_local i%
    if variable ("retour_string$") = 0 then dim retour_string$
    retour_string$ = ""
    for i% = 1 to len(date_a_epouiller$)
       if mid$(date_a_epouiller$,i%,1) <> "/" then retour_string$ = retour_string$ +  mid$(date_a_epouiller$,i%,1)
    next i%
end_sub

sub ordonner(N%)               : ' Ordonne un list dlist combo ou memo si les
   dim_local i,a$,b$,c$        : ' items commencent par une date JJ/MM/AAAA
   for i = 1 to count(N%)      : ' selon la longueur de l'enr adapter le 50
      a$ = item_read$(N%,i)    : ' des mid$ (si le list etc.. commence par une date JJ/MM/AAAA
      b$ = left$(a$,10)
      date_ansi(b$)
      virer_slash_date(retour_string$)
      b$ = retour_string$
      b$ = b$ + mid$(a$,11,50)
      item_insert N%,i,b$
      item_delete N%,i+1
   next i
   sort N%
   for i = 1 to count(N%)
      a$ = item_read$(N%,i)
      b$ = left$(a$,8)
      c$ = right$(b$,2)+"/"+mid$(b$,5,2)+"/"+ left$(b$,4) + mid$(a$,9,50)
      item_insert N%,i,c$
      item_delete N%,i+1
   next i
end_sub

nettoyage:
filebin_open_read 1,"c:\config\reminder.txt"        : ' On teste sile fichier est vide
if filebin_size(1) = 0
   filebin_close 1                                  : ' et on n'effectue pas le traitement
   file_load 201,"c:\config\reminder.txt"
   return                                           : ' (inutile dans ce cas) qui générait l'erreur
end_if
filebin_close 1
dlist 200
file_load 200,"c:\config\reminder.txt"
i=1
while 1 = 1
   if i = count(200)+1 then exit_while
   date_temp$ = left$(item_read$(200,i),10)
   date_ansi(date_temp$)
   virer_slash_date(retour_string$)
   date_temp$ = retour_string$
   date_ansi(date$)
   virer_slash_date(retour_string$)
   if val(date_temp$) < val(retour_string$)+1
      item_delete 200,i
      i=i-1
   end_if
   i=i+1
end_while
ordonner(200)
file_save 200,"c:\config\reminder.txt"
delete 200
file_load 201,"c:\config\reminder.txt"
return

ajout:
if text$(4)=""
   message "Pas d'évènement ?"
   set_focus 4
   return
end_if
execute_wait "c:\outils\Calendrier"
nouvelle_ligne$ = clipboard_string_paste$
date_ansi(nouvelle_ligne$)
virer_slash_date(retour_string$)
date_temp$ = retour_string$
date_ansi(date$)
virer_slash_date(retour_string$)
date_$ = retour_string$
if val(date_temp$) <= val(date_$)
   message "Date dépassée"
   return
end_if
' Traitement de l'entrée de l'évènement
nouvelle_ligne$=nouvelle_ligne$+" "+text$(4)
file_open_append 1,"c:\config\reminder.txt"
file_writeln 1,nouvelle_ligne$
file_close 1
file_load 201,"c:\config\reminder.txt"
ordonner(201)
text 4,""
set_focus 4
  clipboard_string_copy date$
return


modif:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   nouvelle_ligne$ = message_input$("Modification de l'évènement", "" ,item_index$(201) )
   item_insert 201 ,item_index(201), nouvelle_ligne$
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                              : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 250 : width 201, 320
   file_load 201,"c:\config\reminder.txt"
return



suppression:
   if clicked(201) = 0
      message "Cliquez un évènement !"
      return
   end_if
   item_delete 201,item_index(201)
   file_save 201,"c:\config\reminder.txt"
   delete 201                                               : ' Réinitialise la fonction cliqued
   list 201 :top 201,150 : left 201, 250 : width 201, 320
   file_load 201,"c:\config\reminder.txt"
return

sortie:
terminate

label fin
hide 0
DIM a%, x%, y%, w%, h%
a% = val( right$(date$,4))
x% = 10: y% = 10: w% = 1000: h% =720
Calendrier(a%,x%,y%,w%,h%)

goto fin     : ' Evite le schklong au terminate qui doit être placé à la FIN

' ==============================================================================
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","JANVIER","FÉVRIER","MARS","AVRIL","MAI","JUIN","JUILLET","AOÛT","SEPTEMBRE","OCTOBRE","NOVEMBRE","DÉCEMBRE"
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,"Selectionnez une date"

2D_TARGET_IS fca%+5: 2D_FILL_COLOR 255,255,200
PRINT_TARGET_IS fca%+5: FONT_NAME fca%+5,"Times new roman"
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%,10*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
height fca%,h%+22
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
fin:
TERMINATE