FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» Gestionnaire de Projets Panoramic
par Minibug Aujourd'hui à 2:10

» Mah-Jong européen new-look
par jjn4 Hier à 16:35

» Button_picture
par pascal10000 Hier à 11:41

» Pourquoi le compilateur stagne
par Minibug Hier à 11:09

» 4 (en analyse): SYNEDIT_TARGET_IS_OBJECT devient inactif
par Jack Hier à 10:09

» 3 (en analyse): Mauvaise interprétation du string "THEN"
par Jack Hier à 10:03

» KGF.dll - demandes ou suggestions de modifications ou ajouts
par Marc Hier à 10:00

» KGF_dll - nouvelles versions
par pascal10000 Mer 13 Déc 2017 - 17:27

» track_bar circulaire
par Klaus Mar 12 Déc 2017 - 13:54

» API Windows
par Klaus Mar 12 Déc 2017 - 3:21

» Cartes de voeux, menus, etc.
par JL35 Lun 11 Déc 2017 - 17:48

» a l'aide klaus
par Minibug Lun 11 Déc 2017 - 11:42

» bug SYNEDIT_TARGET_IS_OBJECT
par Jack Lun 11 Déc 2017 - 0:16

» Jukebox : Serge Reggiani
par papydall Sam 9 Déc 2017 - 5:58

» Ecouter la radio fm sur votre pc
par pascal10000 Sam 9 Déc 2017 - 3:42

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Décembre 2017
LunMarMerJeuVenSamDim
    123
45678910
11121314151617
18192021222324
25262728293031
CalendrierCalendrier

Partagez | 
 

 Reminder

Voir le sujet précédent Voir le sujet suivant Aller en bas 
AuteurMessage
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Reminder   Dim 22 Mar 2015 - 20:33

Bonjour tout le monde.

durant mes longues absences, j'ai quand même l'opportunité de coder un peu.

Voici 2 petits codes qui m'ont permis de réinventer l'eau tiède (ou le  bidon de 2 litres)

Le premier va lire les enregistrements d'un fichier texte, au format : "JJ/MM/AA texte libre" et affiche en message le texte libre en question si la date du PC coïncide avec la date de l'enregistrement. Transformé en .EXE il peut être mis dans le dossier démarrage de l'ordi.

Code:

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

le second permet la mise à jour du fichier de texte en question

Code:

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

A noter que ce dernier fait appel à une sub calendrier publiée ici par... j'ai oublié... Shame on me !

Bonne journée à toutes et à  tous

Edit : Ces petits programmes permettent à la tête creuse que je suis d'un peu moins manquer ses rendez vous...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Froggy One

avatar

Nombre de messages : 395
Date d'inscription : 06/01/2012

MessageSujet: Re   Lun 23 Mar 2015 - 23:03

Super Mumu ! Tête creuse moi aussi, je viens de tester ton programme et j'obtiens une erreur 33 (not logical expression) en ligne 178 :

if val(date_temp$) < val(retour_string$)+1

Mon fichier reminder.txt ne contenant pour l'heure que : 03/07/15 fin

J'aimerais bien te dire pourquoi mais j'en suis encore incapable...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gaeldwest.wordpress.com
Jicehel

avatar

Nombre de messages : 5863
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Reminder   Lun 23 Mar 2015 - 23:11

If suffit de faire un test avant pour savoir si les chaines de caractères sont vides Wink
Si vide => afficher un beau message.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Re: Reminder   Mar 24 Mar 2015 - 2:13

Bonsoir à toutes et à tous.
@Froggy One
On va faire un concours de tête creuse... Fais gaffe j'suis fort à ce jeu là Very Happy .

Je n'ai pas fini de me cogner la tête contre les murs... LE FORMAT DE LA DATE C'EST :
JJ/MM/AAAA !!!! affraid  affraid  affraid

Mille excuses pour cette erreur
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Froggy One

avatar

Nombre de messages : 395
Date d'inscription : 06/01/2012

MessageSujet: Re   Mar 24 Mar 2015 - 9:54

Bonjour tout le monde !

@Mumu : gagné !

Mine de rien ton reminder est ADOPTÉ ! Il me sera utile au boulot. Merci encore !!!!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gaeldwest.wordpress.com
Froggy One

avatar

Nombre de messages : 395
Date d'inscription : 06/01/2012

MessageSujet: ReRe   Jeu 26 Mar 2015 - 19:48

Me voila: je viens d'installer REMINDER chez moi,et pour le tester je mets une note à aujourd'hui. J'ai un message INDEX LIST OUT OF BOUNDS avec le second programme (l'éditeur) dont aucun bouton ne semble vouloir fonctionner. Je ne comprends pas pourquoi... Par contre, le premier programme m'affiche bien le message ! Alors alors ?
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gaeldwest.wordpress.com
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Re: Reminder   Ven 27 Mar 2015 - 16:08

@Froggy one
Le problème se produit quand le fichier reminder.txt est vide.
Il n"est pas vide me diras tu. Et ce à juste titre, car tu viens d'y entrer un événement !
Que nenni..
Les événements du jour sont effacés (par la proc nettoyage:)
Donc le fichier est vide (C'est  complètement QFD)
Aïe c'est un problème car on peu bien ne pas avoir d'événement prévu ou commencer l'utilisation de ce programme...
Je corrige et j'édite

Edit :

Code:

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

ça, ça doit marcher... (je croise les orteils...)
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Froggy One

avatar

Nombre de messages : 395
Date d'inscription : 06/01/2012

MessageSujet: Re   Ven 27 Mar 2015 - 19:06

Euh ben... non ! lol!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gaeldwest.wordpress.com
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Re: Reminder   Sam 28 Mar 2015 - 0:55

Il se passe quoi ?
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Froggy One

avatar

Nombre de messages : 395
Date d'inscription : 06/01/2012

MessageSujet: Re   Lun 30 Mar 2015 - 19:11

Il se passe que comme dirait Jean-Claude, je réagis mal aux antalgiques ! Je viens de ressayer ton excellent programme et il fonctionne parfaitement !! Toutes mes excuses et bonne soirée !!! Embarassed Embarassed Embarassed
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gaeldwest.wordpress.com
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Re: Reminder   Mar 31 Mar 2015 - 1:37

Y'a pas de problème... Very Happy
Content que mes élucubration Panoramiciennes rendent service à quelqu'un.
Je tiens à mentionner à nouveau l'usage que j'ai fait d'une sub calendrier Top moumoute produit de... la communauté Panoramic, j'ai oublié l'auteur mais foi de veau je retrouverai
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Reminder   Mar 31 Mar 2015 - 8:28

Bravo Mumu,

Pour éviter d'avoir le vilain message d'erreur au premier lancement (et tant que l'on n'a pas enregistré de rappel), tu tests l’existence du fichier.

Regarde à la ligne 22:

Code:
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

Ensuite il te reste à caler le programme sur le répertoire courant ou alors de créer un répertoire dans "Mes documents" par exemple pour y placer le fichier reminder.txt.

A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Re: Reminder   Mar 31 Mar 2015 - 14:49

Bonjour tout le monde.
@Jean Claude
Merci et bien vu le test.
On peut même aller plus loin. S'il n'existe pas on le crée
Code:

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

Bien entendu ça suppose que le répertoire "c:\config" (ou tout autre) existe bien.
Mais ce n'est pas difficile ni hors de notre portée de tester cette existence et de le créer s'il n'existe pas.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jean Claude

avatar

Nombre de messages : 5086
Age : 63
Localisation : 83 Var
Date d'inscription : 07/05/2009

MessageSujet: Re: Reminder   Mar 31 Mar 2015 - 17:23

Effectivement, si le répertoire n'existe pas le programme pourrait proposer sa création à l'utilisateur.

A+
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Re: Reminder   Mar 31 Mar 2015 - 23:56

Bon ben voilà. si le fichier ou le répertoire n’existent pas ils sont automatiquement créés.



Code:

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

Bonsoir à toutes et à tous

Edit : J'ai relevé et corrigé un bug qui s'était glissé là !
J'en ai profité pour élargir le list d'affichage
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Froggy One

avatar

Nombre de messages : 395
Date d'inscription : 06/01/2012

MessageSujet: Re   Sam 4 Avr 2015 - 10:34

Rebonjour !

Une fois qu'on utilise quotidiennement REMINDER, plus de problème, par contre, sur un fichier reminder.txt plein avec des dates antérieures au jour où on l'ouvre, rien n'est visible... il faudrait donc effectivement créer lefichier s'il n'existe pas, mais encore, y ajouter une ligne. Je viens de tester, le programme n'ouvre pas "30/03/2015 faire le jardin". J'ai ajouté "10/04/2015 rien" et comme ça ça marche... mais il a effacé tout seul la ligne du 30 mars. Je reteste dans la semaine et je vous tiens au courant, j'ai hélas d'autres trucs en cours pale

À bientôt !!!
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gaeldwest.wordpress.com
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Re: Reminder   Sam 4 Avr 2015 - 14:56

C'est normal les événements antérieurs à la data courante sont effacés  ( voir ligne 22 ).
Donc la ligne "30/03/2015 faire le jardin" ne peut pas apparaître car la date est dépassée -> effacée.
On peut invalider la ligne (mettre en rem) mais le fichier reminder.txt va grandir... grandir.. Bon c'est vrai qu'on a de la place sur nos disques (encore que pas toujours), et puis ça ouvrirait sur une gestion d'archives et pourquoi pas de statistiques. Mais là on dépasse largement l'ambition première de l'utilitaire...
Mais c'est faisable...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Re: Reminder   Sam 4 Avr 2015 - 18:47

Oh là là !
J'viens de me rendre compte d'un truc bien ennuyeux...
Si on programme un événement pour l'année en cours (2015 par ex), ça marche le feux de dieu.
Si on a le malheur de voir un peu plus loin (2016 par ex), là ça plante lamentablement.
Panoramic prétend (et ce avec toutes les versions que j'ai essayé) qu'une comparaison logique n'est pas bonne (dans un while), et ce dans la sub calendrier. Le problème c'est que la sub en question n'est pas active à ce moment là...!
J'ai momentanément tourné le problème en faisant appel à un exécutable contenant la dite sub. Voilà les codes modifiés de mise_a_jour.bas et de calendrier.bas (à transformer tous les 2 en exe).

mise_a_jour.bas


Code:

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


Calendrier.bas

Code:

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Re: Reminder   Sam 4 Avr 2015 - 18:47

Oh là là !
J'viens de me rendre compte d'un truc bien ennuyeux...
Si on programme un événement pour l'année en cours (2015 par ex), ça marche le feux de dieu.
Si on a le malheur de voir un peu plus loin (2016 par ex), là ça plante lamentablement.
Panoramic prétend (et ce avec toutes les versions que j'ai essayé) qu'une comparaison logique n'est pas bonne (dans un while), et ce dans la sub calendrier. Le problème c'est que la sub en question n'est pas active à ce moment là...!
J'ai momentanément tourné le problème en faisant appel à un exécutable contenant la dite sub. Voilà les codes modifiés de mise_a_jour.bas et de calendrier.bas (à transformer tous les 2 en exe).

mise_a_jour.bas


Code:

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


Calendrier.bas

Code:

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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Mumu



Nombre de messages : 172
Localisation : 45
Date d'inscription : 20/12/2012

MessageSujet: Re: Reminder   Sam 4 Avr 2015 - 18:49

Tiens ! Pourquoi le post est il passé deux fois Question Question Question Suspect
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Froggy One

avatar

Nombre de messages : 395
Date d'inscription : 06/01/2012

MessageSujet: Re   Mar 7 Avr 2015 - 10:01

Very Happy C'est quand même pas mal ! Le mieux est l'ennemi du bien...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gaeldwest.wordpress.com
Contenu sponsorisé




MessageSujet: Re: Reminder   

Revenir en haut Aller en bas
 
Reminder
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» [Résolu] Window ne repond plus !
» [Résolu] Message Windows

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Vos sources, vos utilitaires à partager-
Sauter vers: