rem ' Perpétuoramic - Calcul du calendrier grégorien perpétuel
dim i$ , i% , j% , x , y , z : rem Variables générales à utilisation multiple
dim an% , mo% , jo% : rem ANnée, MoiS et JouR du jour même
dim be$(4) : rem Titres des Boutons d`Ecriture
dim cc% : rem Couleur retenue pour les Caractères à écrire dans le calendrier
dim cf% : rem Couleur de Fond retenue pour écrire dans le calendrier
dim cc1$(8) , cc2$(8) , cc3$(8) : rem Couleurs possibles des Caractères
dim cf1$(8) , cf2$(8) , cf3$(8) : rem Couleurs possibles du Fond
dim cs$(26) : rem Caractères Spéciaux
dim hg$ , hm$ : rem Variables spécifiques de la pendule
dim ji%(5) : rem Jours Inexistants dans le calendrier
dim jo$(7) , mo$(12) , an$ : rem Données pour les JOurs, MOis et ANnée
dim mx% , my% : rem Mesures de l`écran en X et Y
dim oc% : rem Où s`est passé le dernier click entre édit 680 et mémo 700
dim sr% : rem Style Retenu pour l`écriture dans le calendrier
dim tb$(8) : rem Titre des Boutons
an$=right$(date$,4) : an%=val(an$) : ' pour la version, voir dans apropos()
mo%=val(mid$(date$,4,2)) : jo%=val(left$(date$,2))
label change : rem Effets d`un on-change
label choix : rem Effets des boutons de commande d`écriture
label clic : rem rem Effets des diverses autres commandes on-click
label coul : rem Couleur des caractères et du fond de la note brève
label divers : rem Effets de diverses commandes
label go : rem Effets des boutons de commande principaux
label key : rem Utilisation des zones d`écriture avec la touche ENTER
label montre : rem Fait fonctionner la pendule
label passe : rem Passe à l`année suivante ou précédente
rem datas utilisés pour la gestion du programme
data "Dim" , "Lun" , "Mar" , "Mer" , "Jeu" , "Ven" , "Sam"
data "JAN" , "FÉV" , "MAR" , "AVR" , "MAI" , "JUIN" , "JUIL"
data "AOÛ" , "SEP" , "OCT" , "NOV" , "DÉC"
data 95 , 96 , 160 , 320 , 384
data "A propos" , chr$(240) , "Sortir" , "Copy Cal"
data "Aide" , chr$(239) , "Écrire" , "Quitter"
data "255" , "255" , "255" , "100" , "100" , "100" , "255" , "000" , "000"
data "000" , "255" , "000" , "000" , "100" , "255" , "255" , "200" , "255"
data "255" , "255" , "000" , "000" , "000" , "000" , "255" , "000" , "000"
data "255" , "160" , "000" , "000" , "000" , "000" , "000" , "150" , "000"
data "000" , "255" , "255" , "255" , "100" , "255" , "180" , "180" , "180"
data "255" , "255" , "255"
data "Copier" , "Coller" , "Vider" , "Détruire"
data "—" , "•" , "¤" , "½" , "¼" , "¾" , "º" , "¹" , "²" , "³" , "ª" , "×" , "÷"
data "±" , "¥" , "«" , "»" , "†" , "‡" , "ƒ" , "‰" , "¶" , "
" , "ß" , "É" , "È"
for i%=0 to 6
read jo$(i%)
next i%
for i%=1 to 12
read mo$(i%)
next i%
for i%=1 to 5
read ji%(i%)
next i%
for i%=1 to 8
read tb$(i%)
next i%
for i%=1 to 8
read cc1$(i%) : read cc2$(i%) : read cc3$(i%)
next i%
for i%=1 to 8
read cf1$(i%) : read cf2$(i%) : read cf3$(i%)
next i%
for i%=1 to 4
read be$(i%)
next i%
for i%=1 to 26
read cs$(i%)
next i%
rem form0 = fenêtre de fond d`écran
full_space 0
mx%=screen_x
my%=screen_y
rem Fenêtre publicitaire d`attente 1
form 10
full_space 10
caption 10," Espace publicitaire"
alpha 11 : rem Soleil
parent 11,10
left 11,50
top 11,100
font_size 11,200
font_color 11,255,255,0
font_name 11,"Wingdings"
caption 11,chr$(82)
alpha 12 : rem Terre
parent 12,10
left 12,250
top 12,300
font_size 12,125
font_color 12,0,255,0
font_name 12,"Webdings"
caption 12,chr$(252)
alpha 13 : rem Satellite
parent 13,10
left 13,30
top 13,400
font_size 13,99
font_color 13,0,0,255
font_name 13,"Webdings"
caption 13,chr$(107)
alpha 14 : rem Éphéméride
parent 14,10
left 14,550
top 14,30
font_size 14,120
font_name 14,"Webdings"
caption 14,chr$(166)
alpha 15 : rem Texte 1
parent 15,10
left 15,550
top 15,180
font_size 15,49
caption 15,"PERPÉTUORAMIC"
alpha 16 : rem Texte 2
parent 16,10
left 16,550
top 16,280
font_size 16,20
i$="Un calendrier qui peut vous suivre toute votre vie"+chr$(13)
i$=i$+"en vous donnant les détails les plus précis de"+chr$(13)
i$=i$+"toutes les années que vous aurez l'occasion"+chr$(13)
i$=i$+"de connaître, et même au delà..."
caption 16,i$
alpha 17 : rem Texte 3
parent 17,10
left 17,200
top 17,600
font_size 17,20
font_color 17,155,0,255
i$="Mais aussi un calendrier détaillé des nombreuses années"+chr$(13)
i$=i$+"qui appartiennent maintenant à l'histoire..."
caption 17,i$
alpha 18 : rem Sablier
parent 18,10
left 18,900
top 18,450
font_size 18,99
font_color 18,255,100,0
font_name 18,"Wingdings"
caption 18,chr$(54)
progress_bar 19 : rem Barre de progression de l`installation
parent 19,10
left 19,50
width 19,mx%-100
height 19,35
min 19,0
max 19,100
image 20 : rem Va servir pour faire des copies d`écran
2d_target_is 0
for i%=1 to 3 : rem panels pour compléter le tableau des annotations mensuelles
panel i%+29 : rem Obj-syst n° 30, 31 et 32
top i%+29,(i%+28)*(my%-90)/32
width i%+29,(mx%-36)/12
height i%+29,(my%-90)/32
next i%
rem Affichage du support des jours et mois de l`année -------------------------
for x=1 to 12 : rem Obj-syst n° 33 à 416 à pas de 1
for y=1 to 32
panel x*32+y
left x*32+y,(x-1)*(mx%-24)/12
top x*32+y,(y-1)*(my%-90)/32
width x*32+y,(mx%-36)/12
height x*32+y,(my%-90)/32
color x*32+y,255,200,255
font_name x*32+y,"Arial"
next y
position 19,x*8
color x*32+1,255,0,255
font_bold x*32+1
font_size x*32+1,12
inactive x*32+1
on_click x*32+1,divers
next x
for i%=1 to 5
hide ji%(i%)
next i%
color 224,0,0,255
font_color 224,255,0,0
font_bold 224
font_size 224,12
gosub montre
on_click 224,clic
button 420 : rem Bouton de commande central -----------------------------------
left 420,left(95)
top 420,top(95)
width 420,width(95)
height 420,height(95)*2+2
font_bold 420
font_size 420,30
font_name 420,"Arial"
caption 420,"CLIC"
inactive 420
on_click 420,clic
button 430 : rem Bouton Année précédente
left 430,left(160)
top 430,top(160)
width 430,width(160)
height 430,height(160)
font_bold 430
font_size 430,20
font_name 430,"Wingdings"
caption 430,chr$(239)
inactive 430
on_click 430,passe
button 440 : rem Bouton Année suivante
left 440,left(320)
top 440,top(320)
width 440,width(320)
height 440,height(320)
font_bold 440
font_size 440,20
font_name 440,"Wingdings"
caption 440,chr$(240)
inactive 440
on_click 440,passe
rem Fenêtre publicitaire d`attente 2
hide 10
form 450
full_space 450
caption 450," Espace publicitaire"
alpha 451 : rem Carte de crédit
parent 451,450
left 451,200
top 451,50
font_size 451,99
font_color 451,255,0,0
font_name 451,"Webdings"
caption 451,chr$(147)
alpha 452 : rem Calculatrice
parent 452,450
left 452,450
top 452,80
font_size 452,199
font_color 452,100,100,100
font_name 452,"Webdings"
caption 452,chr$(203)
alpha 453 : rem Pendule
parent 453,450
left 453,850
top 453,60
font_size 453,150
font_color 453,0,155,0
font_name 453,"Wingdings"
caption 453,chr$(192)
alpha 454 : rem Texte 1
parent 454,450
left 454,150
top 454,350
font_size 454,49
font_color 454,0,0,255
caption 454,"PERPÉTUORAMIC"
alpha 455 : rem Texte 2
parent 455,450
left 455,150
top 455,450
font_size 455,20
font_color 455,0,0,255
i$="Un programme qui vous permet aussi de visualiser"+chr$(13)
i$=i$+"tous les éléments importants de l'année"+chr$(13)
i$=i$+"avec les couleurs de votre choix..."
caption 455,i$
alpha 456 : rem Dessin Noter
parent 456,450
left 456,800
top 456,500
font_size 456,99
font_color 456,255,0,255
font_name 456,"Wingdings"
caption 456,chr$(63)
progress_bar 457 : rem Barre de progression de l`installation
parent 457,450
left 457,50
width 457,mx%-100
height 457,35
min 457,0
max 457,100
container 500 : rem Fenêtre des commandes
left 500,left(129)
top 500,-510
width 500,780
height 500,420
caption 500,"Commandes du logiciel"
rem Affichage des boutons de commande de la plateforme ------------------------
for i%=1 to 8
j%=150
if i%=1 or i%=5
j%=0
end_if
button i%*10+500 : rem Obj-syst n° 510 à 580 à pas de 10
parent i%*10+500,500
left i%*10+500,(i%-1)*150+20+j%-int((i%-1)/4)*600
top i%*10+500,int((i%-1)/4)*85+25
width i%*10+500,140
height i%*10+500,75
font_bold i%*10+500
font_size i%*10+500,18
font_name i%*10+500,"Arial"
caption i%*10+500,tb$(i%)
on_click i%*10+500,go
position 457,i%*2
next i%
font_name 520,"Wingdings"
font_name 560,"Wingdings"
font_size 520,50
font_size 560,50
rem Affichage des autres données de commande
panel 590 : rem Lieu où va s`afficher l`année concernée
parent 590,500
left 590,170
top 590,25
width 590,140
height 590,75
font_bold 590
font_size 590,40
font_name 590,"Arial"
caption 590,an$
color 590,255,200,255
container 600 : rem Support de la zone de texte pour années lointaines
parent 600,500
left 600,165
top 600,105
width 600,150
height 600,80
caption 600,"Autre année"
position 457,18
edit 610 : rem Zone de texte où insérer les années lointaines
parent 610,600
left 610,5
top 610,15
width 610,140
font_size 610,32
font_bold 610
font_name 610,"Arial"
on_change 610,change
on_key_down 610,key
container 620 : rem Fenêtre des paramètres d`écriture -------------------------
parent 620,500
left 620,5
top 620,205
width 620,770
height 620,200
caption 620,"Paramètres d'écriture"
position 457,20
rem Affichage des données d`écriture
alpha 630 : rem Indication que c`est le jour qu`il faut inscrire là
parent 630,620
left 630,15
top 630,18
font_bold 630
font_size 630,12
caption 630,"Jour"
combo 640 : rem Zone où insérer le jour où ajouter une note
parent 640,620
left 640,10
top 640,38
width 640,45
font_bold 640
font_size 640,12
for i%=1 to 31
item_add 640,i%
next i%
on_click 640,clic
on_change 640,change
on_key_down 640,key
position 457,22
alpha 650 : rem Indication que c`est le mois qu`il faut inscrire là
parent 650,620
left 650,72
top 650,18
font_bold 650
font_size 650,12
caption 650,"Mois"
combo 660 : rem Zone où insérer le mois où ajouter une note
parent 660,620
left 660,70
top 660,38
width 660,45
font_bold 660
font_size 660,12
for i%=1 to 12
item_add 660,i%
next i%
on_click 660,clic
on_change 660,change
on_key_down 660,key
position 457,24
alpha 665 : rem Affichage de l`année concernée par l`écriture
parent 665,620
left 665,49
top 665,65
alpha 670 : rem Indication qu`il s`agit de la zone de Note brève
parent 670,620
left 670,18
top 670,85
font_bold 670
font_size 670,12
caption 670,"Note brève"
position 457,26
edit 680 : rem Zone où écrire la Note brève
parent 680,620
left 680,10
top 680,105
width 680,105
font_size 680,12
font_name 680,"Arial"
on_click 680,divers
on_key_down 680,key
alpha 690 : rem Indication qu`il s`agit de la zone de Texte détaillé
parent 690,620
left 690,130
top 690,15
font_bold 690
font_size 690,12
caption 690,"Texte détaillé"
position 457,28
memo 700 : rem Zone où écrire le Texte détaillé
parent 700,620
left 700,130
top 700,35
width 700,250
height 700,98
font_size 700,10
font_name 700,"Arial"
bar_vertical 700
on_click 700,divers
alpha 710 : rem Indication de la zone où choisir la couleur de police
parent 710,620
left 710,410
top 710,15
font_bold 710
font_size 710,12
caption 710,"Couleur de police"
position 457,30
for i%=1 to 8 : rem Différentes couleurs disponibles pour la police
panel i%+710 : rem Obj-syst n° 711 à 718 à pas de 1
parent i%+710,620
left i%+710,(i%-1)*43+395-int((i%-1)/4)*172
top i%+710,int((i%-1)/4)*48+35
width i%+710,43
height i%+710,48
color i%+710,cc1$(i%),cc2$(i%),cc3$(i%)
on_click i%+710,coul
position 457,i%+30
next i%
alpha 720 : rem Indication de la zone où choisir la couleur de fond
parent 720,620
left 720,600
top 720,15
font_bold 720
font_size 720,12
caption 720,"Couleur de fond"
for i%=1 to 8 : rem Différentes couleurs disponibles pour le fond
panel i%+720 : rem Obj-syst n° 721 à 728 à pas de 1
parent i%+720,620
left i%+720,(i%-1)*43+580-int((i%-1)/4)*172
top i%+720,int((i%-1)/4)*48+35
width i%+720,43
height i%+720,48
color i%+720,cf1$(i%),cf2$(i%),cf3$(i%)
on_click i%+720,coul
position 457,i%+38
next i%
alpha 730 : rem Indication qu`il s`agit de la zone où choisir le style
parent 730,620
left 730,35
top 730,140
font_bold 730
font_size 730,12
caption 730,"Style"
combo 740 : rem Zone où choisir le style de la Note brève
parent 740,620
left 740,10
top 740,160
width 740,105
font_bold 740
font_size 740,12
item_add 740,"Normal"
item_add 740,"Gras"
item_add 740,"Souligné"
item_add 740,"Italique"
item_add 740,"Barré"
on_click 740,clic
position 457,48
alpha 750 : rem Indication qu`il s`agit de la zone où choisir les symboles
parent 750,620
left 750,170
top 750,140
font_bold 750
font_size 750,12
caption 750,"Symboles"
combo 760 : rem Zone où choisir les symboles utiles pour la Note brève
parent 760,620
left 760,130
top 760,160
width 760,170
font_bold 760
font_size 760,12
item_add 760,"@ = Anniversaire"
item_add 760,"
= Rendez-Vous"
item_add 760,"
= Important/Autre"
on_click 760,clic
position 457,50
alpha 770 : rem Indication de la zone où choisir les Caractères spéciaux
parent 770,620
left 770,311
top 770,130
font_size 770,12
font_name 770,"Arial Narrow"
caption 770,"Carac Spéc"
combo 780 : rem Zone où choisir les Caractères spéciaux
parent 780,620
left 780,315
top 780,150
width 780,65
font_bold 780
font_size 780,24
font_name 780,"Arial"
for i%=1 to 26
item_add 780,cs$(i%)
next i%
on_click 780,clic
position 457,52
check 790 : rem Zone où choisir si c`est une note multi-annuelle ou unique
parent 790,620
left 790,258
top 790,10
width 790,120
font_bold 790
font_size 790,12
caption 790,"Tous les ans"
for i%=1 to 4 : rem Boutons de commande d`écriture
panel i%+790 : rem Obj-syst n° 791 à 794 à pas de 1
parent i%+790,620
left i%+790,395+(i%-1)*90
top i%+790,140
width i%+790,85
height i%+790,50
font_bold i%+790
font_size i%+790,12
caption i%+790,be$(i%)
on_click i%+790,choix
position 457,i%+54
next i%
alpha 800 : rem Flèche vers le bas
parent 800,500
left 800,525
top 800,180
font_bold 800
font_size 800,20
font_name 800,"Wingdings"
caption 800,chr$(242)
button 810 : rem Bouton de rappel
left 810,left(384)
top 810,top(384)
width 810,width(384)
height 810,height(384)
font_bold 810
caption 810,"Rappel"
inactive 810
on_click 810,clic
position 457,60
timer 820 : rem Pour faire fonctionner la pendule
timer_interval 820,15000
on_timer 820,montre
for i%=2 to 32 : rem Affichage des données du mois
panel i%+898 : rem Obj-syst n° 900 à 930 à pas de 1 (annotations)
hide i%+898
left i%+898,(mx%-24)/12+1
top i%+898,(i%-1)*(my%-90)/32
width i%+898,((mx%-24)/12)*11-2
height i%+898,(my%-90)/32
font_name i%+898,"Arial"
position 457,i%+64
next i%
rem Affichage du calendrier de l`année en cours
position 457,100
calcul()
for i%=1 to 12
active i%*32+1
next i%
active 420
active 430
active 440
active 810
hide 450
beep
end : rem ' Début des routines ==============================================
change: : rem Effets d`un on-change
j%=number_change
select j%
case 610 : change()
case 640 : voir()
case 660 : voir()
end_select
return
choix: : rem Effets des boutons de commande d`écriture
select number_click-790
case 1 : copier()
case 2 : coller()
case 3 : vider()
case 4 : detruire()
end_select
return
clic: : rem Effets des diverses autres commandes on-click
select number_click/10
case 42 : clic()
case 64 : voir()
case 66 : voir()
case 74 : style()
case 76 : symb()
case 78 : carac()
case 81 : rappel()
end_select
if number_click=224
quitter()
end_if
return
coul: : rem Couleur des caractères et du fond de la note brève
if number_click<720
coul()
else
fond()
end_if
return
divers: : rem Effets de diverses commandes
if number_click<600
mois()
else
quel()
end_if
return
go: : rem Effets des boutons de commande principaux
select (number_click/10)-50
case 1 : apropos()
case 2 : annee()
case 3 : sortir()
case 4 : copier_image()
case 5 : aide()
case 6 : annee()
case 7 : ecrire()
case 8 : quitter()
end_select
return
key: : rem Défilement entre les zones d`écriture avec la touche ENTER
if key_down_code=13
j%=number_key_down
j%=j%+20
if j%>700 or j%<640
j%=640
end_if
if object_type(j%)>2 and object_type(j%)<6
set_focus j%
end_if
end_if
return
montre: : rem Fait fonctionner la pendule
hg$=left$(time$,2)+" h "+mid$(time$,4,2)
caption 224,hg$
hm$=right$(hg$,2)
if hm$="15" or hm$="30" or hm$="45" or hm$="00"
if val(right$(time$,2))<15
beep
end_if
if hm$="00"
beep
end_if
color 224,255,255,0
pause 50
color 224,0,0,255
end_if
return
passe: : rem Passe à l`année suivante ou précédente
i$=right$(caption$(0),4)
if numeric(i$)=1
inactive 430
inactive 440
j%=val(i$)
if number_click=440
j%=j%+1
else
j%=j%-1
end_if
an$=str$(j%)
calcul()
active 430
active 440
end_if
return
rem ' Sub routines -----------------------------------------------------------
sub aide() : rem Explications du programme
dim_local a$ , i$
timer_off 820
i$=chr$(13)
application_title "Comment fonctionne le programme"
a$=a$+"UTILITÉ DU PROGRAMME :"+i$
a$=a$+" Perpétuoramic est un calendrier perpétuel servant à consulter "
a$=a$+"la structure de n'importe quelle année du passé ou de l'avenir."+i$
a$=a$+"Mais c'est aussi un gestionnaire mensuel d'anniversaires, de Rendez-"
a$=a$+"Vous et autres événements."+i$
a$=a$+"(Précisons que l'utilisation de ce calendrier nécessite cependant"
a$=a$+"qu'il n'y ait pas trop de ces événements, quoique...)"+i$
a$=a$+" Ce calendrier n'est perpétuel que dans la limite du calendrier "
a$=a$+"dit « grégorien » qui a commencé en fin 1582 et devrait être"+i$
a$=a$+"logiquement remplacé par un autre en 4582 pour cause de décalage "
a$=a$+"d'une journée. Il ne fonctionne donc que de 1583 à 4581."+i$+i$
a$=a$+"DÉTAIL DES COULEURS :"+i$
a$=a$+"× le jour actuel est indiqué en bleu (couleur prioritaire)"+i$
a$=a$+"× les jours fériés sont en vert (couleur prioritaire en second)"+i$
a$=a$+"× les dimanches sont colorés en jaune"+i$
a$=a$+"× les autres jours sont colorés en rose"+i$
a$=a$+"× le bleu foncé est la pendule "
a$=a$+"(qui sonne et clignote tous les ¼ d'heure)"+i$
a$=a$+"× les jours que vous annoterez pourront l'être "
a$=a$+"dans la couleur que vous choisirez "
a$=a$+"(qui sera prioritaire sur toutes)"+i$+i$
a$=a$+"DÉTAIL DES TOUCHES UTILISABLES :"+i$
a$=a$+"× <-- : pour afficher le calendrier de l'année précédente"+i$
a$=a$+"× --> : pour afficher le calendrier de l'année suivante"+i$
a$=a$+"× Rappel : pour rappeler que les touches violettes ont une "
a$=a$+"utilité bien spécifique"+i$
a$=a$+"× Touches violettes : pour consulter les annotations mensuelles"+i$
a$=a$+"× CLIC : permet d'accéder à la plateforme de commande et d'écriture"+i$
a$=a$+"× Sortir : pour faire disparaître la plateforme de commande et d'écriture"+i$
a$=a$+"× Copy Cal : pour faire une copie d'écran du calendrier et l'enregistrer"
a$=a$+"afin de l'utiliser ensuite avec un logiciel adapté)"+i$
a$=a$+"× Ecrire : pour écrire dans le calendrier et enregistrer en "
a$=a$+"mémoire les données entrées dans les zones de texte situées en dessous"+i$
a$=a$+" - la Note brève sera écrite dans le calendrier"+i$
a$=a$+" - le Texte détaillé sera consultable dans le tableau mensuel des annotations"+i$
a$=a$+" - le Style, les Symboles et les Couleurs ne concernent que la Note brève"+i$
a$=a$+" - les Caractères Spéciaux peuvent s'afficher dans la Note brève"
a$=a$+" ou le Texte détaillé selon l'emplacement préalable du curseur"+i$
a$=a$+" - NOTA : on peut utiliser le bouton Ecrire pour modifier une note"
a$=a$+" déjà inscrite et enregistrée"+i$
a$=a$+"× Vider : 2 cas de figure :"+i$
a$=a$+" - du texte quelconque se trouve dans la Note brève et/ou le "
a$=a$+"Texte détaillé, le programme vide alors les zones d'écriture"+i$
a$=a$+" - les zones de Note brève et de Texte détaillé sont vides, tandis que"
a$=a$+" des dates sont inclues dans les zones de Jour et de Mois,"+i$
a$=a$+" alors la Note brève de cette date sera effacée du calendrier, "
a$=a$+"mais l'enregistrement sera conservé"+i$
a$=a$+"× Détruire : En affichant la date d'une annotation enregistrée, on peut"
a$=a$+" l'effacer du calendrier et détruire le fichier enregistré."
message a$
timer_on 820
end_sub
sub annee() : rem Noter l`année suivante ou précédente
dim_local a%
a%=val(caption$(590))
if number_click=520
a%=a%+1
else
a%=a%-1
end_if
if numeric(text$(610))=1 and text$(610)=caption$(590)
text 610,str$(a%)
end_if
caption 590,a%
end_sub
sub apropos() : rem Explications liées à la construction du programme
dim_local a$ , i$
timer_off 820
i$=chr$(13)
application_title "Version du programme"
a$=a$+" PERPÉTUORAMIC fait suite au programme de calendrier perpétuel"+i$
a$=a$+"réalisé en décembre 2009 avec un objectif plus rudimentaire."+i$+i$
a$=a$+" Made in France, sa version actuelle est : Cal011209.3.5"+i$
a$=a$+"La dernière modification effectuée date du 10 juillet 2017"+i$
a$=a$+" Ce programme a été fabriqué par jjn4 qu'on peut trouver sur :"+i$
a$=a$+"---> http://panoramic.1fr1.net/"+i$
a$=a$+"---> http://jjn4.e-monsite.com/ (la ludothèque de jjn4)"
message a$
timer_on 820
end_sub
sub calcul() : rem Routine de calcul et d`affichage des dates de chaque jour
dim_local t$ , tt% , g% , w% , d% , e% , h% , k% , u% , q% , v% , z% , n%
dim_local f% , r% , j1% , m1% , y% , j3% , m3% , x% , j2% , m2% , c% , a%
dim_local j% , m% , t% , p% , b% , s% , vp% , e$ , o$ , np$ , v2$ , v3$
np$=" CALENDRIER GRÉGORIEN PERPÉTUEL "
t$=an$ : caption 94,""
if t$<>"" and numeric(t$)=1
tt%=int(val(t$))
if tt%<1583 or tt%>4581
beep
timer_off 820
message "Non, pas possible, seulement de 1583 à 4581"
timer_on 820
exit_sub
end_if
rem ' Calcul du lundi de Pâques - Algorithme de Oudin
g%=tt%-int(tt%/19)*19
w%=int(tt%/100)
d%=int(w%/4)
e%=int((8*w%+13)/25)
h%=19*g%+w%-d%-e%+15-int((19*g%+w%-d%-e%+15)/30)*30
k%=int(h%/28)
u%=int(29/(h%+1))
q%=int((21-g%)/11)
v%=(k%*u%*q%-1)*k%+h%
z%=int(tt%/4)+tt%
n%=z%+v%+2+d%-w%
f%=n%-int(n%/7)*7
r%=28+v%-f%
if h%=29 and r%=50
r%=57
end_if
if h%=28 and g%>10 and r%=49
r%=56
end_if
if r%>30
j1%=r%-30
m1%=4
else
j1%=r%+1
m1%=3
end_if
rem ' Calcul du jeudi de l'Ascension
y%=r%+39
if y%>92
j3%=y%-92
m3%=6
else
j3%=y%-61
m3%=5
end_if
rem ' Calcul du lundi de Pentecôte
x%=r%+50
if x%>92
j2%=x%-92
m2%=6
else
j2%=x%-61
m2%=5
end_if
rem ' Calcul du jour de la semaine et affichage
c%=val(left$(t$,2))
a%=val(right$(t$,2))
for m%=1 to 12
for j%=1 to 31
select m%
case 1 : t%=0
case 2 : t%=3
case 3 : t%=3
case 4 : t%=6
case 5 : t%=1
case 6 : t%=4
case 7 : t%=6
case 8 : t%=2
case 9 : t%=5
case 10 : t%=0
case 11 : t%=3
case 12 : t%=5
end_select
if a%=0 and m%<3
p%=(20-c%)*2+int((c%-1)/4)-5
else
p%=(19-c%)*2+int(c%/4)-4
end_if
b%=int(a%/4)
if a%/4=int(a%/4) and m%<3
b%=b%-1
end_if
s%=(j%+t%+a%+b%+p%)-7*int((j%+t%+a%+b%+p%)/7)
s%=s%-int(s%/7)*7
vp%=0
if j%=31 and (m%=2 or m%=4 or m%=6 or m%=9 or m%=11)
vp%=1
end_if
if (m%=2 and j%>29) or (m%=2 and a%/4<>int(a%/4) and j%>28)
vp%=1
end_if
if a%=0 and c%/4<>int(c%/4) and m%=2 and j%=29
vp%=1
end_if
if vp%=0
e$=""
if j%=1 and m%=5 and tt%>1946
e$="F/Trav"
end_if
if j%=8 and m%=5 and tt%>1952 and tt%<1960
e$="Vic/45"
end_if
if j%=8 and m%=5 and tt%>1981
e$="Vic/45"
end_if
if j%=14 and m%=7 and tt%>1879
e$="Révol"
end_if
if (j%=15 and m%=8)
e$="Assom"
end_if
if (j%=1 and m%=11)
e$="Touss"
end_if
if j%=11 and m%=11 and tt%>1921
e$="Armist"
end_if
if (j%=25 and m%=12)
e$="Noël"
end_if
if (j%=1 and m%=1)
e$="Jo/an"
end_if
if (j%=j1% and m%=m1%)
e$="L/Pâq"
end_if
if (j%=j2% and m%=m2%)
e$="L/Pent"
end_if
if (j%=j3% and m%=m3%)
e$="Ascen"
end_if
o$=""
if j%<10
o$="0"
end_if
v3$=""
if e$<>""
if int(width(33)/6)-7-len(e$)>0
v3$=string$(int(width(33)/6)-7-len(e$)," ")
end_if
v2$=" - "+e$+chr$(141)+v3$
else
if int(width(33)/6)>0
v3$=string$(int(width(33)/6)," ")
end_if
v2$=chr$(141)+v3$
end_if
font_color m%*32+j%+1,0,0,0
color m%*32+j%+1,255,200,255
caption m%*32+j%+1,jo$(s%)+" "+o$+str$(j%)+v2$
color m%*32+j%+1,255,200,255
if jo$(s%)="Dim"
color m%*32+j%+1,255,255,0
end_if
if e$<>""
color m%*32+j%+1,0,255,0
end_if
if jo%=j% and mo%=m% and an%=tt%
color m%*32+j%+1,0,200,255
end_if
font_bold_off m%*32+j%+1
font_underline_off m%*32+j%+1
font_italic_off m%*32+j%+1
font_strike_off m%*32+j%+1
end_if
next j%
caption m%*32+1,mo$(m%)+string$(int(mx%/400-1)," ")+an$
caption 0,np$+t$
next m%
if a%/4=int(a%/4)
m%=1
else
m%=0
end_if
if a%=0
if ((c%/4)<>int(c%/4))
m%=0
end_if
end_if
if m%=1
show 94
top 420,top(95)
height 420,height(95)*2+2
else
hide 94
top 420,top(94)
height 420,height(94)*3+2
end_if
noter()
end_if
end_sub
sub carac() : rem Affiche un Caractère spécial dans l`édit ou le mémo
dim_local a$
if oc%=680
a$=text$(780)
milieu(a$)
set_focus oc%
caret_position oc%,len(text$(oc%))
else
text 700,text$(700)+text$(780)
set_focus 700
caret_position 700,len(text$(700))
end_if
end_sub
sub change() : rem Effet d`un changement dans l`édit 610
i$=text$(610)
if len(i$)=4 and numeric(i$)=1
caption 590,i$
end_if
end_sub
sub clic() : rem Effet du bouton CLIC (affichage de la zone de commande)
for i%=-510 to 0 step 4
top 500,i%
display
next i%
for i%=33 to 385 step 32
inactive i%
next i%
for i%=420 to 440 step 10
inactive i%
next i%
inactive 810
caption 590,right$(caption$(0),4)
caption 665,right$(caption$(0),4)
text 610,""
set_focus 610
end_sub
sub coller() : rem Coller dans l`édit ou le mémo
dim_local a$
if oc%=680
a$=clipboard_string_paste$
milieu(a$)
set_focus oc%
caret_position oc%,len(text$(oc%))
else
text 700,text$(700)+clipboard_string_paste$
set_focus 700
caret_position 700,len(text$(700))
end_if
simule()
end_sub
sub copier() : rem Copier du texte à partir de l`édit, du mémo et des combos
j%=0
for i%=640 to 780 step 20
if i%<>720
if select_read$(i%)<>""
j%=i%
exit_for
end_if
end_if
next i%
if j%>0
clipboard_string_copy select_read$(j%)
else
clipboard_string_copy ""
end_if
simule()
end_sub
sub copier_image() : rem Copie le tableau pour imprimer ailleurs
hide 500
display
2d_image_copy 20,0,0,mx%-20,my%-85
clipboard_copy 20
file_save 20,"Copie.bmp"
file_open_write 1,"Date-copie.txt"
file_writeln 1,date$
file_close 1
beep
show 500
end_sub
sub coul() : rem Couleur des caractères de la note brève
cc%=number_click-710
font_color 680,cc1$(cc%),cc2$(cc%),cc3$(cc%)
focus()
end_sub
sub detruire() : rem Détruire un fichier calendrier enregistré sur le disque dur
dim_local j$ , m$
j$=text$(640) : m$=text$(660)
if j$<>"" and m$<>"" and numeric(j$)=1 and numeric(m$)=1
if int(val(j$))>0 and int(val(j$))<32
if int(val(m$))>0 and int(val(m$))<13
if len(j$)<2
j$="0"+j$
end_if
if len(m$)<2
m$="0"+m$
end_if
if file_exists("Cal-&"+right$(caption$(0),4)+m$+j$+".txt")=1
file_delete "Cal-&"+right$(caption$(0),4)+m$+j$+".txt"
end_if
if file_exists("Cal-@"+m$+j$+".txt")=1
file_delete "Cal-@"+m$+j$+".txt"
end_if
cc%=8 : cf%=8
efface()
vide()
end_if
end_if
end_if
simule()
end_sub
sub ecrire() : rem Reporter la note dans le tableau et l`enregistrer
dim_local j$ , m$ , j% , m% , t% , h$ , k%
j$=text$(640) : m$=text$(660)
if numeric(j$)=1 and numeric(m$)=1
j%=val(j$) : m%=val(m$)
if j%=int(j%) and m%=int(m%)
if j%>0 and j%<32 and m%>0 and m%<13
t%=m%*32+j%+1
if checked(790)=1
h$=chr$(144)
else
h$=chr$(143)
end_if
if instr(caption$(t%),chr$(144))>0 or instr(caption$(t%),chr$(143))>0
k%=instr(caption$(t%),chr$(141))
caption t%,left$(caption$(t%),k%)
end_if
caption t%,trim$(caption$(t%))+" "+text$(680)+h$
if cc%=0
cc%=8
end_if
font_color t%,cc1$(cc%),cc2$(cc%),cc3$(cc%)
if cf%=0
cf%=8
end_if
color t%,cf1$(cf%),cf2$(cf%),cf3$(cf%)
font_bold_off t%
font_underline_off t%
font_italic_off t%
font_strike_off t%
select sr%
case 2 : font_bold t%
case 3 : font_underline t%
case 4 : font_italic t%
case 5 : font_strike t%
end_select
enreg()
end_if
end_if
end_if
end_sub
sub efface() : rem Annuler une note dans le calendrier
dim_local j$ , m$ , j% , m% , t% , n% , v$
j$=text$(640) : m$=text$(660)
if numeric(j$)=1 and numeric(m$)=1
j%=val(j$) : m%=val(m$)
if j%=int(j%) and m%=int(m%)
if j%>0 and j%<32 and m%>0 and m%<13
t%=m%*32+j%+1
n%=instr(caption$(t%),chr$(141))
v$=string$((int(width(33)/4)-n%)," ")
caption t%,trim$(left$(caption$(t%),n%))+v$
if cc%=0
cc%=8
end_if
font_color t%,cc1$(cc%),cc2$(cc%),cc3$(cc%)
if cf%=0
cf%=8
end_if
color t%,cf1$(cf%),cf2$(cf%),cf3$(cf%)
sr%=1
font_bold_off t%
font_underline_off t%
font_italic_off t%
font_strike_off t%
end_if
end_if
end_if
end_sub
sub enreg() : rem Enregistrer la note spécifique d`une journée du calendrier
dim_local j$ , m$ , j% , m% , e$ , h$
j$=text$(640) : m$=text$(660)
if j$<>"" and m$<>"" and numeric(j$)=1 and numeric(m$)=1
j%=val(j$) : m%=val(m$)
if j%=int(j%) and m%=int(m%) and j%>0 and j%<32 and m%>0 and m%<13
if len(j$)<2
j$="0"+j$
end_if
if len(m$)<2
m$="0"+m$
end_if
if cc%=0
cc%=8
end_if
if cf%=0
cf%=8
end_if
if sr%=0
sr%=1
end_if
e$=cc1$(cc%)+cc2$(cc%)+cc3$(cc%)+cf1$(cf%)+cf2$(cf%)+cf3$(cf%)+str$(sr%)
if checked(790)=0
h$=chr$(143)
file_open_write 1,"Cal-&"+caption$(665)+m$+j$+".txt"
file_writeln 1,e$
file_writeln 1,text$(680)+h$
if count(700)>0
for i%=1 to count(700)
file_writeln 1,item_read$(700,i%)
next i%
end_if
file_close 1
else
h$=chr$(144)
file_open_write 1,"Cal-@"+m$+j$+".txt"
file_writeln 1,e$
file_writeln 1,text$(680)+h$
if count(700)>0
for i%=1 to count(700)
file_writeln 1,item_read$(700,i%)
next i%
end_if
file_close 1
end_if
end_if
end_if
end_sub
sub focus() : rem Place le curseur à la fin de l`édit 680
set_focus 680
caret_position 680,len(text$(680))
end_sub
sub fond() : rem Couleur du Fond de la note brève
cf%=number_click-720
color 680,cf1$(cf%),cf2$(cf%),cf3$(cf%)
focus()
end_sub
sub milieu(a$) : rem Placer l`élément à ajouter au milieu de la zone de texte
dim_local d$ , f$
d$=left$(text$(680),caret_position(680))
f$=right_pos$(text$(680),caret_position(680)+1)
text 680,d$+a$+f$
end_sub
sub mois() : rem Affichage des annotations mensuelles
dim_local j$ , m$ , l$ , t$ , r$
if (number_click-1)/32=int((number_click-1)/32)
if show(900)=0
color number_click,240,240,240
for i%=1 to 31
if i%<>31 or int((number_click-1)/32)<>6
left number_click+i%,0
end_if
caption i%+899,""
if i%>28 and int((number_click-1)/32)<>1
hide i%+33
end_if
show i%+899
next i%
for i%=33 to 385 step 32
if i%<>number_click
inactive i%
font_color i%,255,100,255
end_if
next i%
hide 420
for i%=1 to 31
t$=""
if instr(caption$(number_click+i%),chr$(143))>0
j$=str$(i%)
if len(j$)<2
j$="0"+j$
end_if
m$=str$((number_click-1)/32)
if len(m$)<2
m$="0"+m$
end_if
if file_exists("Cal-&"+right$(caption$(0),4)+m$+j$+".txt")=1
file_open_read 1,"Cal-&"+right$(caption$(0),4)+m$+j$+".txt"
file_readln 1,l$
file_readln 1,l$
while file_eof(1)<>1
file_readln 1,l$
t$=t$+" "+l$
end_while
file_close 1
end_if
r$=string$(int(((mx%-width(33))/4))-len(t$)," ")
caption i%+899,t$+r$
end_if
if instr(caption$(number_click+i%),chr$(144))>0
j$=str$(i%)
if len(j$)<2
j$="0"+j$
end_if
m$=str$((number_click-1)/32)
if len(m$)<2
m$="0"+m$
end_if
if file_exists("Cal-@"+m$+j$+".txt")=1
file_open_read 1,"Cal-@"+m$+j$+".txt"
file_readln 1,l$
file_readln 1,l$
while file_eof(1)<>1
file_readln 1,l$
t$=t$+" "+l$
end_while
file_close 1
end_if
r$=string$(int(((mx%-width(33))/4))-len(t$)," ")
caption i%+899,t$+r$
end_if
next i%
else
color number_click,255,0,255
for i%=1 to 31
left number_click+i%,left(number_click)
hide i%+899
next i%
for i%=33 to 385 step 32
active i%
font_color i%,0,0,0
next i%
show 420
for i%=62 to 64
show i%
next i%
end_if
end_if
end_sub
sub noter() : rem Noter les RV et anniversaires sur le calendrier
dim_local a$ , d$ , j% , k% , m% , t% , c$ , n$ , s%
dim_local c1% , c2% , c3% , c4% , c5% , c6%
a$=file_find_first$
while a$<>"_"
k%=0
if left$(a$,5)="Cal-&"
if mid$(a$,6,4)=right$(caption$(0),4)
k%=1
d$=mid$(a$,10,4)
end_if
end_if
if left$(a$,5)="Cal-@"
k%=1
d$=mid$(a$,6,4)
end_if
if k%=1
j%=val(right$(d$,2))
m%=val(left$(d$,2))
t%=m%*32+j%+1
file_open_read 1,a$
file_readln 1,c$
file_readln 1,n$
file_close 1
c1%=val(left$(c$,3)) : c2%=val(mid$(c$,4,3)) : c3%=val(mid$(c$,7,3))
c4%=val(mid$(c$,10,3)) : c5%=val(mid$(c$,13,3)) : c6%=val(mid$(c$,16,3))
s%=val(right$(c$,1))
caption t%,trim$(caption$(t%))+" "+n$
font_color t%,c1%,c2%,c3%
color t%,c4%,c5%,c6%
select s%
case 2 : font_bold t%
case 3 : font_underline t%
case 4 : font_italic t%
case 5 : font_strike t%
end_select
end_if
a$=file_find_next$
end_while
end_sub
sub quel() : rem Détermination du dernier cliqué parmi édit 680 et mémo 700
oc%=number_click
end_sub
sub quitter() : rem Arrêter le logiciel
terminate
end_sub
sub rappel() : rem Mettre l`accent sur l`utilisation des cases violettes
dim_local t%
for i%=1 to 12
t%=i%*32+1
color t%,255,255,255
pause 50
color t%,255,0,255
next i%
end_sub
sub simule() : rem Simule l`effet d`un bouton au niveau des panels
font_bold_off number_click
pause 100
font_bold number_click
end_sub
sub sortir() : rem Efface la zone de commande
for i%=0 to -510 step -4
top 500,i%
display
next i%
dim_local a$
a$=caption$(590)
if a$<>an$
an$=a$
calcul()
end_if
for i%=33 to 385 step 32
active i%
next i%
for i%=420 to 440 step 10
active i%
next i%
active 810
end_sub
sub style() : rem Affecte un certain style à la note brève
if item_index(740)>0
select item_index(740)
case 1 : style_off()
case 2 : style_off() : font_bold 680
case 3 : style_off() : font_underline 680
case 4 : style_off() : font_italic 680
case 5 : style_off() : font_strike 680
end_select
sr%=item_index(740)
focus()
end_if
end_sub
sub style_off() : rem Supprime le style des caractères de l`édit 680
font_bold_off 680
font_underline_off 680
font_italic_off 680
font_strike_off 680
end_sub
sub symb() : rem Symbole choisi pour la note brève
dim_local a$
if item_index(760)>0
select item_index(760)
case 1 : a$="@" : milieu(a$)
case 2 : a$="
" : milieu(a$)
case 3 : a$="
" : milieu(a$)
end_select
focus()
end_if
end_sub
sub vide() : rem Vide les zones de texte de la plateforme d`écriture
text 640,""
text 660,""
clear 700
mark_off 790
text 680,""
font_color 680,0,0,0
cc%=8
color 680,255,255,255
cf%=8
style_off()
sr%=1
text 740,""
text 760,""
text 780,""
end_sub
sub vider() : rem Vider l`édit, le mémo et les combos ou le jour du calendrier
if text$(680)="" and text$(700)="" and text$(640)<>"" and text$(660)<>""
efface()
beep
else
vide()
end_if
simule()
end_sub
sub voir() : rem Voir si à cette date il n`y a pas déjà une note enregistrée
dim_local j$ , m$ , j% , m% , t% , a$ , c$ , n$ , t$ , c1% , c2% , c3%
if text$(640)<>"" and text$(660)<>""
j$=text$(640) : m$=text$(660)
if numeric(j$)=1 and numeric(m$)=1
j%=val(j$) : m%=val(m$)
if j%=int(j%) and m%=int(m%)
if j%>0 and j%<31 and m%>0 and m%<13
t%=m%*32+j%+1
clear 700
text 680,""
font_color 680,0,0,0
color 680,255,255,255
cc%=8
cf%=8
sr%=1
style_off()
text 740,""
text 760,""
text 780,""
if instr(caption$(t%),chr$(143))>0 or instr(caption$(t%),chr$(144))>0
if len(j$)<2
j$="0"+j$
end_if
if len(m$)<2
m$="0"+m$
end_if
a$=right$(caption$(0),4)
if file_exists("Cal-&"+a$+m$+j$+".txt")=1
file_open_read 1,"Cal-&"+a$+m$+j$+".txt"
file_readln 1,c$
file_readln 1,n$
text 680,n$
while file_eof(1)<>1
file_readln 1,t$
item_add 700,t$
end_while
file_close 1
end_if
if file_exists("Cal-@"+m$+j$+".txt")=1
file_open_read 1,"Cal-@"+m$+j$+".txt"
file_readln 1,c$
file_readln 1,n$
text 680,n$
while file_eof(1)<>1
file_readln 1,t$
item_add 700,t$
end_while
file_close 1
mark_on 790
end_if
sr%=val(right$(c$,1))
c1%=val(left$(c$,3)) : c2%=val(mid$(c$,4,3)) : c3%=val(mid$(c$,7,3))
font_color 680,c1%,c2%,c3%
for i%=1 to 8
if c1%=val(cc1$(i%)) and c2%=val(cc2$(i%)) and c3%=val(cc3$(i%))
cc%=i%
exit_for
end_if
next i%
c1%=val(mid$(c$,10,3)) : c2%=val(mid$(c$,13,3)) : c3%=val(mid$(c$,16,3))
color 680,c1%,c2%,c3%
for i%=1 to 8
if c1%=val(cf1$(i%)) and c2%=val(cf2$(i%)) and c3%=val(cf3$(i%))
cf%=i%
exit_for
end_if
next i%
select sr%
case 2 : font_bold 680
case 3 : font_underline 680
case 4 : font_italic 680
case 5 : font_strike 680
end_select
end_if
end_if
end_if
end_if
end_if
end_sub
Accueil 
Calendrier
