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
» COMPILATEUR V 0.9 beta 7 du 10 aout 2017
par Yannick Aujourd'hui à 1:58

» Pb 17 (en analyse): ITEM_SELECT ne fonctionne pas
par Jack Hier à 19:26

» Compilateur FBPano
par Mike Hier à 13:52

» un nouveau editeur panobasic
par Jean Claude Hier à 10:18

» Le compilateur.
par Pedro Alvarez Hier à 8:36

» Pb 16 (en analyse): ON_CLOSE plante à l'exécution
par Jack Mer 16 Aoû 2017 - 20:00

» Pb 15 (en analyse): TIMER_ON plante à l'exécution
par Jack Mer 16 Aoû 2017 - 19:58

» KGF_dll - nouvelles versions
par Yannick Dim 13 Aoû 2017 - 17:35

» probleme d'outil
par Yannick Dim 13 Aoû 2017 - 17:32

» Carte de France des régions
par Yannick Sam 12 Aoû 2017 - 21:33

» Pb 14 (en analyse): PRINT_LOCATE plante à l'exécution
par Jack Ven 11 Aoû 2017 - 22:37

» Petit avertissement [Mots réservés]
par papydall Ven 11 Aoû 2017 - 13:45

» Distances sur plan
par JL35 Jeu 10 Aoû 2017 - 21:29

» Tracé : Triangle, Carrée, Dents de scie, Sinusoïde redressée
par papydall Jeu 10 Aoû 2017 - 14:52

» Troncature dans une image
par JL35 Mer 9 Aoû 2017 - 13:45

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Août 2017
LunMarMerJeuVenSamDim
 123456
78910111213
14151617181920
21222324252627
28293031   
CalendrierCalendrier

Partagez | 
 

 Perpétuoramic : l'utilitaire absolument incontournable

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

avatar

Nombre de messages : 1594
Date d'inscription : 13/09/2009

MessageSujet: Perpétuoramic : l'utilitaire absolument incontournable   Ven 22 Avr 2016 - 17:04

Perpétuoramic, qu'est-ce que c'est qu'ce bin's ?
C'est quoi, un nouveau gestionnaire de déplacement spatio-temporel ?
ou un programme spécialement destiné à ceux qui ont pris perpette ?
Mais non, mais non, c'est une reprise du calendrier perpétuel
que j'avais fabriqué il y a quelques années, mais je l'ai modernisé.

A l'époque, le but était de sortir le calendrier de n'importe quelle année sur une feuille,
avec la possibilité d'ajouter sur la feuille des notes à la main, au crayon.
Pffffffff...!!!   Des notions d'un autre siècle !!!
(sûrement le XIX° et peut-être même plus loin encore...)

Maintenant, on prend des notes directement sur ordinateur
au doigt sur un écran tactile !
On n'est pas loin du XXII° siècle, quoi !
(au moins, au moins !  Parce qu'avec ce calendrier,
vous pouvez aller jusqu'au XLVI° siècle,
alors voyez que vous avez le temps de voir venir...!)
Code:
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.free-boards.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
NOTA: Certains grognons feront peut-être remarquer
qu'ils ont le même sur leur smartphone, mais en plus rapide.
Bon, d'accord, mais celui-là, au moins, est en Panoramic pur jus,
avantage très net que vous ne trouverez nulle part ailleurs !
sunny alien sunny Laughing


Dernière édition par jjn4 le Lun 10 Juil 2017 - 15:22, édité 4 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://jjn4.e-monsite.com
jjn4

avatar

Nombre de messages : 1594
Date d'inscription : 13/09/2009

MessageSujet: +++   Ven 22 Avr 2016 - 17:40

Désolé, il y avait encore un bug, c'est corrigé.
affraid alien affraid Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://jjn4.e-monsite.com
Marc37



Nombre de messages : 443
Age : 56
Localisation : TOURS
Date d'inscription : 18/03/2014

MessageSujet: Re: Perpétuoramic : l'utilitaire absolument incontournable   Ven 22 Avr 2016 - 18:28

Merci jjn4 !
Original, joli, bien fait et fonctionnel.

Sur mon écran, la première lettre des jours est tronquée. Ecran préhistorique 1024x768 !
Si j’appuie trop vite sur les boutons "précédant et suivant", le programme plante.
Peut-être faut-il inhiber les boutons 430 et 440 tant que l’affichage n’est pas fini.

Merci encore pour ce source.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
papydall

avatar

Nombre de messages : 5501
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Perpétuoramic : l'utilitaire absolument incontournable   Ven 22 Avr 2016 - 20:14

Ça c’est du vrai Martien, BRAVO !!
Mais le Terrien n’aime trop "  ATENDEZ - Installation du programme en cours..." dans le caption 0
Juste après ligne 74
Code:
caption 0,"  ATENDEZ - Installation du programme en cours..."
Ajouter quelque chose comme :
Code:

hide 0 : form 999 : print_target_is 999 : font_size 999,22
print "    veuillez patienter ..."

Puis, juste avant
Code:

rem Affichage du calendrier de l`année en cours
   calcul()
   beep

end : rem ' Début des routines ==============================================

Ajouter
Code:
show 0

Bon, c'est une idée terre-à-terre à améliorer mars-à-terre ! Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Jean Claude

avatar

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

MessageSujet: Re: Perpétuoramic : l'utilitaire absolument incontournable   Ven 22 Avr 2016 - 20:14

Bravo JJN4 ! cheers

Chez moi l'affichage est OK !

Bougre ! il faut que j'apprenne à m'en servir alien

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

avatar

Nombre de messages : 1594
Date d'inscription : 13/09/2009

MessageSujet: +++   Sam 23 Avr 2016 - 13:15

Merci, merci.
Embarassed alien Embarassed
(quoiqu'un martien vert rosissant, c'est curieux)

@Marc37
C'est corrigé, il est maintenant impossible de tripoter impatiemment
les boutons avant l'installation complète du programme.
J'ai un peu amélioré le décalage de l'affichage,
mais c'est vrai que j'ai essayé, pour voir, avec un vieil ordi en 1024 pixels et XP
et il faut reconnaître qu'avec les écrans trop petits, le programme peut difficilement être adapté.
No alien No

@papydall
Eh, ATTENDEZ ou VEUILLEZ PATIENTER, c'est kif-kif...
Bon, j'aurai aussi pu faire apparaître une barre de progression,
mais bof, c'est joli de voir le programme se construire !
(plutôt que d'attendre sans rien voir en tapotant la table d'impatience)
geek alien geek
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://jjn4.e-monsite.com
Laurent (Minibug)

avatar

Nombre de messages : 2353
Age : 50
Localisation : Vienne (86)
Date d'inscription : 10/02/2012

MessageSujet: Re: Perpétuoramic : l'utilitaire absolument incontournable   Sam 23 Avr 2016 - 14:08

Bravo JJN4 !

Juste un bémol pour le temps de chargement mais bon vu le nombre de Panels a charger, on ne peux pas vraiment faire autrement... Wink
J'ai testé avec des variables entières (%) ou cacher puis afficher les Panels a la fin, il n'y a pas beaucoup de différence !
Après tout comme tu le dis si bien, 'voir le programme se construire' c'est une manière de passer le temps. Laughing

Grace a toi je ne vais peut être plus louper les anniversaires. drunken
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
jjn4

avatar

Nombre de messages : 1594
Date d'inscription : 13/09/2009

MessageSujet: +++   Sam 23 Avr 2016 - 18:03

Finalement, j'ai tenu compte de l'objection de papydall et des autres
et j'ai complètement transformé la période d'installation du programme.
Alors là, maintenant, c'est carrément du grand martien cosmique !!!
Voyez vous-même...
Maintenant, tout le monde va dire : Ah, c'est pas assez long !
(la nouvelle version 3.3 se trouve au début de cette page web à la place de la version initiale)
Like a Star @ heaven Like a Star @ heaven Like a Star @ heaven alien Like a Star @ heaven Like a Star @ heaven Like a Star @ heaven Razz


Dernière édition par jjn4 le Dim 24 Avr 2016 - 17:54, édité 1 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://jjn4.e-monsite.com
Jean Claude

avatar

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

MessageSujet: Re: Perpétuoramic : l'utilitaire absolument incontournable   Sam 23 Avr 2016 - 18:41

AH! Ben voilà! geek c'est réussi: on n'a pas le temps de tout lire scratch
lol!

Sérieusement: avec hide 0 au début de programme et show 0 juste avant end, (j'ai fait l'essai) l'attente est d'environ 1 à 2 secondes, ce n'est pas la mer à boire.

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

avatar

Nombre de messages : 5501
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Perpétuoramic : l'utilitaire absolument incontournable   Sam 23 Avr 2016 - 18:44

Ah, ça !
Voilà ce que vous risquez quand vous prenez au sérieux les remarques de Papydal.
Ça peut rendre jaloux une bonne quinzaine de Pano_Terriens  en plus de Papydall  tous réunis !

NB :
Quitter le programme provoque chez moi : Panoramic a cessé de fonctionner … et toute la musique qui va avec.
J’ai mis ma propre SUB Quitter() et tout devient correct comme un vrai martien tout vert !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Laurent (Minibug)

avatar

Nombre de messages : 2353
Age : 50
Localisation : Vienne (86)
Date d'inscription : 10/02/2012

MessageSujet: Re: Perpétuoramic : l'utilitaire absolument incontournable   Lun 25 Avr 2016 - 0:20

Alors là !!!
Ca c'est une bonne idée ! drunken
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
jjn4

avatar

Nombre de messages : 1594
Date d'inscription : 13/09/2009

MessageSujet: +++   Lun 25 Avr 2016 - 19:27

Jean Claude a écrit:
l'attente est d'environ 1 à 2 secondes, ce n'est pas la mer à boire.
Alors j'ai voulu tester en chronométrant à partir de différents ordinateurs persos ou d'amis...

Voici ce que ça donne :
Ordinateur -------- Puissance --------  Perpétuo -----  Pg Test
-----------------------------------------------------------------------
OrdiLolo  ---  1,20 GHz - 2,80 GHz  --- 17,5 sec  ---    51 sec
Génixxx  ---  2,22 GHz ------------  ----  5,0 sec  ---    15 sec
Tablette  ---  1,80 GHz ------------  --- 26,5 sec  ---    30 sec
Asus123  --- 1,60 GHz - 2,30 GHz  ----  7,5 sec  ---      9 sec

Légende :
- Perpétuo : c'est le temps qu'il faut pour que Perpétuoramic s'installe
- Pg Test : c'est la mesure faite par un programme de test de vitesse
 que j'ai fait pour essayer de mesurer la vitesse des ordinateurs
Le voici :
Code:
rem ' Calcul-vitesse-ordi-1 : Calcul opérationnel de la vitesse des ordinateurs

cal_vit_ordi()

end

sub cal_vit_ordi()
   dim_local i% , hd , hf , t$ , t1$
   t1$=time$
   repeat
      t$=time$ : rem Recherche du début de la seconde
   until t$<>t1$
   hd=val(left$(t$,2))*3600+val(mid$(t$,4,2))*60+val(right$(t$,2))
   for i%=1 to 100000
      caption 0,"Calcul de la vitesse de l'ordinateur  "+str$(int(i%/1000))+" %"
   next i%
   t$=time$
   hf=val(left$(t$,2))*3600+val(mid$(t$,4,2))*60+val(right$(t$,2))
   caption 0,"Vitesse de l'ordinateur =  Test effectué en  "+str$(hf-hd)+"  Sec"
   beep
end_sub
NOTA:
- OrdiLolo est un très vieux portable en XP
- Génixxx est un vieil ordinateur fixe en XP
- Tablette est un ordinateur moderne en tablette détachable en W/8.1
- Asus123 est un ordinateur portable récent en W/10
NOTA:
Les mesures sont effectuées à partir des programmes Perpétuoramic et Pg Test (Cal-vit-ordi)
lancés sous forme d'.exe et non de .bas

Cela donne de drôles de résultats... ?
En tout cas, cela veut dire que ça valait le coup de rajouter
un occupationnel pendant que Perpétuoramic s'installe.
scratch alien scratch Basketball

Quelqu'un connaît une meilleure méthode pour connaître la vitesse réelle des ordinateurs ?
scratch alien scratch Question
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://jjn4.e-monsite.com
jjn4

avatar

Nombre de messages : 1594
Date d'inscription : 13/09/2009

MessageSujet: +++   Ven 29 Avr 2016 - 17:54

Et alors, ça n'intéresse personne,
la vitesse des ordinateurs ?
scratch alien No
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://jjn4.e-monsite.com
Jean Claude

avatar

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

MessageSujet: Re: Perpétuoramic : l'utilitaire absolument incontournable   Ven 29 Avr 2016 - 18:17

Bof.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Jicehel

avatar

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

MessageSujet: Re: Perpétuoramic : l'utilitaire absolument incontournable   Ven 29 Avr 2016 - 21:17

Perso, je n'ai pas assez de connaissances pour tester tous les composants alors j'utilise toujours des utilitaires de Benchmark gratuits quand j'en ai besoin (exemple: SiSoft Sandra Lite (http://www.benchmarkhq.ru/english.html?/sandradl_e.html) )

C'est bien mieux fait que ce que je pourrais faire, ça permet de comparer etc ...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
jjn4

avatar

Nombre de messages : 1594
Date d'inscription : 13/09/2009

MessageSujet: +++   Sam 30 Avr 2016 - 16:55

Ah oui !
scratch alien jocolor
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://jjn4.e-monsite.com
jjn4

avatar

Nombre de messages : 1594
Date d'inscription : 13/09/2009

MessageSujet: +++   Lun 10 Juil 2017 - 15:28

Un petit coucou de la planète Mars
pour corriger un programme que
j'ai fait il y a déjà pas mal de temps,
et je me suis aperçu qu'il avait un bug
aux années 1700, 1800, 1900, 2100...
Gênant pour un calendrier qui se veut
grégorien, quand même !
Alors, je vous le corrige, que vous ne
soyez pas surpris si vous voyagez
dans ces temps lointains...
(version corrigée en haut du chapitre)
A plus tard...!
farao alien farao
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://jjn4.e-monsite.com
Contenu sponsorisé




MessageSujet: Re: Perpétuoramic : l'utilitaire absolument incontournable   

Revenir en haut Aller en bas
 
Perpétuoramic : l'utilitaire absolument incontournable
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 1 sur 1
 Sujets similaires
-
» utilitaire USB
» BD à lire absolument...
» CALENDRIER PERPÉTUEL
» Celeri Perpétuel " Liveche "
» Petite réflexion personnelle

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